Merge pull request #291 from haskell-nix/srk/readOnlyDsum

Readonly use `DSum` instead of `NamedAlgo`
haskell-nix · Nov 1, 2024 · 9b24233 · 9b24233
2 parents 517bbde + a41c941
commit 9b24233
Show file tree

Hide file tree

Showing 3 changed files with 32 additions and 25 deletions.
diff --git a/hnix-store-readonly/hnix-store-readonly.cabal b/hnix-store-readonly/hnix-store-readonly.cabal
@@ -34,7 +34,9 @@ library
     , hnix-store-core >= 0.8
     , hnix-store-nar >= 0.1
     , bytestring
+    , constraints-extras
     , crypton
+    , dependent-sum > 0.7
     , mtl
     , text
     , unordered-containers
@@ -57,5 +59,6 @@ test-suite readonly
     , bytestring
     , crypton
     , data-default-class
+    , dependent-sum
     , hspec
     , unordered-containers
diff --git a/hnix-store-readonly/src/System/Nix/Store/ReadOnly.hs b/hnix-store-readonly/src/System/Nix/Store/ReadOnly.hs
@@ -9,10 +9,13 @@ module System.Nix.Store.ReadOnly
   ) where
 
 import Control.Monad.State (StateT, execStateT, modify)
-import Crypto.Hash (Context, Digest, SHA256)
+import Crypto.Hash (Context, Digest, SHA256, HashAlgorithm)
 import Data.ByteString (ByteString)
+import Data.Constraint.Extras (Has(has))
+import Data.Dependent.Sum (DSum((:=>)))
 import Data.HashSet (HashSet)
-import System.Nix.Hash (BaseEncoding(Base16), NamedAlgo(algoName))
+import Data.Some (Some(Some))
+import System.Nix.Hash (BaseEncoding(Base16), HashAlgo(..))
 import System.Nix.Store.Types (FileIngestionMethod(..), PathFilter, RepairMode)
 import System.Nix.StorePath (StoreDir, StorePath, StorePathName)
 
@@ -28,22 +31,20 @@ import qualified System.Nix.Nar
 import qualified System.Nix.StorePath
 
 makeStorePath
-  :: forall hashAlgo
-   . (NamedAlgo hashAlgo)
-  => StoreDir
+  :: StoreDir
   -> ByteString
-  -> Digest hashAlgo
+  -> DSum HashAlgo Digest
   -> StorePathName
   -> StorePath
-makeStorePath storeDir ty h nm =
+makeStorePath storeDir ty (hashAlgo :=> (digest :: Digest a)) nm =
  System.Nix.StorePath.unsafeMakeStorePath storeHash nm
  where
-  storeHash = System.Nix.StorePath.mkStorePathHashPart @hashAlgo s
+  storeHash = has @HashAlgorithm hashAlgo $ System.Nix.StorePath.mkStorePathHashPart @a s
   s =
     Data.ByteString.intercalate ":" $
       ty:fmap Data.Text.Encoding.encodeUtf8
-        [ algoName @hashAlgo
-        , System.Nix.Hash.encodeDigestWith Base16 h
+        [ System.Nix.Hash.algoToText hashAlgo
+        , System.Nix.Hash.encodeDigestWith Base16 digest
         , Data.Text.pack . Data.ByteString.Char8.unpack $ System.Nix.StorePath.unStoreDir storeDir
         , System.Nix.StorePath.unStorePathName nm
         ]
@@ -54,7 +55,7 @@ makeTextPath
   -> Digest SHA256
   -> HashSet StorePath
   -> StorePath
-makeTextPath storeDir nm h refs = makeStorePath storeDir ty h nm
+makeTextPath storeDir nm h refs = makeStorePath storeDir ty (HashAlgo_SHA256 :=> h) nm
  where
   ty =
     Data.ByteString.intercalate
@@ -65,25 +66,23 @@ makeTextPath storeDir nm h refs = makeStorePath storeDir ty h nm
            <$> Data.HashSet.toList refs)
 
 makeFixedOutputPath
-  :: forall hashAlgo
-  .  NamedAlgo hashAlgo
-  => StoreDir
+  :: StoreDir
   -> FileIngestionMethod
-  -> Digest hashAlgo
+  -> DSum HashAlgo Digest
   -> StorePathName
   -> StorePath
-makeFixedOutputPath storeDir recursive h =
+makeFixedOutputPath storeDir recursive algoDigest@(hashAlgo :=> digest) =
   if recursive == FileIngestionMethod_FileRecursive
-     && (algoName @hashAlgo) == "sha256"
-  then makeStorePath storeDir "source" h
-  else makeStorePath storeDir "output:out" h'
+     && Some hashAlgo == Some HashAlgo_SHA256
+  then makeStorePath storeDir "source" algoDigest
+  else makeStorePath storeDir "output:out" (HashAlgo_SHA256 :=> h')
  where
   h' =
     Crypto.Hash.hash @ByteString @SHA256
       $  "fixed:out:"
-      <> Data.Text.Encoding.encodeUtf8 (algoName @hashAlgo)
+      <> 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 h)
+      <> Data.Text.Encoding.encodeUtf8 (System.Nix.Hash.encodeDigestWith Base16 digest)
       <> ":"
 
 computeStorePathForText
@@ -108,7 +107,7 @@ computeStorePathForPath storeDir name pth recursive _pathFilter _repair = do
     if recursive == FileIngestionMethod_FileRecursive
       then recursiveContentHash
       else flatContentHash
-  pure $ makeFixedOutputPath storeDir recursive selectedHash name
+  pure $ makeFixedOutputPath storeDir recursive (HashAlgo_SHA256 :=> selectedHash) name
  where
   recursiveContentHash :: IO (Digest SHA256)
   recursiveContentHash =

diff --git a/hnix-store-readonly/tests/ReadOnlySpec.hs b/hnix-store-readonly/tests/ReadOnlySpec.hs
@@ -7,6 +7,8 @@ import Test.Hspec (Spec, describe, it, shouldBe, pendingWith)
 
 import Crypto.Hash (hash, Digest, SHA256(..))
 import Data.ByteString (ByteString)
+import Data.Dependent.Sum (DSum(..))
+import System.Nix.Hash (HashAlgo(..))
 import System.Nix.StorePath (StorePath, StorePathName)
 import System.Nix.Store.Types (FileIngestionMethod(..))
 
@@ -18,6 +20,9 @@ import System.Nix.Store.ReadOnly
 testDigest :: Digest SHA256
 testDigest = Crypto.Hash.hash @ByteString "testDigest"
 
+testDigest' :: DSum HashAlgo Digest
+testDigest' = HashAlgo_SHA256 :=> testDigest
+
 testName :: StorePathName
 testName =
     either undefined id
@@ -45,7 +50,7 @@ spec = do
         $ makeStorePath
             def
             "test"
-            testDigest
+            testDigest'
             testName
       )
       `shouldBe`
@@ -86,7 +91,7 @@ spec = do
           $ makeFixedOutputPath
               def
               FileIngestionMethod_FileRecursive
-              testDigest
+              testDigest'
               testName
         )
         `shouldBe`
@@ -99,7 +104,7 @@ spec = do
           $ makeFixedOutputPath
               def
               FileIngestionMethod_Flat
-              testDigest
+              testDigest'
               testName
         )
         `shouldBe`