move ContentAddressableAddress builder and parser to core, add roundtrip prop

2024-12-01 07:10:26 +03:00 · 2023-11-16 16:54:03 +01:00 · 2023-11-16 16:54:03 +01:00 · 2e1cab22b3
commit 2e1cab22b3
parent b80ee47f6a
8 changed files with 106 additions and 99 deletions
--- a/hnix-store-core/hnix-store-core.cabal
+++ b/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
--- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs
+++ b/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,7 +37,9 @@ 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
@ -41,17 +47,23 @@ 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
--- a/hnix-store-core/src/System/Nix/StorePath.hs
+++ b/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
--- a/hnix-store-core/tests/ContentAddressableAddress.hs
+++ b/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
+
--- a/hnix-store-remote/hnix-store-remote.cabal
+++ b/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
--- a/hnix-store-remote/src/System/Nix/Store/Remote.hs
+++ b/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
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs
@ -1,36 +0,0 @@
-{-# language AllowAmbiguousTypes #-}
-{-# language ScopedTypeVariables #-}
-{-# language RankNTypes          #-}
-
-module System.Nix.Store.Remote.Builders
-  ( buildContentAddressableAddress
-  )
-where
-
-import qualified Data.Text.Lazy              as TL
-import           Crypto.Hash                    ( Digest )
-import           System.Nix.StorePath           ( ContentAddressableAddress(..)
-                                                )
-
-import           Data.Text.Lazy.Builder         ( Builder )
-import qualified Data.Text.Lazy.Builder      as TL
-
-import           System.Nix.Hash
-
-- | Marshall `ContentAddressableAddress` to `Text`
-- in form suitable for remote protocol usage.
-buildContentAddressableAddress :: ContentAddressableAddress -> TL.Text
-buildContentAddressableAddress =
-  TL.toLazyText . contentAddressableAddressBuilder
-
-contentAddressableAddressBuilder :: ContentAddressableAddress -> Builder
-contentAddressableAddressBuilder (Text digest) =
-  "text:" <> digestBuilder digest
-contentAddressableAddressBuilder (Fixed _narHashMode (SomeDigest (digest :: Digest hashAlgo))) =
-  "fixed:"
-  <> TL.fromText (System.Nix.Hash.algoName @hashAlgo)
-  <> digestBuilder digest
-
-digestBuilder :: Digest a -> Builder
-digestBuilder =
-  TL.fromText . encodeDigestWith NixBase32
--- a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs
+++ b/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs
@ -1,58 +0,0 @@
-{-# language AllowAmbiguousTypes #-}
-{-# language ScopedTypeVariables #-}
-{-# language RankNTypes          #-}
-{-# language DataKinds           #-}
-
-module System.Nix.Store.Remote.Parsers
-  ( parseContentAddressableAddress
-  )
-where
-
-import Control.Applicative ((<|>))
-import Data.ByteString (ByteString)
-import Data.Text (Text)
-import           Data.Attoparsec.ByteString.Char8
-import           System.Nix.Hash
-import           System.Nix.StorePath           ( ContentAddressableAddress(..)
-                                                , NarHashMode(..)
-                                                )
-import           Crypto.Hash                    ( SHA256 )
-import qualified Data.Text.Encoding
-
-- | Parse `ContentAddressableAddress` from `ByteString`
-parseContentAddressableAddress
-  :: ByteString -> Either String ContentAddressableAddress
-parseContentAddressableAddress =
-  Data.Attoparsec.ByteString.Char8.parseOnly contentAddressableAddressParser
-
-- | Parser for content addressable field
-contentAddressableAddressParser :: Parser ContentAddressableAddress
-contentAddressableAddressParser = caText <|> caFixed
-
-- | 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
-  <$> takeWhile1 (/= ':')