mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2025-01-06 03:06:58 +03:00
Store dir like nix
This commit is contained in:
John Ericson
parent
6b32c7cd77
commit
5727827dcb
@ -11,19 +11,22 @@ import qualified Data.Attoparsec.Text.Lazy as Text.Lazy
|
||||
( Parser )
|
||||
import Nix.Derivation ( Derivation )
|
||||
import qualified Nix.Derivation as Derivation
|
||||
import System.Nix.StorePath ( StorePath )
|
||||
import System.Nix.StorePath ( StoreDir
|
||||
, StorePath
|
||||
, storePathToFilePath
|
||||
)
|
||||
import qualified System.Nix.StorePath as StorePath
|
||||
|
||||
|
||||
|
||||
parseDerivation :: FilePath -> Text.Lazy.Parser (Derivation StorePath Text)
|
||||
parseDerivation :: StoreDir -> Text.Lazy.Parser (Derivation StorePath Text)
|
||||
parseDerivation expectedRoot =
|
||||
Derivation.parseDerivationWith
|
||||
("\"" *> StorePath.pathParser expectedRoot <* "\"")
|
||||
Derivation.textParser
|
||||
|
||||
buildDerivation :: Derivation StorePath Text -> Text.Lazy.Builder
|
||||
buildDerivation =
|
||||
buildDerivation :: StoreDir -> Derivation StorePath Text -> Text.Lazy.Builder
|
||||
buildDerivation storeDir =
|
||||
Derivation.buildDerivationWith
|
||||
(show . show)
|
||||
(show . storePathToFilePath storeDir)
|
||||
show
|
||||
|
||||
@ -10,7 +10,8 @@ Description : Representation of Nix store paths.
|
||||
|
||||
module System.Nix.Internal.StorePath
|
||||
( -- * Basic store path types
|
||||
StorePath(..)
|
||||
StoreDir(..)
|
||||
, StorePath(..)
|
||||
, StorePathName(..)
|
||||
, StorePathSet
|
||||
, mkStorePathHashPart
|
||||
@ -54,10 +55,9 @@ import Crypto.Hash ( SHA256
|
||||
-- From the Nix thesis: A store path is the full path of a store
|
||||
-- object. It has the following anatomy: storeDir/hashPart-name.
|
||||
--
|
||||
-- @storeDir@: The root of the Nix store (e.g. \/nix\/store).
|
||||
--
|
||||
-- See the 'StoreDir' haddocks for details on why we represent this at
|
||||
-- the type level.
|
||||
-- The store directory is *not* included, and must be known from the
|
||||
-- context. This matches modern C++ Nix, and also represents the fact
|
||||
-- that store paths for different store directories cannot be mixed.
|
||||
data StorePath = StorePath
|
||||
{ -- | The 160-bit hash digest reflecting the "address" of the name.
|
||||
-- Currently, this is a truncated SHA256 hash.
|
||||
@ -66,18 +66,13 @@ data StorePath = StorePath
|
||||
-- this is typically the package name and version (e.g.
|
||||
-- hello-1.2.3).
|
||||
storePathName :: !StorePathName
|
||||
, -- | Root of the store
|
||||
storePathRoot :: !FilePath
|
||||
}
|
||||
deriving (Eq, Ord)
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance Hashable StorePath where
|
||||
hashWithSalt s StorePath{..} =
|
||||
s `hashWithSalt` storePathHash `hashWithSalt` storePathName
|
||||
|
||||
instance Show StorePath where
|
||||
show p = Bytes.Char8.unpack $ storePathToRawFilePath p
|
||||
|
||||
-- | The name portion of a Nix path.
|
||||
--
|
||||
-- 'unStorePathName' must only contain a-zA-Z0-9+._?=-, can't start
|
||||
@ -86,7 +81,7 @@ instance Show StorePath where
|
||||
newtype StorePathName = StorePathName
|
||||
{ -- | Extract the contents of the name.
|
||||
unStorePathName :: Text
|
||||
} deriving (Eq, Hashable, Ord)
|
||||
} deriving (Eq, Hashable, Ord, Show)
|
||||
|
||||
-- | The hash algorithm used for store path hashes.
|
||||
newtype StorePathHashPart = StorePathHashPart ByteString
|
||||
@ -161,22 +156,29 @@ validStorePathNameChar c =
|
||||
-- to avoid the dependency.
|
||||
type RawFilePath = ByteString
|
||||
|
||||
-- | The path to the store dir
|
||||
--
|
||||
-- Many operations need to be parameterized with this, since store paths
|
||||
-- do not know their own store dir by design.
|
||||
newtype StoreDir = StoreDir {
|
||||
unStoreDir :: RawFilePath
|
||||
} deriving (Eq, Hashable, Ord, Show)
|
||||
|
||||
-- | Render a 'StorePath' as a 'RawFilePath'.
|
||||
storePathToRawFilePath :: StorePath -> RawFilePath
|
||||
storePathToRawFilePath StorePath{..} =
|
||||
root <> "/" <> hashPart <> "-" <> name
|
||||
storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath
|
||||
storePathToRawFilePath storeDir StorePath{..} =
|
||||
unStoreDir storeDir <> "/" <> hashPart <> "-" <> name
|
||||
where
|
||||
root = Bytes.Char8.pack storePathRoot
|
||||
hashPart = encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash
|
||||
name = encodeUtf8 $ unStorePathName storePathName
|
||||
|
||||
-- | Render a 'StorePath' as a 'FilePath'.
|
||||
storePathToFilePath :: StorePath -> FilePath
|
||||
storePathToFilePath = Bytes.Char8.unpack . storePathToRawFilePath
|
||||
storePathToFilePath :: StoreDir -> StorePath -> FilePath
|
||||
storePathToFilePath storeDir = Bytes.Char8.unpack . storePathToRawFilePath storeDir
|
||||
|
||||
-- | Render a 'StorePath' as a 'Text'.
|
||||
storePathToText :: StorePath -> Text
|
||||
storePathToText = toText . Bytes.Char8.unpack . storePathToRawFilePath
|
||||
storePathToText :: StoreDir -> StorePath -> Text
|
||||
storePathToText storeDir = toText . Bytes.Char8.unpack . storePathToRawFilePath storeDir
|
||||
|
||||
-- | Build `narinfo` suffix from `StorePath` which
|
||||
-- can be used to query binary caches.
|
||||
@ -186,7 +188,7 @@ storePathToNarInfo StorePath{..} =
|
||||
|
||||
-- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking
|
||||
-- that store directory matches `expectedRoot`.
|
||||
parsePath :: FilePath -> Bytes.Char8.ByteString -> Either String StorePath
|
||||
parsePath :: StoreDir -> Bytes.Char8.ByteString -> Either String StorePath
|
||||
parsePath expectedRoot x =
|
||||
let
|
||||
(rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x
|
||||
@ -196,17 +198,20 @@ parsePath expectedRoot x =
|
||||
--rootDir' = dropTrailingPathSeparator rootDir
|
||||
-- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b
|
||||
rootDir' = Unsafe.init rootDir
|
||||
expectedRootS = Bytes.Char8.unpack (unStoreDir expectedRoot)
|
||||
storeDir =
|
||||
if expectedRoot == rootDir'
|
||||
if expectedRootS == rootDir'
|
||||
then pure rootDir'
|
||||
else Left $ "Root store dir mismatch, expected" <> expectedRoot <> "got" <> rootDir'
|
||||
else Left $ "Root store dir mismatch, expected" <> expectedRootS <> "got" <> rootDir'
|
||||
in
|
||||
StorePath <$> coerce storeHash <*> name <*> storeDir
|
||||
StorePath <$> coerce storeHash <*> name
|
||||
|
||||
pathParser :: FilePath -> Parser StorePath
|
||||
pathParser :: StoreDir -> Parser StorePath
|
||||
pathParser expectedRoot = do
|
||||
let expectedRootS = Bytes.Char8.unpack (unStoreDir expectedRoot)
|
||||
|
||||
_ <-
|
||||
Parser.Text.Lazy.string (toText expectedRoot)
|
||||
Parser.Text.Lazy.string (toText expectedRootS)
|
||||
<?> "Store root mismatch" -- e.g. /nix/store
|
||||
|
||||
_ <- Parser.Text.Lazy.char '/'
|
||||
@ -232,4 +237,4 @@ pathParser expectedRoot = do
|
||||
either
|
||||
fail
|
||||
pure
|
||||
(StorePath <$> coerce digest <*> name <*> pure expectedRoot)
|
||||
(StorePath <$> coerce digest <*> name)
|
||||
|
||||
@ -4,6 +4,7 @@
|
||||
module System.Nix.ReadonlyStore where
|
||||
|
||||
|
||||
import qualified Data.ByteString.Char8 as Bytes.Char8
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.HashSet as HS
|
||||
import System.Nix.Hash
|
||||
@ -23,43 +24,42 @@ import Crypto.Hash ( Context
|
||||
makeStorePath
|
||||
:: forall h
|
||||
. (NamedAlgo h)
|
||||
=> FilePath
|
||||
=> StoreDir
|
||||
-> ByteString
|
||||
-> Digest h
|
||||
-> StorePathName
|
||||
-> StorePath
|
||||
makeStorePath fp ty h nm = StorePath (coerce storeHash) nm fp
|
||||
makeStorePath storeDir ty h nm = StorePath (coerce storeHash) nm
|
||||
where
|
||||
storeHash = mkStorePathHash @h s
|
||||
|
||||
s =
|
||||
BS.intercalate ":" $
|
||||
ty:fmap encodeUtf8
|
||||
[ algoName @h
|
||||
, encodeDigestWith Base16 h
|
||||
, toText fp
|
||||
, toText . Bytes.Char8.unpack $ unStoreDir storeDir
|
||||
, coerce nm
|
||||
]
|
||||
|
||||
makeTextPath
|
||||
:: FilePath -> StorePathName -> Digest SHA256 -> StorePathSet -> StorePath
|
||||
makeTextPath fp nm h refs = makeStorePath fp ty h nm
|
||||
:: StoreDir -> StorePathName -> Digest SHA256 -> StorePathSet -> StorePath
|
||||
makeTextPath storeDir nm h refs = makeStorePath storeDir ty h nm
|
||||
where
|
||||
ty =
|
||||
BS.intercalate ":" $ "text" : sort (storePathToRawFilePath <$> HS.toList refs)
|
||||
BS.intercalate ":" $ "text" : sort (storePathToRawFilePath storeDir <$> HS.toList refs)
|
||||
|
||||
makeFixedOutputPath
|
||||
:: forall hashAlgo
|
||||
. NamedAlgo hashAlgo
|
||||
=> FilePath
|
||||
=> StoreDir
|
||||
-> Bool
|
||||
-> Digest hashAlgo
|
||||
-> StorePathName
|
||||
-> StorePath
|
||||
makeFixedOutputPath fp recursive h =
|
||||
makeFixedOutputPath storeDir recursive h =
|
||||
if recursive && (algoName @hashAlgo) == "sha256"
|
||||
then makeStorePath fp "source" h
|
||||
else makeStorePath fp "output:out" h'
|
||||
then makeStorePath storeDir "source" h
|
||||
else makeStorePath storeDir "output:out" h'
|
||||
where
|
||||
h' =
|
||||
hash @ByteString @SHA256
|
||||
@ -70,19 +70,20 @@ makeFixedOutputPath fp recursive h =
|
||||
<> ":"
|
||||
|
||||
computeStorePathForText
|
||||
:: FilePath -> StorePathName -> ByteString -> (StorePathSet -> StorePath)
|
||||
computeStorePathForText fp nm = makeTextPath fp nm . hash
|
||||
:: StoreDir -> StorePathName -> ByteString -> (StorePathSet -> StorePath)
|
||||
computeStorePathForText storeDir nm = makeTextPath storeDir nm . hash
|
||||
|
||||
computeStorePathForPath
|
||||
:: StorePathName -- ^ Name part of the newly created `StorePath`
|
||||
:: StoreDir
|
||||
-> StorePathName -- ^ Name part of the newly created `StorePath`
|
||||
-> FilePath -- ^ Local `FilePath` to add
|
||||
-> Bool -- ^ Add target directory recursively
|
||||
-> (FilePath -> Bool) -- ^ Path filter function
|
||||
-> Bool -- ^ Only used by local store backend
|
||||
-> IO StorePath
|
||||
computeStorePathForPath name pth recursive _pathFilter _repair = do
|
||||
computeStorePathForPath storeDir name pth recursive _pathFilter _repair = do
|
||||
selectedHash <- if recursive then recursiveContentHash else flatContentHash
|
||||
pure $ makeFixedOutputPath "/nix/store" recursive selectedHash name
|
||||
pure $ makeFixedOutputPath storeDir recursive selectedHash name
|
||||
where
|
||||
recursiveContentHash :: IO (Digest SHA256)
|
||||
recursiveContentHash = hashFinalize <$> execStateT streamNarUpdate (hashInit @SHA256)
|
||||
|
||||
@ -3,7 +3,8 @@ Description : Representation of Nix store paths.
|
||||
-}
|
||||
module System.Nix.StorePath
|
||||
( -- * Basic store path types
|
||||
StorePath(..)
|
||||
StoreDir(..)
|
||||
, StorePath(..)
|
||||
, StorePathName(..)
|
||||
, StorePathSet
|
||||
, mkStorePathHashPart
|
||||
|
||||
@ -35,23 +35,24 @@ instance Arbitrary StorePathHashPart where
|
||||
instance Arbitrary (Digest SHA256) where
|
||||
arbitrary = hash . BSC.pack <$> arbitrary
|
||||
|
||||
instance Arbitrary StoreDir where
|
||||
arbitrary = StoreDir . ("/" <>) . BSC.pack <$> arbitrary
|
||||
|
||||
newtype NixLike = NixLike {getNixLike :: StorePath}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance Arbitrary NixLike where
|
||||
arbitrary =
|
||||
NixLike <$>
|
||||
liftA3 StorePath
|
||||
liftA2 StorePath
|
||||
arbitraryTruncatedDigest
|
||||
arbitrary
|
||||
(pure "/nix/store")
|
||||
where
|
||||
-- 160-bit hash, 20 bytes, 32 chars in base32
|
||||
arbitraryTruncatedDigest = coerce . BSC.pack <$> replicateM 20 genSafeChar
|
||||
|
||||
instance Arbitrary StorePath where
|
||||
arbitrary =
|
||||
liftA3 StorePath
|
||||
liftA2 StorePath
|
||||
arbitrary
|
||||
arbitrary
|
||||
dir
|
||||
|
||||
@ -6,6 +6,7 @@ import Test.Tasty ( TestTree
|
||||
)
|
||||
import Test.Tasty.Golden ( goldenVsFile )
|
||||
|
||||
import System.Nix.StorePath ( StoreDir(..) )
|
||||
import System.Nix.Derivation ( parseDerivation
|
||||
, buildDerivation
|
||||
)
|
||||
@ -23,10 +24,10 @@ processDerivation source dest = do
|
||||
(Data.Text.IO.writeFile dest
|
||||
. toText
|
||||
. Data.Text.Lazy.Builder.toLazyText
|
||||
. buildDerivation
|
||||
. buildDerivation (StoreDir "/nix/store")
|
||||
)
|
||||
(Data.Attoparsec.Text.parseOnly
|
||||
(parseDerivation "/nix/store")
|
||||
(parseDerivation $ StoreDir "/nix/store")
|
||||
contents
|
||||
)
|
||||
|
||||
|
||||
@ -1,5 +1,6 @@
|
||||
{-# language DataKinds #-}
|
||||
{-# language ScopedTypeVariables #-}
|
||||
{-# language OverloadedStrings #-}
|
||||
|
||||
module StorePath where
|
||||
|
||||
@ -11,19 +12,19 @@ import System.Nix.StorePath
|
||||
import Arbitrary
|
||||
|
||||
-- | Test that Nix(OS) like paths roundtrip
|
||||
prop_storePathRoundtrip :: NixLike -> NixLike -> Property
|
||||
prop_storePathRoundtrip (_ :: NixLike) (NixLike x) =
|
||||
parsePath "/nix/store" (storePathToRawFilePath x) === pure x
|
||||
prop_storePathRoundtrip :: StoreDir -> NixLike -> NixLike -> Property
|
||||
prop_storePathRoundtrip storeDir (_ :: NixLike) (NixLike x) =
|
||||
parsePath storeDir (storePathToRawFilePath storeDir x) === pure x
|
||||
|
||||
-- | Test that any `StorePath` roundtrips
|
||||
prop_storePathRoundtrip' :: StorePath -> Property
|
||||
prop_storePathRoundtrip' x =
|
||||
parsePath (storePathRoot x) (storePathToRawFilePath x) === pure x
|
||||
prop_storePathRoundtrip' :: StoreDir -> StorePath -> Property
|
||||
prop_storePathRoundtrip' storeDir x =
|
||||
parsePath storeDir (storePathToRawFilePath storeDir x) === pure x
|
||||
|
||||
prop_storePathRoundtripParser :: NixLike -> NixLike -> Property
|
||||
prop_storePathRoundtripParser (_ :: NixLike) (NixLike x) =
|
||||
Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) (storePathToText x) === pure x
|
||||
prop_storePathRoundtripParser :: StoreDir -> NixLike -> NixLike -> Property
|
||||
prop_storePathRoundtripParser storeDir (_ :: NixLike) (NixLike x) =
|
||||
Data.Attoparsec.Text.parseOnly (pathParser storeDir) (storePathToText storeDir x) === pure x
|
||||
|
||||
prop_storePathRoundtripParser' :: StorePath -> Property
|
||||
prop_storePathRoundtripParser' x =
|
||||
Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) (storePathToText x) === pure x
|
||||
prop_storePathRoundtripParser' :: StoreDir -> StorePath -> Property
|
||||
prop_storePathRoundtripParser' storeDir x =
|
||||
Data.Attoparsec.Text.parseOnly (pathParser storeDir) (storePathToText storeDir x) === pure x
|
||||
|
||||
@ -53,6 +53,7 @@ library
|
||||
, mtl
|
||||
, unordered-containers
|
||||
, hnix-store-core >= 0.6 && <0.7
|
||||
, transformers
|
||||
mixins:
|
||||
base hiding (Prelude)
|
||||
, relude (Relude as Prelude)
|
||||
@ -98,6 +99,7 @@ test-suite hnix-store-remote-tests
|
||||
tasty-discover:tasty-discover
|
||||
build-depends:
|
||||
base
|
||||
, bytestring
|
||||
, relude
|
||||
, hnix-store-core >= 0.3
|
||||
, hnix-store-remote
|
||||
|
||||
@ -107,36 +107,41 @@ addTextToStore
|
||||
addTextToStore name text references' repair = do
|
||||
when repair
|
||||
$ error "repairing is not supported when building through the Nix daemon"
|
||||
storeDir <- getStoreDir
|
||||
runOpArgs AddTextToStore $ do
|
||||
putText name
|
||||
putText text
|
||||
putPaths references'
|
||||
putPaths storeDir references'
|
||||
sockGetPath
|
||||
|
||||
addSignatures :: StorePath -> [BSL.ByteString] -> MonadStore ()
|
||||
addSignatures p signatures = do
|
||||
storeDir <- getStoreDir
|
||||
void $ simpleOpArgs AddSignatures $ do
|
||||
putPath p
|
||||
putPath storeDir p
|
||||
putByteStrings signatures
|
||||
|
||||
addIndirectRoot :: StorePath -> MonadStore ()
|
||||
addIndirectRoot pn = do
|
||||
void $ simpleOpArgs AddIndirectRoot $ putPath pn
|
||||
storeDir <- getStoreDir
|
||||
void $ simpleOpArgs AddIndirectRoot $ putPath storeDir pn
|
||||
|
||||
-- | Add temporary garbage collector root.
|
||||
--
|
||||
-- This root is removed as soon as the client exits.
|
||||
addTempRoot :: StorePath -> MonadStore ()
|
||||
addTempRoot pn = do
|
||||
void $ simpleOpArgs AddTempRoot $ putPath pn
|
||||
storeDir <- getStoreDir
|
||||
void $ simpleOpArgs AddTempRoot $ putPath storeDir pn
|
||||
|
||||
-- | Build paths if they are an actual derivations.
|
||||
--
|
||||
-- If derivation output paths are already valid, do nothing.
|
||||
buildPaths :: StorePathSet -> BuildMode -> MonadStore ()
|
||||
buildPaths ps bm = do
|
||||
storeDir <- getStoreDir
|
||||
void $ simpleOpArgs BuildPaths $ do
|
||||
putPaths ps
|
||||
putPaths storeDir ps
|
||||
putInt $ fromEnum bm
|
||||
|
||||
buildDerivation
|
||||
@ -145,9 +150,10 @@ buildDerivation
|
||||
-> BuildMode
|
||||
-> MonadStore BuildResult
|
||||
buildDerivation p drv buildMode = do
|
||||
storeDir <- getStoreDir
|
||||
runOpArgs BuildDerivation $ do
|
||||
putPath p
|
||||
putDerivation drv
|
||||
putPath storeDir p
|
||||
putDerivation storeDir drv
|
||||
putEnum buildMode
|
||||
-- XXX: reason for this is unknown
|
||||
-- but without it protocol just hangs waiting for
|
||||
@ -159,7 +165,8 @@ buildDerivation p drv buildMode = do
|
||||
|
||||
ensurePath :: StorePath -> MonadStore ()
|
||||
ensurePath pn = do
|
||||
void $ simpleOpArgs EnsurePath $ putPath pn
|
||||
storeDir <- getStoreDir
|
||||
void $ simpleOpArgs EnsurePath $ putPath storeDir pn
|
||||
|
||||
-- | Find garbage collector roots.
|
||||
findRoots :: MonadStore (Map BSL.ByteString StorePath)
|
||||
@ -185,7 +192,8 @@ findRoots = do
|
||||
|
||||
isValidPathUncached :: StorePath -> MonadStore Bool
|
||||
isValidPathUncached p = do
|
||||
simpleOpArgs IsValidPath $ putPath p
|
||||
storeDir <- getStoreDir
|
||||
simpleOpArgs IsValidPath $ putPath storeDir p
|
||||
|
||||
-- | Query valid paths from set, optionally try to use substitutes.
|
||||
queryValidPaths
|
||||
@ -193,8 +201,9 @@ queryValidPaths
|
||||
-> SubstituteFlag -- ^ Try substituting missing paths when `True`
|
||||
-> MonadStore StorePathSet
|
||||
queryValidPaths ps substitute = do
|
||||
storeDir <- getStoreDir
|
||||
runOpArgs QueryValidPaths $ do
|
||||
putPaths ps
|
||||
putPaths storeDir ps
|
||||
putBool substitute
|
||||
sockGetPaths
|
||||
|
||||
@ -205,13 +214,15 @@ queryAllValidPaths = do
|
||||
|
||||
querySubstitutablePaths :: StorePathSet -> MonadStore StorePathSet
|
||||
querySubstitutablePaths ps = do
|
||||
runOpArgs QuerySubstitutablePaths $ putPaths ps
|
||||
storeDir <- getStoreDir
|
||||
runOpArgs QuerySubstitutablePaths $ putPaths storeDir ps
|
||||
sockGetPaths
|
||||
|
||||
queryPathInfoUncached :: StorePath -> MonadStore StorePathMetadata
|
||||
queryPathInfoUncached path = do
|
||||
storeDir <- getStoreDir
|
||||
runOpArgs QueryPathInfo $ do
|
||||
putPath path
|
||||
putPath storeDir path
|
||||
|
||||
valid <- sockGetBool
|
||||
unless valid $ error "Path is not valid"
|
||||
@ -252,22 +263,26 @@ queryPathInfoUncached path = do
|
||||
|
||||
queryReferrers :: StorePath -> MonadStore StorePathSet
|
||||
queryReferrers p = do
|
||||
runOpArgs QueryReferrers $ putPath p
|
||||
storeDir <- getStoreDir
|
||||
runOpArgs QueryReferrers $ putPath storeDir p
|
||||
sockGetPaths
|
||||
|
||||
queryValidDerivers :: StorePath -> MonadStore StorePathSet
|
||||
queryValidDerivers p = do
|
||||
runOpArgs QueryValidDerivers $ putPath p
|
||||
storeDir <- getStoreDir
|
||||
runOpArgs QueryValidDerivers $ putPath storeDir p
|
||||
sockGetPaths
|
||||
|
||||
queryDerivationOutputs :: StorePath -> MonadStore StorePathSet
|
||||
queryDerivationOutputs p = do
|
||||
runOpArgs QueryDerivationOutputs $ putPath p
|
||||
storeDir <- getStoreDir
|
||||
runOpArgs QueryDerivationOutputs $ putPath storeDir p
|
||||
sockGetPaths
|
||||
|
||||
queryDerivationOutputNames :: StorePath -> MonadStore StorePathSet
|
||||
queryDerivationOutputNames p = do
|
||||
runOpArgs QueryDerivationOutputNames $ putPath p
|
||||
storeDir <- getStoreDir
|
||||
runOpArgs QueryDerivationOutputNames $ putPath storeDir p
|
||||
sockGetPaths
|
||||
|
||||
queryPathFromHashPart :: StorePathHashPart -> MonadStore StorePath
|
||||
@ -287,7 +302,8 @@ queryMissing
|
||||
, Integer -- Nar size?
|
||||
)
|
||||
queryMissing ps = do
|
||||
runOpArgs QueryMissing $ putPaths ps
|
||||
storeDir <- getStoreDir
|
||||
runOpArgs QueryMissing $ putPaths storeDir ps
|
||||
|
||||
willBuild <- sockGetPaths
|
||||
willSubstitute <- sockGetPaths
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# language OverloadedStrings #-}
|
||||
{-# language DataKinds #-}
|
||||
{-# language ScopedTypeVariables #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
@ -31,6 +32,7 @@ import Network.Socket.ByteString ( recv
|
||||
, sendAll
|
||||
)
|
||||
|
||||
import System.Nix.StorePath ( StoreDir(..) )
|
||||
import System.Nix.Store.Remote.Binary
|
||||
import System.Nix.Store.Remote.Logger
|
||||
import System.Nix.Store.Remote.Types
|
||||
@ -163,21 +165,21 @@ runOpArgsIO op encoder = do
|
||||
throwError $ Data.ByteString.Char8.unpack msg
|
||||
|
||||
runStore :: MonadStore a -> IO (Either String a, [Logger])
|
||||
runStore = runStoreOpts defaultSockPath "/nix/store"
|
||||
runStore = runStoreOpts defaultSockPath $ StoreDir "/nix/store"
|
||||
|
||||
runStoreOpts
|
||||
:: FilePath -> FilePath -> MonadStore a -> IO (Either String a, [Logger])
|
||||
:: FilePath -> StoreDir -> MonadStore a -> IO (Either String a, [Logger])
|
||||
runStoreOpts path = runStoreOpts' S.AF_UNIX (SockAddrUnix path)
|
||||
|
||||
runStoreOptsTCP
|
||||
:: String -> Int -> FilePath -> MonadStore a -> IO (Either String a, [Logger])
|
||||
:: String -> Int -> StoreDir -> MonadStore a -> IO (Either String a, [Logger])
|
||||
runStoreOptsTCP host port storeRootDir code = do
|
||||
S.getAddrInfo (Just S.defaultHints) (Just host) (Just $ show port) >>= \case
|
||||
(sockAddr:_) -> runStoreOpts' (S.addrFamily sockAddr) (S.addrAddress sockAddr) storeRootDir code
|
||||
_ -> pure (Left "Couldn't resolve host and port with getAddrInfo.", [])
|
||||
|
||||
runStoreOpts'
|
||||
:: S.Family -> S.SockAddr -> FilePath -> MonadStore a -> IO (Either String a, [Logger])
|
||||
:: S.Family -> S.SockAddr -> StoreDir -> MonadStore a -> IO (Either String a, [Logger])
|
||||
runStoreOpts' sockFamily sockAddr storeRootDir code =
|
||||
bracket open (S.close . storeSocket) run
|
||||
|
||||
|
||||
@ -6,6 +6,7 @@ module System.Nix.Store.Remote.Types
|
||||
, StoreConfig(..)
|
||||
, Logger(..)
|
||||
, Field(..)
|
||||
, mapStoreDir
|
||||
, getStoreDir
|
||||
, getLog
|
||||
, flushLog
|
||||
@ -16,12 +17,15 @@ module System.Nix.Store.Remote.Types
|
||||
)
|
||||
where
|
||||
|
||||
|
||||
import Control.Monad.Trans.State.Strict (mapStateT)
|
||||
import Control.Monad.Trans.Except (mapExceptT)
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
import Network.Socket ( Socket )
|
||||
|
||||
import System.Nix.StorePath ( StoreDir )
|
||||
|
||||
data StoreConfig = StoreConfig
|
||||
{ storeDir :: FilePath
|
||||
{ storeDir :: StoreDir
|
||||
, storeSocket :: Socket
|
||||
}
|
||||
|
||||
@ -31,6 +35,10 @@ type MonadStore a
|
||||
(StateT (Maybe BSL.ByteString, [Logger]) (ReaderT StoreConfig IO))
|
||||
a
|
||||
|
||||
-- | For lying about the store dir in tests
|
||||
mapStoreDir :: (StoreDir -> StoreDir) -> (MonadStore a -> MonadStore a)
|
||||
mapStoreDir f = mapExceptT . mapStateT . withReaderT $ \c@StoreConfig { storeDir = sd } -> c { storeDir = f sd }
|
||||
|
||||
type ActivityID = Int
|
||||
type ActivityParentID = Int
|
||||
type ActivityType = Int
|
||||
@ -73,5 +81,5 @@ setData x = modify (\(_, b) -> (Just x, b))
|
||||
clearData :: MonadStore ()
|
||||
clearData = modify (\(_, b) -> (Nothing, b))
|
||||
|
||||
getStoreDir :: MonadStore FilePath
|
||||
getStoreDir :: MonadStore StoreDir
|
||||
getStoreDir = asks storeDir
|
||||
|
||||
@ -106,19 +106,19 @@ putText = putByteStringLen . textToBSL
|
||||
putTexts :: [Text] -> Put
|
||||
putTexts = putByteStrings . fmap textToBSL
|
||||
|
||||
getPath :: FilePath -> Get (Either String StorePath)
|
||||
getPath :: StoreDir -> Get (Either String StorePath)
|
||||
getPath sd = parsePath sd <$> getByteStringLen
|
||||
|
||||
getPaths :: FilePath -> Get StorePathSet
|
||||
getPaths :: StoreDir -> Get StorePathSet
|
||||
getPaths sd =
|
||||
Data.HashSet.fromList . rights . fmap (parsePath sd) <$> getByteStrings
|
||||
|
||||
putPath :: StorePath -> Put
|
||||
putPath = putByteStringLen . fromStrict . storePathToRawFilePath
|
||||
putPath :: StoreDir -> StorePath -> Put
|
||||
putPath storeDir = putByteStringLen . fromStrict . storePathToRawFilePath storeDir
|
||||
|
||||
putPaths :: StorePathSet -> Put
|
||||
putPaths = putByteStrings . Data.HashSet.toList . Data.HashSet.map
|
||||
(fromStrict . storePathToRawFilePath)
|
||||
putPaths :: StoreDir -> StorePathSet -> Put
|
||||
putPaths storeDir = putByteStrings . Data.HashSet.toList . Data.HashSet.map
|
||||
(fromStrict . storePathToRawFilePath storeDir)
|
||||
|
||||
putBool :: Bool -> Put
|
||||
putBool True = putInt (1 :: Int)
|
||||
@ -149,16 +149,16 @@ getBuildResult =
|
||||
<*> getTime
|
||||
<*> getTime
|
||||
|
||||
putDerivation :: Derivation StorePath Text -> Put
|
||||
putDerivation Derivation{..} = do
|
||||
putDerivation :: StoreDir -> Derivation StorePath Text -> Put
|
||||
putDerivation storeDir Derivation{..} = do
|
||||
flip putMany (Data.Map.toList outputs)
|
||||
$ \(outputName, DerivationOutput{..}) -> do
|
||||
putText outputName
|
||||
putPath path
|
||||
putPath storeDir path
|
||||
putText hashAlgo
|
||||
putText hash
|
||||
|
||||
putMany putPath inputSrcs
|
||||
putMany (putPath storeDir) inputSrcs
|
||||
putText platform
|
||||
putText builder
|
||||
putMany putText args
|
||||
|
||||
@ -6,6 +6,7 @@ module NixDaemon where
|
||||
import qualified System.Environment as Env
|
||||
import Control.Exception ( bracket )
|
||||
import Control.Concurrent ( threadDelay )
|
||||
import qualified Data.ByteString.Char8 as BSC
|
||||
import qualified Data.HashSet as HS
|
||||
import qualified Data.Map.Strict as M
|
||||
import System.Directory
|
||||
@ -90,7 +91,7 @@ startDaemon fp = do
|
||||
writeConf (fp </> "etc" </> "nix.conf")
|
||||
p <- createProcessEnv fp "nix-daemon" []
|
||||
waitSocket sockFp 30
|
||||
pure (p, runStoreOpts sockFp (fp </> "store"))
|
||||
pure (p, runStoreOpts sockFp (StoreDir $ BSC.pack $ fp </> "store"))
|
||||
where
|
||||
sockFp = fp </> "var/nix/daemon-socket/socket"
|
||||
|
||||
@ -164,7 +165,7 @@ dummy = do
|
||||
invalidPath :: StorePath
|
||||
invalidPath =
|
||||
let Right n = makeStorePathName "invalid"
|
||||
in StorePath (mkStorePathHashPart "invalid") n "no_such_root"
|
||||
in StorePath (mkStorePathHashPart "invalid") n
|
||||
|
||||
withBuilder :: (StorePath -> MonadStore a) -> MonadStore a
|
||||
withBuilder action = do
|
||||
@ -200,7 +201,7 @@ spec_protocol = Hspec.around withNixDaemon $
|
||||
itRights "validates path" $ withPath $ \path -> do
|
||||
liftIO $ print path
|
||||
isValidPathUncached path `shouldReturn` True
|
||||
itLefts "fails on invalid path" $ isValidPathUncached invalidPath
|
||||
itLefts "fails on invalid path" $ mapStoreDir (\_ -> StoreDir "/asdf") $ isValidPathUncached invalidPath
|
||||
|
||||
context "queryAllValidPaths" $ do
|
||||
itRights "empty query" queryAllValidPaths
|
||||
|
||||
Loading…
Reference in New Issue
Block a user