Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Adapt to new hnix-store #1112

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 17 additions & 11 deletions hnix.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -353,12 +353,12 @@ common shared
base >= 4.12 && < 5
, data-fix >= 0.3.0 && < 0.4
, exceptions >= 0.10.0 && < 0.11
, filepath >= 1.4.2 && < 1.5
, filepath >= 1.4.2 && < 1.6
, optparse-applicative >= 0.14.3 && < 0.19
, relude >= 1.0.0 && < 1.3
, serialise >= 0.2.1 && < 0.3
, template-haskell >= 2.13 && < 2.22
, time >= 1.8.0 && < 1.9 || >= 1.9.3 && < 1.13
, template-haskell >= 2.13 && < 2.23
, time >= 1.8.0 && < 1.9 || >= 1.9.3 && < 1.15
ghc-options:
-Wall
-Wno-incomplete-uni-patterns
Expand Down Expand Up @@ -435,32 +435,38 @@ library
hs-source-dirs:
src
build-depends:
aeson >= 1.4.2 && < 1.6 || >= 2.0 && < 2.2
aeson >= 1.4.2 && < 1.6 || >= 2.0 && < 2.3
, array >= 0.4 && < 0.6
, base16-bytestring >= 0.1.1 && < 1.1
, binary >= 0.8.5 && < 0.9
, bytestring >= 0.10.8 && < 0.12
, cryptonite
, bytestring >= 0.10.8 && < 0.13
, crypton
, comonad >= 5.0.4 && < 5.1
, containers >= 0.5.11.0 && < 0.7
, containers >= 0.5.11.0 && < 0.8
, constraints-extras
, data-default-class
, deepseq >= 1.4.3 && <1.6
, dependent-sum > 0.7
, deriving-compat >= 0.3 && < 0.7
, directory >= 1.3.1 && < 1.4
, dlist
, extra >= 1.7 && < 1.8
, free >= 5.1 && < 5.3
, gitrev >= 1.1.0 && < 1.4
, hashable >= 1.2.5 && < 1.5
, hashable >= 1.2.5 && < 1.6
, hashing >= 0.1.0 && < 0.2
, hnix-store-core >= 0.6.0 && < 0.7
, hnix-store-remote >= 0.6.0 && < 0.7
, hnix-store-core >= 0.8.0 && < 0.9
, hnix-store-nar >= 0.1.0 && < 0.2
, hnix-store-readonly >= 0.1.0 && < 0.2
, hnix-store-remote >= 0.7.0 && < 0.8
, http-client >= 0.5.14 && < 0.6 || >= 0.6.4 && < 0.8
, http-client-tls >= 0.3.5 && < 0.4
, http-types >= 0.12.2 && < 0.13
, lens-family >= 1.2.2 && < 2.2
, lens-family-core >= 1.2.2 && < 2.2
, lens-family-th >= 0.5.0 && < 0.6
, logict >= 0.6.0 && < 0.7 || >= 0.7.0.2 && < 0.9
, megaparsec >= 7.0 && < 9.6
, megaparsec >= 7.0 && < 9.7
, monad-control >= 1.0.2 && < 1.1
, monadlist >= 0.0.2 && < 0.1
, mtl >= 2.2.2 && < 2.4
Expand Down
13 changes: 12 additions & 1 deletion src/Nix/Builtins.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,6 +78,9 @@ import Nix.Value.Equal
import Nix.Value.Monad
import Nix.XML
import System.Nix.Base32 as Base32
import System.Nix.Store.Types ( FileIngestionMethod(..)
, RepairMode(..)
)
import System.PosixCompat.Files ( isRegularFile
, isDirectory
, isSymbolicLink
Expand Down Expand Up @@ -912,7 +915,15 @@ pathNix arg =
name <- toText <$> attrGetOr (takeFileName path) (fmap (coerce . toString) . fromStringNoContext) "name" attrs
recursive <- attrGetOr True pure "recursive" attrs

Right (coerce . toText . coerce @StorePath @String -> s) <- addToStore name (NarFile path) recursive False
Right (coerce . toText . coerce @StorePath @String -> s)
<- addToStore
name
(NarFile path)
(if recursive
then FileIngestionMethod_FileRecursive
else FileIngestionMethod_Flat
)
RepairMode_DontRepair
-- TODO: Ensure that s matches sha256 when not empty
pure $ NVStr $ mkNixStringWithSingletonContext (StringContext DirectPath s) s
where
Expand Down
86 changes: 57 additions & 29 deletions src/Nix/Effects.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,6 @@
{-# language DataKinds #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language UndecidableInstances #-}
{-# language PackageImports #-} -- 2021-07-05: Due to hashing Haskell IT system situation, in HNix we currently ended-up with 2 hash package dependencies @{hashing, cryptonite}@
{-# language TypeOperators #-}

{-# options_ghc -Wno-orphans #-}
Expand All @@ -18,12 +17,13 @@ import Nix.Prelude hiding ( putStrLn
)
import qualified Nix.Prelude as Prelude
import GHC.Exception ( ErrorCall(ErrorCall) )
import qualified Data.HashSet as HS
import Data.Default.Class ( Default(def) )
import Data.DList ( DList )
import Data.Some ( Some(Some) )
import qualified Data.Text as Text
import Network.HTTP.Client hiding ( path, Proxy )
import Network.HTTP.Client.TLS
import Network.HTTP.Types
import qualified "cryptonite" Crypto.Hash as Hash
import Nix.Utils.Fix1
import Nix.Expr.Types.Annotated
import Nix.Frames hiding ( Proxy )
Expand All @@ -33,11 +33,18 @@ import Nix.Value
import qualified Paths_hnix
import System.Exit
import qualified System.Info
import System.Process

import System.Nix.Hash ( HashAlgo(HashAlgo_SHA256) )
import System.Nix.Store.Types ( FileIngestionMethod(..)
, RepairMode(..)
)
import System.Nix.Store.Remote ( Logger
, RemoteStoreError
, StoreText(..)
)
import qualified System.Nix.Store.Remote as Store.Remote
import qualified System.Nix.StorePath as Store
import qualified System.Nix.Nar as Store.Nar
import System.Process

-- | A path into the nix store
newtype StorePath = StorePath Path
Expand Down Expand Up @@ -293,7 +300,7 @@ baseNameOf a = Text.takeWhileEnd (/='/') $ Text.dropWhileEnd (=='/') a

-- conversion from Store.StorePath to Effects.StorePath, different type with the same name.
toStorePath :: Store.StorePath -> StorePath
toStorePath = StorePath . coerce . decodeUtf8 @FilePath @ByteString . Store.storePathToRawFilePath
toStorePath = StorePath . coerce . decodeUtf8 @FilePath @ByteString . Store.storePathToRawFilePath def

-- ** Instances

Expand All @@ -317,7 +324,7 @@ instance MonadHttp IO where
(pure $ Left $ ErrorCall $ "fail, got " <> show status <> " when fetching url = " <> urlstr)
-- using addTextToStore' result in different hash from the addToStore.
-- see https://github.com/haskell-nix/hnix/pull/1051#issuecomment-1031380804
(addToStore name (NarText $ toStrict body) False False)
(addToStore name (NarText $ toStrict body) FileIngestionMethod_Flat RepairMode_DontRepair)
(status == 200)


Expand Down Expand Up @@ -374,12 +381,8 @@ print = putStrLn . show

-- ** Data type synonyms

type RecursiveFlag = Bool
type RepairFlag = Bool
type StorePathName = Text
type PathFilter m = Path -> m Bool
type StorePathSet = HS.HashSet StorePath


-- ** @class MonadStore m@

Expand All @@ -396,14 +399,14 @@ class
-- | Copy the contents of a local path(Or pure text) to the store. The resulting store
-- path is returned. Note: This does not support yet support the expected
-- `filter` function that allows excluding some files.
addToStore :: StorePathName -> NarContent -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)
default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> NarContent -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)
addToStore :: StorePathName -> NarContent -> FileIngestionMethod -> RepairMode -> m (Either ErrorCall StorePath)
default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> NarContent -> FileIngestionMethod -> RepairMode -> m (Either ErrorCall StorePath)
addToStore a b c d = lift $ addToStore a b c d

-- | Like addToStore, but the contents written to the output path is a
-- regular file containing the given string.
addTextToStore' :: StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath)
default addTextToStore' :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath)
addTextToStore' :: StorePathName -> Text -> HashSet Store.StorePath -> RepairMode -> m (Either ErrorCall StorePath)
default addTextToStore' :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> Text -> HashSet Store.StorePath -> RepairMode -> m (Either ErrorCall StorePath)
addTextToStore' a b c d = lift $ addTextToStore' a b c d


Expand All @@ -413,37 +416,58 @@ instance MonadStore IO where

addToStore name content recursive repair =
either
(\ err -> pure $ Left $ ErrorCall $ "String '" <> show name <> "' is not a valid path name: " <> err)
(\ err -> pure $ Left $ ErrorCall $ "String '" <> show name <> "' is not a valid path name: " <> show err)
(\ pathName ->
do
res <- Store.Remote.runStore $ Store.Remote.addToStore @Hash.SHA256 pathName (toNarSource content) recursive repair
res <-
Store.Remote.runStore
$ Store.Remote.addToStore
pathName
(toNarSource content)
recursive
(Some HashAlgo_SHA256)
repair
either
Left -- err
(pure . toStorePath) -- store path
<$> parseStoreResult "addToStore" res
)
(Store.makeStorePathName name)
(Store.mkStorePathName name)

addTextToStore' name text references repair =
do
res <- Store.Remote.runStore $ Store.Remote.addTextToStore name text references repair
either
Left -- err
(pure . toStorePath) -- path
<$> parseStoreResult "addTextToStore" res
either
(\ err -> pure $ Left $ ErrorCall $ "String '" <> show name <> "' is not a valid path name: " <> show err)
(\ pathName ->
do
res <-
Store.Remote.runStore
$ Store.Remote.addTextToStore
(StoreText pathName text)
references
repair
either
Left -- err
(pure . toStorePath) -- path
<$> parseStoreResult "addTextToStore" res
)
(Store.mkStorePathName name)


-- ** Functions

parseStoreResult :: Monad m => Text -> (Either String a, [Store.Remote.Logger]) -> m (Either ErrorCall a)
parseStoreResult
:: Monad m
=> Text
-> (Either RemoteStoreError a, DList Logger)
-> m (Either ErrorCall a)
parseStoreResult name (res, logs) =
pure $
either
(\ msg -> Left $ ErrorCall $ "Failed to execute '" <> toString name <> "': " <> msg <> "\n" <> show logs)
(\ msg -> Left $ ErrorCall $ "Failed to execute '" <> toString name <> "': " <> show msg <> "\n" <> show logs)
pure
res

addTextToStore :: (Framed e m, MonadStore m) => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m StorePath
addTextToStore :: (Framed e m, MonadStore m) => StorePathName -> Text -> HashSet Store.StorePath -> RepairMode -> m StorePath
addTextToStore a b c d =
either
throwError
Expand All @@ -457,7 +481,11 @@ addPath p =
either
throwError
pure
=<< addToStore (fromString $ coerce takeFileName p) (NarFile p) True False
=<< addToStore
(fromString $ coerce takeFileName p)
(NarFile p)
FileIngestionMethod_FileRecursive
RepairMode_DontRepair

toFile_ :: (Framed e m, MonadStore m) => Path -> Text -> m StorePath
toFile_ p contents = addTextToStore (fromString $ coerce p) contents mempty False
toFile_ p contents = addTextToStore (fromString $ coerce p) contents mempty RepairMode_DontRepair
Loading
Loading