move ContentAddressableAddress builder and parser to core, add roundtrip prop

Author: sorki

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

@@ -123,6 +123,7 @@ test-suite format-tests
   main-is: Driver.hs
   other-modules:
     Derivation
+    ContentAddressableAddress
     NarFormat
     Hash
     StorePath

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

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
 {-|
 Description : Representation of Nix store paths.
 -}
@@ -14,6 +15,9 @@ module System.Nix.Internal.StorePath
   , StorePathHashPart(..)
   , mkStorePathHashPart
   , ContentAddressableAddress(..)
+  , contentAddressableAddressBuilder
+  , contentAddressableAddressParser
+  , digestBuilder
   , NarHashMode(..)
   , -- * Manipulating 'StorePathName'
     makeStorePathName
@@ -33,25 +37,33 @@ module System.Nix.Internal.StorePath
 where
 
 import Data.Default.Class (Default(def))
+import Data.Text.Lazy.Builder (Builder)
 import qualified Relude.Unsafe as Unsafe
+import qualified System.Nix.Hash
 import           System.Nix.Internal.Hash
 import           System.Nix.Internal.Base
 import qualified System.Nix.Internal.Base32    as Nix.Base32
 
 import qualified Data.ByteString.Char8         as Bytes.Char8
 import qualified Data.Char                     as Char
 import qualified Data.Text                     as Text
+import qualified Data.Text.Encoding
+import qualified Data.Text.Lazy.Builder
 import           Data.Attoparsec.Text.Lazy      ( Parser
                                                 , (<?>)
                                                 )
+import qualified Data.Attoparsec.ByteString.Char8
 import qualified Data.Attoparsec.Text.Lazy     as Parser.Text.Lazy
 import qualified System.FilePath               as FilePath
 import           Crypto.Hash                    ( SHA256
                                                 , Digest
                                                 , HashAlgorithm
+                                                , hash
                                                 )
 
-import Test.QuickCheck
+import Test.QuickCheck (Arbitrary(arbitrary), listOf, elements)
+import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
+import Test.QuickCheck.Instances ()
 
 -- | A path in a Nix store.
 --
@@ -116,6 +128,7 @@ mkStorePathHashPart
   -> StorePathHashPart
 mkStorePathHashPart = StorePathHashPart . mkStorePathHash @hashAlgo
 
