Store dir like nix

Author: Ericson2314

hnix-store-core/src/System/Nix/Derivation.hs

@@ -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

hnix-store-core/src/System/Nix/Internal/StorePath.hs

@@ -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)

hnix-store-core/src/System/Nix/ReadonlyStore.hs

@@ -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)

hnix-store-core/src/System/Nix/StorePath.hs

@@ -3,7 +3,8 @@ Description : Representation of Nix store paths.
 -}
 module System.Nix.StorePath
   ( -- * Basic store path types
-    StorePath(..)
+    StoreDir(..)
+  , StorePath(..)
   , StorePathName(..)
   , StorePathSet
   , mkStorePathHashPart

hnix-store-core/tests/Arbitrary.hs

@@ -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

hnix-store-core/tests/Derivation.hs

@@ -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
     )
 

hnix-store-core/tests/StorePath.hs

@@ -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

hnix-store-remote/hnix-store-remote.cabal

@@ -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