Merge pull request #288 from obsidiansystems/content-address-method-c…

…leanup

Content address method cleanup

hnix-store-core/hnix-store-core.cabal

@@ -64,6 +64,7 @@ library
     , System.Nix.Derivation
     , System.Nix.DerivedPath
     , System.Nix.Fingerprint
+    , System.Nix.FileContentAddress
     , System.Nix.Hash
     , System.Nix.Hash.Truncation
     , System.Nix.OutputName

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

@@ -1,9 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module System.Nix.ContentAddress (
-    ContentAddress
-  , ContentAddressMethod
-  , FileIngestionMethod
+    ContentAddress (..)
+  , ContentAddressMethod (..)
   , contentAddressBuilder
   , contentAddressParser
   , buildContentAddress
@@ -18,19 +17,16 @@ import Data.Text (Text)
 import Data.Text.Lazy.Builder (Builder)
 import GHC.Generics (Generic)
 import System.Nix.Hash (HashAlgo)
-import System.Nix.Store.Types (FileIngestionMethod(..))
 
 import qualified Data.Attoparsec.Text
 import qualified Data.Text.Lazy
 import qualified Data.Text.Lazy.Builder
 import qualified System.Nix.Hash
 
 data ContentAddressMethod
-  = FileIngestionMethod !FileIngestionMethod
-  -- ^ The path was added to the store via makeFixedOutputPath or
-  -- addToStore. It is addressed according to some hash algorithm
-  -- applied to the nar serialization via some 'NarHashMode'.
-  | TextIngestionMethod
+  = ContentAddressMethod_Flat
+  | ContentAddressMethod_NixArchive
+  | ContentAddressMethod_Text
   -- ^ The path is a plain file added via makeTextPath or
   -- addTextToStore. It is addressed according to a sha256sum of the
   -- file contents.
@@ -59,19 +55,14 @@ buildContentAddress =
   . contentAddressBuilder
 
 contentAddressBuilder :: ContentAddress -> Builder
-contentAddressBuilder (ContentAddress method digest) = case method of
-  TextIngestionMethod ->
-    "text:"
-    <> System.Nix.Hash.algoDigestBuilder digest
-  FileIngestionMethod r ->
-    "fixed:"
-    <> fileIngestionMethodBuilder r
-    <> System.Nix.Hash.algoDigestBuilder digest
-
-fileIngestionMethodBuilder :: FileIngestionMethod -> Builder
-fileIngestionMethodBuilder = \case
-  FileIngestionMethod_Flat -> ""
-  FileIngestionMethod_FileRecursive -> "r:"
+contentAddressBuilder (ContentAddress method digest) =
+  (case method of
+    ContentAddressMethod_Text -> "text"
+    ContentAddressMethod_NixArchive -> "fixed:r"
+    ContentAddressMethod_Flat -> "fixed"
+  )
+  <> ":"
+  <> System.Nix.Hash.algoDigestBuilder digest
 
 -- | Parse `ContentAddressableAddress` from `ByteString`
 parseContentAddress
@@ -83,17 +74,17 @@ parseContentAddress =
 contentAddressParser :: Parser ContentAddress
 contentAddressParser = do
   method <- parseContentAddressMethod
+  _ <- ":"
   digest <- parseTypedDigest
   case digest of
     Left e -> fail e
     Right x -> return $ ContentAddress method x
 
 parseContentAddressMethod :: Parser ContentAddressMethod
 parseContentAddressMethod =
-      TextIngestionMethod <$ "text:"
-  <|> FileIngestionMethod <$ "fixed:"
-  <*> (FileIngestionMethod_FileRecursive <$ "r:" 
-       <|> pure FileIngestionMethod_Flat)
+      (ContentAddressMethod_Text <$ "text")
+  <|> (ContentAddressMethod_NixArchive <$ "fixed:r")
+  <|> (ContentAddressMethod_Flat <$ "fixed")
 
 parseTypedDigest :: Parser (Either String (DSum HashAlgo Digest))
 parseTypedDigest = System.Nix.Hash.mkNamedDigest <$> parseHashType <*> parseHash

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

@@ -0,0 +1,10 @@
+module System.Nix.FileContentAddress
+  ( FileIngestionMethod(..)
+  ) where
+
+import GHC.Generics (Generic)
+
+data FileIngestionMethod
+  = FileIngestionMethod_Flat
+  | FileIngestionMethod_NixArchive
+  deriving (Bounded, Eq, Generic, Enum, Ord, Show)

hnix-store-core/src/System/Nix/Store/Types.hs

@@ -1,17 +1,11 @@
+-- | TODO rename module
 module System.Nix.Store.Types
-  ( FileIngestionMethod(..)
-  , PathFilter(..)
+  ( PathFilter(..)
   , RepairMode(..)
   ) where
 
 import GHC.Generics (Generic)
 
--- | Add path recursively or not
-data FileIngestionMethod
-  = FileIngestionMethod_Flat
-  | FileIngestionMethod_FileRecursive
-  deriving (Bounded, Eq, Generic, Enum, Ord, Show)
-
 -- | Path filtering function
 newtype PathFilter = PathFilter
   { pathFilterFunction :: FilePath -> Bool

hnix-store-readonly/src/System/Nix/Store/ReadOnly.hs

@@ -1,10 +1,10 @@
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module System.Nix.Store.ReadOnly
-  ( makeStorePath
-  , makeTextPath
+  ( References(..)
+  , makeStorePath
   , makeFixedOutputPath
-  , computeStorePathForText
   , computeStorePathForPath
   ) where
 
@@ -15,8 +15,9 @@ import Data.Constraint.Extras (Has(has))
 import Data.Dependent.Sum (DSum((:=>)))
 import Data.HashSet (HashSet)
 import Data.Some (Some(Some))
+import System.Nix.ContentAddress (ContentAddressMethod (..))
 import System.Nix.Hash (BaseEncoding(Base16), HashAlgo(..))
-import System.Nix.Store.Types (FileIngestionMethod(..), PathFilter, RepairMode)
+import System.Nix.Store.Types (PathFilter, RepairMode)
 import System.Nix.StorePath (StoreDir, StorePath, StorePathName)
 
 import qualified Crypto.Hash
@@ -30,6 +31,23 @@ import qualified System.Nix.Hash
 import qualified System.Nix.Nar
 import qualified System.Nix.StorePath
 
+data References = References
+  { references_others :: HashSet StorePath
+  , references_self :: Bool
+  }
+
+instance Semigroup References where
+  a <> b = References
+    { references_others = references_others a <> references_others b
+    , references_self = references_self a || references_self b
+    }
+
+instance Monoid References where
+  mempty = References
+    { references_others = mempty
+    , references_self = False
+    }
+
 makeStorePath
   :: StoreDir
   -> ByteString
@@ -49,68 +67,64 @@ makeStorePath storeDir ty (hashAlgo :=> (digest :: Digest a)) nm =
         , System.Nix.StorePath.unStorePathName nm
         ]
 
-makeTextPath
+makeType
   :: StoreDir
-  -> StorePathName
-  -> Digest SHA256
-  -> HashSet StorePath
-  -> StorePath
-makeTextPath storeDir nm h refs = makeStorePath storeDir ty (HashAlgo_SHA256 :=> h) nm
- where
-  ty =
-    Data.ByteString.intercalate
-      ":"
-      $ "text"
-      : Data.List.sort
-          (System.Nix.StorePath.storePathToRawFilePath storeDir
-           <$> Data.HashSet.toList refs)
+  -> ByteString
+  -> References
+  -> ByteString
+makeType storeDir ty refs =
+  Data.ByteString.intercalate ":" $ ty : (others ++ self)
+  where
+    others = Data.List.sort
+      $ fmap (System.Nix.StorePath.storePathToRawFilePath storeDir)
+      $ Data.HashSet.toList
+      $ references_others refs
+    self = ["self" | references_self refs]
 
 makeFixedOutputPath
   :: StoreDir
-  -> FileIngestionMethod
+  -> ContentAddressMethod
   -> DSum HashAlgo Digest
+  -> References
   -> StorePathName
   -> StorePath
-makeFixedOutputPath storeDir recursive algoDigest@(hashAlgo :=> digest) =
-  if recursive == FileIngestionMethod_FileRecursive
-     && Some hashAlgo == Some HashAlgo_SHA256
-  then makeStorePath storeDir "source" algoDigest
-  else makeStorePath storeDir "output:out" (HashAlgo_SHA256 :=> h')
+makeFixedOutputPath storeDir method digest@(hashAlgo :=> h) refs =
+  makeStorePath storeDir ty digest'
  where
-  h' =
-    Crypto.Hash.hash @ByteString @SHA256
-      $  "fixed:out:"
-      <> Data.Text.Encoding.encodeUtf8 (System.Nix.Hash.algoToText hashAlgo)
-      <> (if recursive == FileIngestionMethod_FileRecursive then ":r:" else ":")
-      <> Data.Text.Encoding.encodeUtf8 (System.Nix.Hash.encodeDigestWith Base16 digest)
-      <> ":"
-
-computeStorePathForText
-  :: StoreDir
-  -> StorePathName
-  -> ByteString
-  -> (HashSet StorePath -> StorePath)
-computeStorePathForText storeDir nm =
-  makeTextPath storeDir nm
-  . Crypto.Hash.hash
+  (ty, digest') = case method of
+    ContentAddressMethod_Text ->
+      case hashAlgo of
+        HashAlgo_SHA256
+          | references_self refs == False -> (makeType storeDir "text" refs, digest)
+        _ -> error "unsupported" -- TODO do better; maybe we'll just remove this restriction too?
+    _ ->
+      if method == ContentAddressMethod_NixArchive
+         && Some hashAlgo == Some HashAlgo_SHA256
+      then (makeType storeDir "source" refs, digest)
+      else let
+        h' =
+          Crypto.Hash.hash @ByteString @SHA256
+            $  "fixed:out:"
+            <> Data.Text.Encoding.encodeUtf8 (System.Nix.Hash.algoToText hashAlgo)
+            <> (if method == ContentAddressMethod_NixArchive then ":r:" else ":")
+            <> Data.Text.Encoding.encodeUtf8 (System.Nix.Hash.encodeDigestWith Base16 h)
+            <> ":"
+      in ("output:out", HashAlgo_SHA256 :=> h')
 
-computeStorePathForPath
-  :: StoreDir
-  -> StorePathName        -- ^ Name part of the newly created `StorePath`
-  -> FilePath             -- ^ Local `FilePath` to add
-  -> FileIngestionMethod  -- ^ Add target directory recursively
+digestPath
+  :: FilePath             -- ^ Local `FilePath` to add
+  -> ContentAddressMethod -- ^ target directory method
   -> PathFilter           -- ^ Path filter function
   -> RepairMode           -- ^ Only used by local store backend
-  -> IO StorePath
-computeStorePathForPath storeDir name pth recursive _pathFilter _repair = do
-  selectedHash <-
-    if recursive == FileIngestionMethod_FileRecursive
-      then recursiveContentHash
-      else flatContentHash
-  pure $ makeFixedOutputPath storeDir recursive (HashAlgo_SHA256 :=> selectedHash) name
+  -> IO (Digest SHA256)
+digestPath pth method _pathFilter _repair =
+  case method of
+    ContentAddressMethod_Flat -> flatContentHash
+    ContentAddressMethod_NixArchive -> nixArchiveContentHash
+    ContentAddressMethod_Text -> flatContentHash
  where
-  recursiveContentHash :: IO (Digest SHA256)
-  recursiveContentHash =
+  nixArchiveContentHash :: IO (Digest SHA256)
+  nixArchiveContentHash =
     Crypto.Hash.hashFinalize
     <$> execStateT streamNarUpdate (Crypto.Hash.hashInit @SHA256)
 
@@ -127,3 +141,15 @@ computeStorePathForPath storeDir name pth recursive _pathFilter _repair = do
     <$> System.Nix.Nar.narReadFile
           System.Nix.Nar.narEffectsIO
           pth
+
+computeStorePathForPath
+  :: StoreDir
+  -> StorePathName        -- ^ Name part of the newly created `StorePath`
+  -> FilePath             -- ^ Local `FilePath` to add
+  -> ContentAddressMethod -- ^ Add target directory methodly
+  -> PathFilter           -- ^ Path filter function
+  -> RepairMode           -- ^ Only used by local store backend
+  -> IO StorePath
+computeStorePathForPath storeDir name pth method pathFilter repair = do
+  selectedHash <- digestPath pth method pathFilter repair
+  pure $ makeFixedOutputPath storeDir method (HashAlgo_SHA256 :=> selectedHash) mempty name