+-- TODO(srk): split into its own module + .Builder/.Parser
 -- | An address for a content-addressable store path, i.e. one whose
 -- store path hash is purely a function of its contents (as opposed to
 -- paths that are derivation outputs, whose hashes are a function of
@@ -136,6 +149,66 @@ data ContentAddressableAddress
     Fixed !NarHashMode !SomeNamedDigest
   deriving (Eq, Generic, Ord, Show)
 
+-- TODO(srk): extend to all hash types
+instance Arbitrary (Digest SHA256) where
+  arbitrary = hash @ByteString <$> arbitrary
+
+instance Arbitrary SomeNamedDigest where
+  arbitrary = SomeDigest @SHA256 <$> arbitrary
+
+deriving via GenericArbitrary ContentAddressableAddress
+  instance Arbitrary ContentAddressableAddress
+
+-- | Builder for `ContentAddressableAddress`
+contentAddressableAddressBuilder :: ContentAddressableAddress -> Builder
+contentAddressableAddressBuilder (Text digest) =
+  "text:"
+  <> digestBuilder digest
+contentAddressableAddressBuilder (Fixed narHashMode (SomeDigest (digest :: Digest hashAlgo))) =
+  "fixed:"
+  <> (if narHashMode == Recursive then "r:" else mempty)
+--  <> Data.Text.Lazy.Builder.fromText (System.Nix.Hash.algoName @hashAlgo)
+  <> digestBuilder digest
+
+-- | Builder for @Digest@s
+digestBuilder :: forall hashAlgo . (NamedAlgo hashAlgo) => Digest hashAlgo -> Builder
+digestBuilder digest =
+  Data.Text.Lazy.Builder.fromText (System.Nix.Hash.algoName @hashAlgo)
+  <> ":"
+  <> Data.Text.Lazy.Builder.fromText (encodeDigestWith NixBase32 digest)
+
+-- | Parser for content addressable field
+contentAddressableAddressParser :: Data.Attoparsec.ByteString.Char8.Parser ContentAddressableAddress
+contentAddressableAddressParser = caText <|> caFixed
+  where
+  -- | Parser for @text:sha256:<h>@
+  --caText :: Parser ContentAddressableAddress
+  caText = do
+    _      <- "text:sha256:"
+    digest <- decodeDigestWith @SHA256 NixBase32 <$> parseHash
+    either fail pure $ Text <$> digest
+
+  -- | Parser for @fixed:<r?>:<ht>:<h>@
+  --caFixed :: Parser ContentAddressableAddress
+  caFixed = do
+    _           <- "fixed:"
+    narHashMode <- (Recursive <$ "r:") <|> (RegularFile <$ "")
+    digest      <- parseTypedDigest
+    either fail pure $ Fixed narHashMode <$> digest
+
+  --parseTypedDigest :: Parser (Either String SomeNamedDigest)
+  parseTypedDigest = mkNamedDigest <$> parseHashType <*> parseHash
+
+  --parseHashType :: Parser Text
+  parseHashType =
+    Data.Text.Encoding.decodeUtf8
+    <$> ("sha256" <|> "sha512" <|> "sha1" <|> "md5") <* (":" <|> "-")
+
+  --parseHash :: Parser Text
+  parseHash =
+    Data.Text.Encoding.decodeUtf8
+    <$> Data.Attoparsec.ByteString.Char8.takeWhile1 (/= ':')
+
 -- | Schemes for hashing a Nix archive.
 --
 -- For backwards-compatibility reasons, there are two different modes
@@ -148,6 +221,9 @@ data NarHashMode
     Recursive
   deriving (Eq, Enum, Generic, Hashable, Ord, Show)
 
+deriving via GenericArbitrary NarHashMode
+  instance Arbitrary NarHashMode
+
 -- | Reason why a path is not valid
 data InvalidPathError =
     EmptyName

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

@@ -10,6 +10,9 @@ module System.Nix.StorePath
   , mkStorePathHashPart
   , unStorePathHashPart
   , ContentAddressableAddress(..)
+  , contentAddressableAddressBuilder
+  , contentAddressableAddressParser
+  , digestBuilder
   , NarHashMode(..)
   , -- * Manipulating 'StorePathName'
     makeStorePathName

hnix-store-core/tests/ContentAddressableAddress.hs

@@ -0,0 +1,21 @@
+
+module ContentAddressableAddress where
+
+import Test.Tasty.QuickCheck
+import System.Nix.StorePath (ContentAddressableAddress, contentAddressableAddressBuilder, contentAddressableAddressParser)
+
+import qualified Data.Attoparsec.ByteString.Char8
+import qualified Data.Text.Lazy
+import qualified Data.Text.Lazy.Builder
+import qualified Data.Text.Encoding
+
+prop_caAddrRoundTrip :: ContentAddressableAddress -> Property
+prop_caAddrRoundTrip = \caAddr ->
+  Data.Attoparsec.ByteString.Char8.parseOnly contentAddressableAddressParser
+   ( Data.Text.Encoding.encodeUtf8
+   . Data.Text.Lazy.toStrict
+   . Data.Text.Lazy.Builder.toLazyText
+   $ contentAddressableAddressBuilder caAddr
+   )
+  === pure caAddr
+

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

@@ -71,9 +71,7 @@ library
     , System.Nix.Store.Remote.Binary
     , System.Nix.Store.Remote.Serialize
     , System.Nix.Store.Remote.Serialize.Prim
-    , System.Nix.Store.Remote.Builders
     , System.Nix.Store.Remote.Logger
-    , System.Nix.Store.Remote.Parsers
     , System.Nix.Store.Remote.Protocol
     , System.Nix.Store.Remote.Types
     , System.Nix.Store.Remote.Util

hnix-store-remote/src/System/Nix/Store/Remote.hs

@@ -39,6 +39,7 @@ import Data.HashSet (HashSet)
 import Data.Map (Map)
 import Data.Text (Text)
 import qualified Control.Monad
+import qualified Data.Attoparsec.ByteString.Char8
 import qualified Data.Text.Encoding
 --
 import qualified Data.ByteString.Lazy          as BSL
@@ -66,7 +67,6 @@ import qualified Data.Map.Strict
 import qualified Data.Set
 
 import qualified System.Nix.StorePath
-import qualified System.Nix.Store.Remote.Parsers
 
 import           System.Nix.Store.Remote.Binary
 import           System.Nix.Store.Remote.Types
@@ -257,7 +257,9 @@ queryPathInfoUncached path = do
 
       contentAddressableAddress =
         case
-          System.Nix.Store.Remote.Parsers.parseContentAddressableAddress caString
+          Data.Attoparsec.ByteString.Char8.parseOnly
+            System.Nix.StorePath.contentAddressableAddressParser
+            caString
           of
           Left  e -> error e
           Right x -> Just x