From 145e7de63f3b4fb5bb3c8b00a0013be6e955e81f Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sun, 6 Jun 2021 17:58:26 +0300 Subject: [PATCH 01/24] Core: Internal.Hash: qualify GHC.TypeList as Kind A preparation for further work. --- hnix-store-core/src/System/Nix/Internal/Hash.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 74952ba..6e7fb6f 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -31,7 +31,8 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Word (Word8) -import GHC.TypeLits (Nat, KnownNat, natVal) +import qualified GHC.TypeLits as Kind + (Nat, KnownNat, natVal) import Data.Coerce (coerce) -- | Constructors to indicate the base encodings @@ -49,7 +50,7 @@ data HashAlgorithm | SHA1 | SHA256 | SHA512 - | Truncated Nat HashAlgorithm + | Truncated Kind.Nat HashAlgorithm -- ^ The hash algorithm obtained by truncating the result of the -- input 'HashAlgorithm' to the given number of bytes. See -- 'truncateDigest' for a description of the truncation algorithm. @@ -202,7 +203,7 @@ instance ValidAlgo 'SHA512 where -- | Reuses the underlying 'ValidAlgo' instance, but does a -- 'truncateDigest' at the end. -instance (ValidAlgo a, KnownNat n) => ValidAlgo ('Truncated n a) where +instance (ValidAlgo a, Kind.KnownNat n) => ValidAlgo ('Truncated n a) where type AlgoCtx ('Truncated n a) = AlgoCtx a initialize = initialize @a update = update @a @@ -216,11 +217,11 @@ instance (ValidAlgo a, KnownNat n) => ValidAlgo ('Truncated n a) where -- (leftover part), right-pads the leftovers with 0 to the truncation -- length, and combines the two strings bytewise with 'xor'. truncateDigest - :: forall n a.(KnownNat n) => Digest a -> Digest ('Truncated n a) + :: forall n a.(Kind.KnownNat n) => Digest a -> Digest ('Truncated n a) truncateDigest (Digest c) = Digest $ BS.pack $ fmap truncOutputByte [0.. n-1] where - n = fromIntegral $ natVal (Proxy @n) + n = fromIntegral $ Kind.natVal (Proxy @n) truncOutputByte :: Int -> Word8 truncOutputByte i = foldl' (aux i) 0 [0 .. BS.length c - 1] From 79b461962ffcd676a5c2094a2a513ef4266e0d68 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Mon, 7 Jun 2021 15:40:17 +0300 Subject: [PATCH 02/24] Core: Internal: form Base It is tiny, but it is a start of separation of the Base encodings from hashing subsystem. --- hnix-store-core/hnix-store-core.cabal | 1 + hnix-store-core/src/System/Nix/Hash.hs | 3 ++- hnix-store-core/src/System/Nix/Internal/Base.hs | 15 +++++++++++++++ hnix-store-core/src/System/Nix/Internal/Hash.hs | 9 ++------- 4 files changed, 20 insertions(+), 8 deletions(-) create mode 100644 hnix-store-core/src/System/Nix/Internal/Base.hs diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index 7c25992..dcee088 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -35,6 +35,7 @@ library , System.Nix.Hash , System.Nix.Internal.Base32 , System.Nix.Internal.Hash + , System.Nix.Internal.Base , System.Nix.Internal.Nar.Parser , System.Nix.Internal.Nar.Streamer , System.Nix.Internal.Nar.Effects diff --git a/hnix-store-core/src/System/Nix/Hash.hs b/hnix-store-core/src/System/Nix/Hash.hs index ea70f71..beede6c 100644 --- a/hnix-store-core/src/System/Nix/Hash.hs +++ b/hnix-store-core/src/System/Nix/Hash.hs @@ -13,10 +13,11 @@ module System.Nix.Hash , Hash.hashLazy , Hash.mkNamedDigest - , Hash.BaseEncoding(..) + , Base.BaseEncoding(..) , Hash.encodeInBase , Hash.decodeBase ) where import qualified System.Nix.Internal.Hash as Hash +import qualified System.Nix.Internal.Base as Base diff --git a/hnix-store-core/src/System/Nix/Internal/Base.hs b/hnix-store-core/src/System/Nix/Internal/Base.hs new file mode 100644 index 0000000..8c9ef61 --- /dev/null +++ b/hnix-store-core/src/System/Nix/Internal/Base.hs @@ -0,0 +1,15 @@ +module System.Nix.Internal.Base + ( module System.Nix.Internal.Base + , encode + , decode + ) +where + +import System.Nix.Internal.Base32 + +-- | Constructors to indicate the base encodings +data BaseEncoding + = Base16 + | Base32 + -- | ^ Nix has a special map of Base32 encoding + | Base64 diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 6e7fb6f..b5b8a66 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -34,13 +34,8 @@ import Data.Word (Word8) import qualified GHC.TypeLits as Kind (Nat, KnownNat, natVal) import Data.Coerce (coerce) - --- | Constructors to indicate the base encodings -data BaseEncoding - = Base16 - | Base32 - -- | ^ Nix has a special map of Base32 encoding - | Base64 +import System.Nix.Internal.Base + (BaseEncoding(Base16,Base32,Base64)) -- | The universe of supported hash algorithms. -- From 0343740efbd7945857ba4a27eb1336d27073e931 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Mon, 7 Jun 2021 16:09:00 +0300 Subject: [PATCH 03/24] Core: Internal: Base32: m refactor --- hnix-store-core/src/System/Nix/Internal/Base32.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Base32.hs b/hnix-store-core/src/System/Nix/Internal/Base32.hs index 1129238..82f73c8 100644 --- a/hnix-store-core/src/System/Nix/Internal/Base32.hs +++ b/hnix-store-core/src/System/Nix/Internal/Base32.hs @@ -22,7 +22,7 @@ digits32 = Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz" -- | Encode a 'BS.ByteString' in Nix's base32 encoding encode :: ByteString -> Text -encode c = Data.Text.pack $ fmap char32 [nChar - 1, nChar - 2 .. 0] +encode c = Data.Text.pack $ takeCharPosFromDict <$> [nChar - 1, nChar - 2 .. 0] where -- Each base32 character gives us 5 bits of information, while -- each byte gives is 8. Because 'div' rounds down, we need to add @@ -43,8 +43,8 @@ encode c = Data.Text.pack $ fmap char32 [nChar - 1, nChar - 2 .. 0] [ fromIntegral (byte j) * (256 ^ j) | j <- [0 .. Bytes.length c - 1] ] - char32 :: Integer -> Char - char32 i = digits32 Vector.! digitInd + takeCharPosFromDict :: Integer -> Char + takeCharPosFromDict i = digits32 Vector.! digitInd where digitInd = fromIntegral $ From 2ae2b49a0bf02da90e1764e48aa1ab82969e49bf Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Mon, 7 Jun 2021 16:12:09 +0300 Subject: [PATCH 04/24] Core: Internal: Base32: decode: Left: name honestly --- hnix-store-core/src/System/Nix/Internal/Base32.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Base32.hs b/hnix-store-core/src/System/Nix/Internal/Base32.hs index 82f73c8..7fe9ab8 100644 --- a/hnix-store-core/src/System/Nix/Internal/Base32.hs +++ b/hnix-store-core/src/System/Nix/Internal/Base32.hs @@ -54,7 +54,7 @@ encode c = Data.Text.pack $ takeCharPosFromDict <$> [nChar - 1, nChar - 2 .. 0] decode :: Text -> Either String ByteString decode what = bool - (Left "Invalid Base32 string") + (Left "Invalid NixBase32 string") (unsafeDecode what) (Data.Text.all (`elem` digits32) what) From bdeeede9aec3d665fe06e938dd2eefbad44a475e Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Mon, 7 Jun 2021 16:23:11 +0300 Subject: [PATCH 05/24] Core: Internal: Base: (-> Nix)Base32 To name it honestly. It is not a standard Base32 encoding. NixBase32 needs specific treatment over the stack (now & in the future), so it is better to distinquish it from default encoding. --- hnix-store-core/src/System/Nix/Internal/Base.hs | 2 +- hnix-store-core/src/System/Nix/Internal/Hash.hs | 12 ++++++------ hnix-store-core/src/System/Nix/Internal/StorePath.hs | 8 ++++---- hnix-store-core/tests/Hash.hs | 6 +++--- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Base.hs b/hnix-store-core/src/System/Nix/Internal/Base.hs index 8c9ef61..0126361 100644 --- a/hnix-store-core/src/System/Nix/Internal/Base.hs +++ b/hnix-store-core/src/System/Nix/Internal/Base.hs @@ -10,6 +10,6 @@ import System.Nix.Internal.Base32 -- | Constructors to indicate the base encodings data BaseEncoding = Base16 - | Base32 + | NixBase32 -- | ^ Nix has a special map of Base32 encoding | Base64 diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index b5b8a66..0d4266e 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -35,7 +35,7 @@ import qualified GHC.TypeLits as Kind (Nat, KnownNat, natVal) import Data.Coerce (coerce) import System.Nix.Internal.Base - (BaseEncoding(Base16,Base32,Base64)) + (BaseEncoding(Base16,NixBase32,Base64)) -- | The universe of supported hash algorithms. -- @@ -55,7 +55,7 @@ newtype Digest (a :: HashAlgorithm) = Digest BS.ByteString deriving (Eq, Ord, DataHashable.Hashable) instance Show (Digest a) where - show = ("Digest " <>) . show . encodeInBase Base32 + show = ("Digest " <>) . show . encodeInBase NixBase32 -- | The primitive interface for incremental hashing for a given -- 'HashAlgorithm'. Every 'HashAlgorithm' should have an instance. @@ -97,7 +97,7 @@ data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (Digest a) instance Show SomeNamedDigest where show sd = case sd of - SomeDigest (digest :: Digest hashType) -> T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeInBase Base32 digest + SomeDigest (digest :: Digest hashType) -> T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeInBase NixBase32 digest mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest mkNamedDigest name sriHash = @@ -115,7 +115,7 @@ mkNamedDigest name sriHash = decodeGo :: forall a . (NamedAlgo a, ValidAlgo a) => Text -> Either String (Digest a) decodeGo h | size == base16Len = decodeBase Base16 h - | size == base32Len = decodeBase Base32 h + | size == base32Len = decodeBase NixBase32 h | size == base64Len = decodeBase Base64 h | otherwise = Left $ T.unpack sriHash <> " is not a valid " <> T.unpack name <> " hash. Its length (" <> show size <> ") does not match any of " <> show [base16Len, base32Len, base64Len] where @@ -149,7 +149,7 @@ hashLazy bsl = -- | Take BaseEncoding type of the output -> take the Digeest as input -> encode Digest encodeInBase :: BaseEncoding -> Digest a -> T.Text encodeInBase Base16 = T.decodeUtf8 . Base16.encode . coerce -encodeInBase Base32 = Base32.encode . coerce +encodeInBase NixBase32 = Base32.encode . coerce encodeInBase Base64 = T.decodeUtf8 . Base64.encode . coerce @@ -164,7 +164,7 @@ decodeBase Base16 = lDecode -- this tacit sugar simply makes GHC pleased with n (x, "") -> Right $ Digest x _ -> Left $ "Unable to decode base16 string" <> T.unpack t #endif -decodeBase Base32 = fmap Digest . Base32.decode +decodeBase NixBase32 = fmap Digest . Base32.decode decodeBase Base64 = fmap Digest . Base64.decode . T.encodeUtf8 diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index c8db28f..3e7be52 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -154,7 +154,7 @@ storePathToRawFilePath StorePath{..} = root <> "/" <> hashPart <> "-" <> name where root = Bytes.Char8.pack storePathRoot - hashPart = Text.encodeUtf8 $ encodeInBase Base32 storePathHash + hashPart = Text.encodeUtf8 $ encodeInBase NixBase32 storePathHash name = Text.encodeUtf8 $ unStorePathName storePathName -- | Render a 'StorePath' as a 'FilePath'. @@ -169,7 +169,7 @@ storePathToText = Text.pack . Bytes.Char8.unpack . storePathToRawFilePath -- can be used to query binary caches. storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString storePathToNarInfo StorePath{..} = - Text.encodeUtf8 $ encodeInBase Base32 storePathHash <> ".narinfo" + Text.encodeUtf8 $ encodeInBase NixBase32 storePathHash <> ".narinfo" -- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking -- that store directory matches `expectedRoot`. @@ -178,7 +178,7 @@ parsePath expectedRoot x = let (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x (digestPart, namePart) = Text.breakOn "-" $ Text.pack fname - digest = decodeBase Base32 digestPart + digest = decodeBase NixBase32 digestPart name = makeStorePathName . Text.drop 1 $ namePart --rootDir' = dropTrailingPathSeparator rootDir -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b @@ -200,7 +200,7 @@ pathParser expectedRoot = do "Expecting path separator" digest <- - decodeBase Base32 + decodeBase NixBase32 <$> Parser.Text.Lazy.takeWhile1 (`elem` Nix.Base32.digits32) "Invalid Base32 part" diff --git a/hnix-store-core/tests/Hash.hs b/hnix-store-core/tests/Hash.hs index 6e370e5..c943d13 100644 --- a/hnix-store-core/tests/Hash.hs +++ b/hnix-store-core/tests/Hash.hs @@ -27,13 +27,13 @@ spec_hash = do describe "hashing parity with nix-store" $ do it "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\"" $ - shouldBe (encodeInBase Base32 (hash @'SHA256 "nix-output:foo")) + shouldBe (encodeInBase NixBase32 (hash @'SHA256 "nix-output:foo")) "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5" it "produces (base16 . md5) of \"Hello World\" the same as the thesis" $ shouldBe (encodeInBase Base16 (hash @'MD5 "Hello World")) "b10a8db164e0754105b7a99be72e3fe5" it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $ - shouldBe (encodeInBase Base32 (hash @'SHA1 "Hello World")) + shouldBe (encodeInBase NixBase32 (hash @'SHA1 "Hello World")) "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a" -- The example in question: @@ -46,7 +46,7 @@ spec_hash = do "xv2iccirbrvklck36f1g7vldn5v58vck" where encodeInBase32 :: Digest a -> Text - encodeInBase32 = encodeInBase Base32 + encodeInBase32 = encodeInBase NixBase32 -- | Test that Nix-like base32 encoding roundtrips prop_nixBase32Roundtrip :: Property From d0295a1613590450c3cbd551e8c1d66551030773 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Mon, 7 Jun 2021 16:29:55 +0300 Subject: [PATCH 06/24] Core: treewide: m clean-up --- hnix-store-core/src/System/Nix/Internal/Hash.hs | 2 +- hnix-store-core/tests/Derivation.hs | 10 +++++----- hnix-store-core/tests/Hash.hs | 5 ++--- 3 files changed, 8 insertions(+), 9 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 0d4266e..2b74b44 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -212,7 +212,7 @@ instance (ValidAlgo a, Kind.KnownNat n) => ValidAlgo ('Truncated n a) where -- (leftover part), right-pads the leftovers with 0 to the truncation -- length, and combines the two strings bytewise with 'xor'. truncateDigest - :: forall n a.(Kind.KnownNat n) => Digest a -> Digest ('Truncated n a) + :: forall n a .(Kind.KnownNat n) => Digest a -> Digest ('Truncated n a) truncateDigest (Digest c) = Digest $ BS.pack $ fmap truncOutputByte [0.. n-1] where diff --git a/hnix-store-core/tests/Derivation.hs b/hnix-store-core/tests/Derivation.hs index ed11b9a..b614128 100644 --- a/hnix-store-core/tests/Derivation.hs +++ b/hnix-store-core/tests/Derivation.hs @@ -20,11 +20,11 @@ processDerivation source dest = do contents <- Data.Text.IO.readFile source either fail - (\ drv -> - Data.Text.IO.writeFile dest - . Data.Text.Lazy.toStrict - . Data.Text.Lazy.Builder.toLazyText - $ buildDerivation drv + -- It seems to be derivation. + (Data.Text.IO.writeFile dest + . Data.Text.Lazy.toStrict + . Data.Text.Lazy.Builder.toLazyText + . buildDerivation ) (Data.Attoparsec.Text.parseOnly (parseDerivation "/nix/store") diff --git a/hnix-store-core/tests/Hash.hs b/hnix-store-core/tests/Hash.hs index c943d13..5ad953f 100644 --- a/hnix-store-core/tests/Hash.hs +++ b/hnix-store-core/tests/Hash.hs @@ -51,12 +51,11 @@ spec_hash = do -- | Test that Nix-like base32 encoding roundtrips prop_nixBase32Roundtrip :: Property prop_nixBase32Roundtrip = forAllShrink nonEmptyString genericShrink $ - \x -> Right (BSC.pack x) === (B32.decode . B32.encode . BSC.pack $ x) + \x -> pure (BSC.pack x) === (B32.decode . B32.encode . BSC.pack $ x) -- | API variants prop_nixBase16Roundtrip :: Digest StorePathHashAlgo -> Property -prop_nixBase16Roundtrip = - \(x :: Digest StorePathHashAlgo) -> Right x === (decodeBase Base16 . encodeInBase Base16 $ x) +prop_nixBase16Roundtrip x = pure x === (decodeBase Base16 . encodeInBase Base16 $ x) -- | Hash encoding conversion ground-truth. -- Similiar to nix/tests/hash.sh From f5ba0fcfa4aa9b040d69c06888aedf2a554802d4 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Mon, 7 Jun 2021 16:51:24 +0300 Subject: [PATCH 07/24] Core: Internal: mv Base enc -> Base, Hash.encode(InBase->DigestWith) --- hnix-store-core/src/System/Nix/Hash.hs | 2 +- .../src/System/Nix/Internal/Base.hs | 23 +++++++++++++++---- .../src/System/Nix/Internal/Hash.hs | 14 +++++------ .../src/System/Nix/Internal/StorePath.hs | 6 ++--- .../src/System/Nix/ReadonlyStore.hs | 4 ++-- hnix-store-core/tests/Hash.hs | 14 +++++------ 6 files changed, 38 insertions(+), 25 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Hash.hs b/hnix-store-core/src/System/Nix/Hash.hs index beede6c..dbc5d38 100644 --- a/hnix-store-core/src/System/Nix/Hash.hs +++ b/hnix-store-core/src/System/Nix/Hash.hs @@ -14,7 +14,7 @@ module System.Nix.Hash , Hash.mkNamedDigest , Base.BaseEncoding(..) - , Hash.encodeInBase + , Hash.encodeDigestWith , Hash.decodeBase ) where diff --git a/hnix-store-core/src/System/Nix/Internal/Base.hs b/hnix-store-core/src/System/Nix/Internal/Base.hs index 0126361..718d0f0 100644 --- a/hnix-store-core/src/System/Nix/Internal/Base.hs +++ b/hnix-store-core/src/System/Nix/Internal/Base.hs @@ -1,15 +1,28 @@ module System.Nix.Internal.Base ( module System.Nix.Internal.Base - , encode - , decode + , Base32.encode + , Base32.decode ) where -import System.Nix.Internal.Base32 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.ByteString as Bytes +import qualified Data.ByteString.Base16 as Base16 +import qualified System.Nix.Base32 as Base32 -- Nix has own Base32 encoding +import qualified Data.ByteString.Base64 as Base64 -- | Constructors to indicate the base encodings data BaseEncoding - = Base16 - | NixBase32 + = NixBase32 -- | ^ Nix has a special map of Base32 encoding + -- Placed first, since it determines Haskell optimizations of pattern matches, & NixBase seems be the most widely used in Nix. + | Base16 | Base64 + + +-- | Encode @ByteString@ with @Base@ encoding, produce @Text@. +encodeWith :: BaseEncoding -> Bytes.ByteString -> T.Text +encodeWith Base16 = T.decodeUtf8 . Base16.encode +encodeWith NixBase32 = Base32.encode +encodeWith Base64 = T.decodeUtf8 . Base64.encode diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 2b74b44..329c697 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -35,7 +35,9 @@ import qualified GHC.TypeLits as Kind (Nat, KnownNat, natVal) import Data.Coerce (coerce) import System.Nix.Internal.Base - (BaseEncoding(Base16,NixBase32,Base64)) + ( BaseEncoding(Base16,NixBase32,Base64) + , encodeWith + ) -- | The universe of supported hash algorithms. -- @@ -55,7 +57,7 @@ newtype Digest (a :: HashAlgorithm) = Digest BS.ByteString deriving (Eq, Ord, DataHashable.Hashable) instance Show (Digest a) where - show = ("Digest " <>) . show . encodeInBase NixBase32 + show = ("Digest " <>) . show . encodeDigestWith NixBase32 -- | The primitive interface for incremental hashing for a given -- 'HashAlgorithm'. Every 'HashAlgorithm' should have an instance. @@ -97,7 +99,7 @@ data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (Digest a) instance Show SomeNamedDigest where show sd = case sd of - SomeDigest (digest :: Digest hashType) -> T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeInBase NixBase32 digest + SomeDigest (digest :: Digest hashType) -> T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeDigestWith NixBase32 digest mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest mkNamedDigest name sriHash = @@ -147,10 +149,8 @@ hashLazy bsl = -- | Take BaseEncoding type of the output -> take the Digeest as input -> encode Digest -encodeInBase :: BaseEncoding -> Digest a -> T.Text -encodeInBase Base16 = T.decodeUtf8 . Base16.encode . coerce -encodeInBase NixBase32 = Base32.encode . coerce -encodeInBase Base64 = T.decodeUtf8 . Base64.encode . coerce +encodeDigestWith :: BaseEncoding -> Digest a -> T.Text +encodeDigestWith b = encodeWith b . coerce -- | Take BaseEncoding type of the input -> take the input itself -> decodeBase into Digest diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 3e7be52..024a9b7 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -16,7 +16,7 @@ import System.Nix.Hash ( HashAlgorithm ) , Digest , BaseEncoding(..) - , encodeInBase + , encodeDigestWith , decodeBase , SomeNamedDigest ) @@ -154,7 +154,7 @@ storePathToRawFilePath StorePath{..} = root <> "/" <> hashPart <> "-" <> name where root = Bytes.Char8.pack storePathRoot - hashPart = Text.encodeUtf8 $ encodeInBase NixBase32 storePathHash + hashPart = Text.encodeUtf8 $ encodeDigestWith NixBase32 storePathHash name = Text.encodeUtf8 $ unStorePathName storePathName -- | Render a 'StorePath' as a 'FilePath'. @@ -169,7 +169,7 @@ storePathToText = Text.pack . Bytes.Char8.unpack . storePathToRawFilePath -- can be used to query binary caches. storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString storePathToNarInfo StorePath{..} = - Text.encodeUtf8 $ encodeInBase NixBase32 storePathHash <> ".narinfo" + Text.encodeUtf8 $ encodeDigestWith NixBase32 storePathHash <> ".narinfo" -- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking -- that store directory matches `expectedRoot`. diff --git a/hnix-store-core/src/System/Nix/ReadonlyStore.hs b/hnix-store-core/src/System/Nix/ReadonlyStore.hs index 732aea4..77c4fd3 100644 --- a/hnix-store-core/src/System/Nix/ReadonlyStore.hs +++ b/hnix-store-core/src/System/Nix/ReadonlyStore.hs @@ -34,7 +34,7 @@ makeStorePath fp ty h nm = StorePath storeHash nm fp BS.intercalate ":" $ ty:fmap encodeUtf8 [ algoName @hashAlgo - , encodeInBase Base16 h + , encodeDigestWith Base16 h , T.pack fp , unStorePathName nm ] @@ -64,7 +64,7 @@ makeFixedOutputPath fp recursive h = $ "fixed:out:" <> encodeUtf8 (algoName @hashAlgo) <> (if recursive then ":r:" else ":") - <> encodeUtf8 (encodeInBase Base16 h) + <> encodeUtf8 (encodeDigestWith Base16 h) <> ":" computeStorePathForText diff --git a/hnix-store-core/tests/Hash.hs b/hnix-store-core/tests/Hash.hs index 5ad953f..6cd34bf 100644 --- a/hnix-store-core/tests/Hash.hs +++ b/hnix-store-core/tests/Hash.hs @@ -27,13 +27,13 @@ spec_hash = do describe "hashing parity with nix-store" $ do it "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\"" $ - shouldBe (encodeInBase NixBase32 (hash @'SHA256 "nix-output:foo")) + shouldBe (encodeDigestWith NixBase32 (hash @'SHA256 "nix-output:foo")) "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5" it "produces (base16 . md5) of \"Hello World\" the same as the thesis" $ - shouldBe (encodeInBase Base16 (hash @'MD5 "Hello World")) + shouldBe (encodeDigestWith Base16 (hash @'MD5 "Hello World")) "b10a8db164e0754105b7a99be72e3fe5" it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $ - shouldBe (encodeInBase NixBase32 (hash @'SHA1 "Hello World")) + shouldBe (encodeDigestWith NixBase32 (hash @'SHA1 "Hello World")) "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a" -- The example in question: @@ -42,11 +42,11 @@ spec_hash = do let exampleStr = "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3" <> "c0d7b98883f9ee3:/nix/store:myfile" - shouldBe (encodeInBase32 @StorePathHashAlgo (hash exampleStr)) + shouldBe (encodeDigestWith32 @StorePathHashAlgo (hash exampleStr)) "xv2iccirbrvklck36f1g7vldn5v58vck" where - encodeInBase32 :: Digest a -> Text - encodeInBase32 = encodeInBase NixBase32 + encodeDigestWith32 :: Digest a -> Text + encodeDigestWith32 = encodeDigestWith NixBase32 -- | Test that Nix-like base32 encoding roundtrips prop_nixBase32Roundtrip :: Property @@ -55,7 +55,7 @@ prop_nixBase32Roundtrip = forAllShrink nonEmptyString genericShrink $ -- | API variants prop_nixBase16Roundtrip :: Digest StorePathHashAlgo -> Property -prop_nixBase16Roundtrip x = pure x === (decodeBase Base16 . encodeInBase Base16 $ x) +prop_nixBase16Roundtrip x = pure x === (decodeBase Base16 . encodeDigestWith Base16 $ x) -- | Hash encoding conversion ground-truth. -- Similiar to nix/tests/hash.sh From 49699e9ce3b51eea41056df057b0fcc77089ac24 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Mon, 7 Jun 2021 17:11:39 +0300 Subject: [PATCH 08/24] Core: Internal: mv Base dec -> Base, Hash.decode(Base->DigestWith) --- hnix-store-core/src/System/Nix/Hash.hs | 2 +- .../src/System/Nix/Internal/Base.hs | 17 +++++++++++++ .../src/System/Nix/Internal/Hash.hs | 25 +++++-------------- .../src/System/Nix/Internal/StorePath.hs | 6 ++--- hnix-store-core/tests/Hash.hs | 2 +- 5 files changed, 28 insertions(+), 24 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Hash.hs b/hnix-store-core/src/System/Nix/Hash.hs index dbc5d38..78b9a3b 100644 --- a/hnix-store-core/src/System/Nix/Hash.hs +++ b/hnix-store-core/src/System/Nix/Hash.hs @@ -15,7 +15,7 @@ module System.Nix.Hash , Base.BaseEncoding(..) , Hash.encodeDigestWith - , Hash.decodeBase + , Hash.decodeDigestWith ) where diff --git a/hnix-store-core/src/System/Nix/Internal/Base.hs b/hnix-store-core/src/System/Nix/Internal/Base.hs index 718d0f0..4702a1d 100644 --- a/hnix-store-core/src/System/Nix/Internal/Base.hs +++ b/hnix-store-core/src/System/Nix/Internal/Base.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module System.Nix.Internal.Base ( module System.Nix.Internal.Base , Base32.encode @@ -26,3 +28,18 @@ encodeWith :: BaseEncoding -> Bytes.ByteString -> T.Text encodeWith Base16 = T.decodeUtf8 . Base16.encode encodeWith NixBase32 = Base32.encode encodeWith Base64 = T.decodeUtf8 . Base64.encode + +-- | Take the input & @Base@ encoding witness -> decode into @Text@. +decodeWith :: BaseEncoding -> T.Text -> Either String Bytes.ByteString +#if MIN_VERSION_base16_bytestring(1,0,0) +decodeWith Base16 = Base16.decode . T.encodeUtf8 +#else +decodeWith Base16 = lDecode -- this tacit sugar simply makes GHC pleased with number of args + where + lDecode t = + case Base16.decode (T.encodeUtf8 t) of + (x, "") -> pure $ x + _ -> Left $ "Unable to decode base16 string" <> T.unpack t +#endif +decodeWith NixBase32 = Base32.decode +decodeWith Base64 = Base64.decode . T.encodeUtf8 diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 329c697..3b7d4c6 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -19,9 +19,6 @@ import qualified Crypto.Hash.SHA1 as SHA1 import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Hash.SHA512 as SHA512 import qualified Data.ByteString as BS -import qualified Data.ByteString.Base16 as Base16 -import qualified System.Nix.Base32 as Base32 -- Nix has own Base32 encoding -import qualified Data.ByteString.Base64 as Base64 import Data.Bits (xor) import qualified Data.ByteString.Lazy as BSL import qualified Data.Hashable as DataHashable @@ -29,7 +26,6 @@ import Data.List (foldl') import Data.Proxy (Proxy(Proxy)) import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.Encoding as T import Data.Word (Word8) import qualified GHC.TypeLits as Kind (Nat, KnownNat, natVal) @@ -37,6 +33,7 @@ import Data.Coerce (coerce) import System.Nix.Internal.Base ( BaseEncoding(Base16,NixBase32,Base64) , encodeWith + , decodeWith ) -- | The universe of supported hash algorithms. @@ -116,9 +113,9 @@ mkNamedDigest name sriHash = _ -> Left $ "Unknown hash name: " <> T.unpack name decodeGo :: forall a . (NamedAlgo a, ValidAlgo a) => Text -> Either String (Digest a) decodeGo h - | size == base16Len = decodeBase Base16 h - | size == base32Len = decodeBase NixBase32 h - | size == base64Len = decodeBase Base64 h + | size == base16Len = decodeDigestWith Base16 h + | size == base32Len = decodeDigestWith NixBase32 h + | size == base64Len = decodeDigestWith Base64 h | otherwise = Left $ T.unpack sriHash <> " is not a valid " <> T.unpack name <> " hash. Its length (" <> show size <> ") does not match any of " <> show [base16Len, base32Len, base64Len] where size = T.length h @@ -154,18 +151,8 @@ encodeDigestWith b = encodeWith b . coerce -- | Take BaseEncoding type of the input -> take the input itself -> decodeBase into Digest -decodeBase :: BaseEncoding -> T.Text -> Either String (Digest a) -#if MIN_VERSION_base16_bytestring(1,0,0) -decodeBase Base16 = fmap Digest . Base16.decode . T.encodeUtf8 -#else -decodeBase Base16 = lDecode -- this tacit sugar simply makes GHC pleased with number of args - where - lDecode t = case Base16.decode (T.encodeUtf8 t) of - (x, "") -> Right $ Digest x - _ -> Left $ "Unable to decode base16 string" <> T.unpack t -#endif -decodeBase NixBase32 = fmap Digest . Base32.decode -decodeBase Base64 = fmap Digest . Base64.decode . T.encodeUtf8 +decodeDigestWith :: BaseEncoding -> T.Text -> Either String (Digest a) +decodeDigestWith b x = Digest <$> decodeWith b x -- | Uses "Crypto.Hash.MD5" from cryptohash-md5. diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 024a9b7..e73995c 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -17,7 +17,7 @@ import System.Nix.Hash ( HashAlgorithm , Digest , BaseEncoding(..) , encodeDigestWith - , decodeBase + , decodeDigestWith , SomeNamedDigest ) @@ -178,7 +178,7 @@ parsePath expectedRoot x = let (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x (digestPart, namePart) = Text.breakOn "-" $ Text.pack fname - digest = decodeBase NixBase32 digestPart + digest = decodeDigestWith NixBase32 digestPart name = makeStorePathName . Text.drop 1 $ namePart --rootDir' = dropTrailingPathSeparator rootDir -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b @@ -200,7 +200,7 @@ pathParser expectedRoot = do "Expecting path separator" digest <- - decodeBase NixBase32 + decodeDigestWith NixBase32 <$> Parser.Text.Lazy.takeWhile1 (`elem` Nix.Base32.digits32) "Invalid Base32 part" diff --git a/hnix-store-core/tests/Hash.hs b/hnix-store-core/tests/Hash.hs index 6cd34bf..011e42e 100644 --- a/hnix-store-core/tests/Hash.hs +++ b/hnix-store-core/tests/Hash.hs @@ -55,7 +55,7 @@ prop_nixBase32Roundtrip = forAllShrink nonEmptyString genericShrink $ -- | API variants prop_nixBase16Roundtrip :: Digest StorePathHashAlgo -> Property -prop_nixBase16Roundtrip x = pure x === (decodeBase Base16 . encodeDigestWith Base16 $ x) +prop_nixBase16Roundtrip x = pure x === (decodeDigestWith Base16 . encodeDigestWith Base16 $ x) -- | Hash encoding conversion ground-truth. -- Similiar to nix/tests/hash.sh From d8b149895754cafd23b299a212c044a2956c71f1 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Mon, 7 Jun 2021 17:38:19 +0300 Subject: [PATCH 09/24] Core: Internal: Hash: truncateDigest: refactor --- hnix-store-core/src/System/Nix/Internal/Hash.hs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 3b7d4c6..778f5ac 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -29,12 +29,13 @@ import qualified Data.Text as T import Data.Word (Word8) import qualified GHC.TypeLits as Kind (Nat, KnownNat, natVal) -import Data.Coerce (coerce) import System.Nix.Internal.Base ( BaseEncoding(Base16,NixBase32,Base64) , encodeWith , decodeWith ) +import Data.Bool (bool) +import Data.Coerce (coerce) -- | The universe of supported hash algorithms. -- @@ -203,15 +204,18 @@ truncateDigest truncateDigest (Digest c) = Digest $ BS.pack $ fmap truncOutputByte [0.. n-1] where - n = fromIntegral $ Kind.natVal (Proxy @n) + n = fromIntegral $ Kind.natVal $ Proxy @n truncOutputByte :: Int -> Word8 truncOutputByte i = foldl' (aux i) 0 [0 .. BS.length c - 1] inputByte :: Int -> Word8 - inputByte j = BS.index c (fromIntegral j) + inputByte j = BS.index c j aux :: Int -> Word8 -> Int -> Word8 - aux i x j = if j `mod` fromIntegral n == fromIntegral i - then xor x (inputByte $ fromIntegral j) - else x + aux i x j = + bool + id + (`xor` inputByte j) + (j `mod` n == i) + x From 449ba89a9038d6c6e789494d502ae632614b5822 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Mon, 7 Jun 2021 17:41:04 +0300 Subject: [PATCH 10/24] Core: Internal: Hash: truncateDigest(->InNixWay) Please, see the notes in the code. --- hnix-store-core/src/System/Nix/Internal/Hash.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 778f5ac..65ad41a 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -190,7 +190,7 @@ instance (ValidAlgo a, Kind.KnownNat n) => ValidAlgo ('Truncated n a) where type AlgoCtx ('Truncated n a) = AlgoCtx a initialize = initialize @a update = update @a - finalize = truncateDigest @n . finalize @a + finalize = truncateDigestInNixWay @n . finalize @a -- | Bytewise truncation of a 'Digest'. -- @@ -199,9 +199,11 @@ instance (ValidAlgo a, Kind.KnownNat n) => ValidAlgo ('Truncated n a) where -- bytestring into a head part (truncation length) and tail part -- (leftover part), right-pads the leftovers with 0 to the truncation -- length, and combines the two strings bytewise with 'xor'. -truncateDigest +truncateDigestInNixWay :: forall n a .(Kind.KnownNat n) => Digest a -> Digest ('Truncated n a) -truncateDigest (Digest c) = +-- 2021-06-07: NOTE: ^ This is why all the cookery with DataKinds, trunkation length (if allowed arbitrary) needs to be represented in type. +-- 2021-06-07: NOTE: Renamed function, since truncation can be done in a lot of ways, there is no practice of truncting hashes this way, moreover: +truncateDigestInNixWay (Digest c) = Digest $ BS.pack $ fmap truncOutputByte [0.. n-1] where n = fromIntegral $ Kind.natVal $ Proxy @n From 8ddca096090503106f45a4731ae28ed3019bcc5e Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 8 Jun 2021 14:23:25 +0300 Subject: [PATCH 11/24] Core: Internal: add module Truncation --- hnix-store-core/hnix-store-core.cabal | 5 ++- .../src/System/Nix/Internal/Hash.hs | 21 +--------- .../src/System/Nix/Internal/Truncation.hs | 41 +++++++++++++++++++ 3 files changed, 46 insertions(+), 21 deletions(-) create mode 100644 hnix-store-core/src/System/Nix/Internal/Truncation.hs diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index dcee088..ce73f6e 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -33,9 +33,10 @@ library , System.Nix.Build , System.Nix.Derivation , System.Nix.Hash - , System.Nix.Internal.Base32 - , System.Nix.Internal.Hash , System.Nix.Internal.Base + , System.Nix.Internal.Base32 + , System.Nix.Internal.Truncation + , System.Nix.Internal.Hash , System.Nix.Internal.Nar.Parser , System.Nix.Internal.Nar.Streamer , System.Nix.Internal.Nar.Effects diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 65ad41a..1f94742 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -19,14 +19,12 @@ import qualified Crypto.Hash.SHA1 as SHA1 import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Hash.SHA512 as SHA512 import qualified Data.ByteString as BS -import Data.Bits (xor) import qualified Data.ByteString.Lazy as BSL import qualified Data.Hashable as DataHashable import Data.List (foldl') import Data.Proxy (Proxy(Proxy)) import Data.Text (Text) import qualified Data.Text as T -import Data.Word (Word8) import qualified GHC.TypeLits as Kind (Nat, KnownNat, natVal) import System.Nix.Internal.Base @@ -34,8 +32,8 @@ import System.Nix.Internal.Base , encodeWith , decodeWith ) -import Data.Bool (bool) import Data.Coerce (coerce) +import System.Nix.Internal.Truncation (truncateInNixWay) -- | The universe of supported hash algorithms. -- @@ -202,22 +200,7 @@ instance (ValidAlgo a, Kind.KnownNat n) => ValidAlgo ('Truncated n a) where truncateDigestInNixWay :: forall n a .(Kind.KnownNat n) => Digest a -> Digest ('Truncated n a) -- 2021-06-07: NOTE: ^ This is why all the cookery with DataKinds, trunkation length (if allowed arbitrary) needs to be represented in type. --- 2021-06-07: NOTE: Renamed function, since truncation can be done in a lot of ways, there is no practice of truncting hashes this way, moreover: truncateDigestInNixWay (Digest c) = - Digest $ BS.pack $ fmap truncOutputByte [0.. n-1] + Digest $ truncateInNixWay n c where n = fromIntegral $ Kind.natVal $ Proxy @n - - truncOutputByte :: Int -> Word8 - truncOutputByte i = foldl' (aux i) 0 [0 .. BS.length c - 1] - - inputByte :: Int -> Word8 - inputByte j = BS.index c j - - aux :: Int -> Word8 -> Int -> Word8 - aux i x j = - bool - id - (`xor` inputByte j) - (j `mod` n == i) - x diff --git a/hnix-store-core/src/System/Nix/Internal/Truncation.hs b/hnix-store-core/src/System/Nix/Internal/Truncation.hs new file mode 100644 index 0000000..0dddd2d --- /dev/null +++ b/hnix-store-core/src/System/Nix/Internal/Truncation.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} + +module System.Nix.Internal.Truncation where + +import qualified Data.ByteString as Bytes +import Data.Bits (xor) +import Data.List (foldl') +import Data.Word (Word8) +import Data.Bool (bool) + +-- | Bytewise truncation of a 'Digest'. +-- +-- When truncation length is greater than the length of the bytestring +-- but less than twice the bytestring length, truncation splits the +-- bytestring into a head part (truncation length) and tail part +-- (leftover part), right-pads the leftovers with 0 to the truncation +-- length, and combines the two strings bytewise with 'xor'. +truncateInNixWay + :: Int -> Bytes.ByteString -> Bytes.ByteString +-- 2021-06-07: NOTE: Renamed function, since truncation can be done in a lot of ways, there is no practice of truncting hashes this way, moreover: +-- 1. +-- 2. +truncateInNixWay n c = + Bytes.pack $ fmap truncOutputByte [0 .. n-1] + where + + truncOutputByte :: Int -> Word8 + truncOutputByte i = foldl' (aux i) 0 [0 .. Bytes.length c - 1] + + inputByte :: Int -> Word8 + inputByte j = Bytes.index c j + + aux :: Int -> Word8 -> Int -> Word8 + aux i x j = + bool + id + (`xor` inputByte j) + (j `mod` n == i) + x From 978aeb09bad245b5250277ca5d806c351d4bc7c0 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 8 Jun 2021 19:16:28 +0300 Subject: [PATCH 12/24] Core: Internal.Base: m import clean-up --- hnix-store-core/src/System/Nix/Internal/Base.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Base.hs b/hnix-store-core/src/System/Nix/Internal/Base.hs index 4702a1d..a2da55c 100644 --- a/hnix-store-core/src/System/Nix/Internal/Base.hs +++ b/hnix-store-core/src/System/Nix/Internal/Base.hs @@ -1,10 +1,6 @@ {-# LANGUAGE CPP #-} module System.Nix.Internal.Base - ( module System.Nix.Internal.Base - , Base32.encode - , Base32.decode - ) where import qualified Data.Text as T From 2af74986de8aef1a13dbfc955886f9935ca246a3 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 9 Jun 2021 01:18:31 +0300 Subject: [PATCH 13/24] Core: Internal.Hash: take-out Truncated from HashAlgorythm & treewide change M hnix-store-core/src/System/Nix/Hash.hs M hnix-store-core/src/System/Nix/Internal/Hash.hs M hnix-store-core/src/System/Nix/Internal/StorePath.hs M hnix-store-core/src/System/Nix/ReadonlyStore.hs M hnix-store-core/src/System/Nix/StorePath.hs M hnix-store-core/tests/Arbitrary.hs M hnix-store-core/tests/Hash.hs --- hnix-store-core/src/System/Nix/Hash.hs | 1 + .../src/System/Nix/Internal/Hash.hs | 39 ++++--------------- .../src/System/Nix/Internal/StorePath.hs | 37 ++++++++++-------- .../src/System/Nix/ReadonlyStore.hs | 15 +++---- hnix-store-core/src/System/Nix/StorePath.hs | 3 +- hnix-store-core/tests/Arbitrary.hs | 30 ++++++++------ hnix-store-core/tests/Hash.hs | 16 ++++---- 7 files changed, 65 insertions(+), 76 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Hash.hs b/hnix-store-core/src/System/Nix/Hash.hs index 78b9a3b..8913348 100644 --- a/hnix-store-core/src/System/Nix/Hash.hs +++ b/hnix-store-core/src/System/Nix/Hash.hs @@ -5,6 +5,7 @@ module System.Nix.Hash ( Hash.Digest , Hash.HashAlgorithm(..) + , Hash.mkStorePathHash , Hash.ValidAlgo(..) , Hash.NamedAlgo(..) , Hash.SomeNamedDigest(..) diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 1f94742..ac373ad 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -22,18 +22,16 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import qualified Data.Hashable as DataHashable import Data.List (foldl') -import Data.Proxy (Proxy(Proxy)) import Data.Text (Text) import qualified Data.Text as T -import qualified GHC.TypeLits as Kind - (Nat, KnownNat, natVal) import System.Nix.Internal.Base ( BaseEncoding(Base16,NixBase32,Base64) , encodeWith , decodeWith ) import Data.Coerce (coerce) -import System.Nix.Internal.Truncation (truncateInNixWay) +import System.Nix.Internal.Truncation + (truncateInNixWay) -- | The universe of supported hash algorithms. -- @@ -43,10 +41,6 @@ data HashAlgorithm | SHA1 | SHA256 | SHA512 - | Truncated Kind.Nat HashAlgorithm - -- ^ The hash algorithm obtained by truncating the result of the - -- input 'HashAlgorithm' to the given number of bytes. See - -- 'truncateDigest' for a description of the truncation algorithm. -- | The result of running a 'HashAlgorithm'. newtype Digest (a :: HashAlgorithm) = @@ -131,10 +125,14 @@ mkNamedDigest name sriHash = -- or -- > :set -XTypeApplications -- > let d = hash @SHA256 "Hello, sha-256!" -hash :: forall a.ValidAlgo a => BS.ByteString -> Digest a +hash :: forall a . ValidAlgo a => BS.ByteString -> Digest a hash bs = finalize $ update @a (initialize @a) bs +mkStorePathHash :: forall a . ValidAlgo a => BS.ByteString -> BS.ByteString +mkStorePathHash bs = + truncateInNixWay 20 $ coerce $ hash @a bs + -- | Hash an entire (lazy) 'BSL.ByteString' as a single call. -- -- Use is the same as for 'hash'. This runs in constant space, but @@ -181,26 +179,3 @@ instance ValidAlgo 'SHA512 where initialize = SHA512.init update = SHA512.update finalize = Digest . SHA512.finalize - --- | Reuses the underlying 'ValidAlgo' instance, but does a --- 'truncateDigest' at the end. -instance (ValidAlgo a, Kind.KnownNat n) => ValidAlgo ('Truncated n a) where - type AlgoCtx ('Truncated n a) = AlgoCtx a - initialize = initialize @a - update = update @a - finalize = truncateDigestInNixWay @n . finalize @a - --- | Bytewise truncation of a 'Digest'. --- --- When truncation length is greater than the length of the bytestring --- but less than twice the bytestring length, truncation splits the --- bytestring into a head part (truncation length) and tail part --- (leftover part), right-pads the leftovers with 0 to the truncation --- length, and combines the two strings bytewise with 'xor'. -truncateDigestInNixWay - :: forall n a .(Kind.KnownNat n) => Digest a -> Digest ('Truncated n a) --- 2021-06-07: NOTE: ^ This is why all the cookery with DataKinds, trunkation length (if allowed arbitrary) needs to be represented in type. -truncateDigestInNixWay (Digest c) = - Digest $ truncateInNixWay n c - where - n = fromIntegral $ Kind.natVal $ Proxy @n diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index e73995c..472e6b2 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeApplications #-} {-| Description : Representation of Nix store paths. -} @@ -10,15 +11,10 @@ Description : Representation of Nix store paths. {-# LANGUAGE TypeInType #-} -- Needed for GHC 8.4.4 for some reason module System.Nix.Internal.StorePath where -import System.Nix.Hash ( HashAlgorithm - ( Truncated - , SHA256 - ) +import System.Nix.Internal.Hash ( HashAlgorithm(SHA256) , Digest - , BaseEncoding(..) - , encodeDigestWith - , decodeDigestWith , SomeNamedDigest + , mkStorePathHash ) @@ -39,6 +35,11 @@ import qualified Data.Attoparsec.Text.Lazy as Parser.Text.Lazy import qualified System.FilePath as FilePath import Data.Hashable ( Hashable(..) ) import Data.HashSet ( HashSet ) +import System.Nix.Internal.Base ( BaseEncoding(..) + , encodeWith + , decodeWith + ) +import Data.Coerce ( coerce ) -- | A path in a Nix store. -- @@ -52,7 +53,7 @@ import Data.HashSet ( HashSet ) data StorePath = StorePath { -- | The 160-bit hash digest reflecting the "address" of the name. -- Currently, this is a truncated SHA256 hash. - storePathHash :: !(Digest StorePathHashAlgo) + storePathHash :: !StorePathHashPart , -- | The (typically human readable) name of the path. For packages -- this is typically the package name and version (e.g. -- hello-1.2.3). @@ -80,7 +81,11 @@ newtype StorePathName = StorePathName } deriving (Eq, Hashable, Ord) -- | The hash algorithm used for store path hashes. -type StorePathHashAlgo = 'Truncated 20 'SHA256 +newtype StorePathHashPart = StorePathHashPart ByteString + deriving (Eq, Hashable, Ord, Show) + +mkStorePathHashPart :: ByteString -> StorePathHashPart +mkStorePathHashPart = coerce . mkStorePathHash @'SHA256 -- | A set of 'StorePath's. type StorePathSet = HashSet StorePath @@ -154,7 +159,7 @@ storePathToRawFilePath StorePath{..} = root <> "/" <> hashPart <> "-" <> name where root = Bytes.Char8.pack storePathRoot - hashPart = Text.encodeUtf8 $ encodeDigestWith NixBase32 storePathHash + hashPart = Text.encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash name = Text.encodeUtf8 $ unStorePathName storePathName -- | Render a 'StorePath' as a 'FilePath'. @@ -169,7 +174,7 @@ storePathToText = Text.pack . Bytes.Char8.unpack . storePathToRawFilePath -- can be used to query binary caches. storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString storePathToNarInfo StorePath{..} = - Text.encodeUtf8 $ encodeDigestWith NixBase32 storePathHash <> ".narinfo" + Text.encodeUtf8 $ encodeWith NixBase32 (coerce storePathHash) <> ".narinfo" -- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking -- that store directory matches `expectedRoot`. @@ -177,8 +182,8 @@ parsePath :: FilePath -> Bytes.Char8.ByteString -> Either String StorePath parsePath expectedRoot x = let (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x - (digestPart, namePart) = Text.breakOn "-" $ Text.pack fname - digest = decodeDigestWith NixBase32 digestPart + (storeBasedHashPart, namePart) = Text.breakOn "-" $ Text.pack fname + storeHash = decodeWith NixBase32 storeBasedHashPart name = makeStorePathName . Text.drop 1 $ namePart --rootDir' = dropTrailingPathSeparator rootDir -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b @@ -188,7 +193,7 @@ parsePath expectedRoot x = then Right rootDir' else Left $ "Root store dir mismatch, expected" <> expectedRoot <> "got" <> rootDir' in - StorePath <$> digest <*> name <*> storeDir + StorePath <$> coerce storeHash <*> name <*> storeDir pathParser :: FilePath -> Parser StorePath pathParser expectedRoot = do @@ -200,7 +205,7 @@ pathParser expectedRoot = do "Expecting path separator" digest <- - decodeDigestWith NixBase32 + decodeWith NixBase32 <$> Parser.Text.Lazy.takeWhile1 (`elem` Nix.Base32.digits32) "Invalid Base32 part" @@ -219,4 +224,4 @@ pathParser expectedRoot = do either fail pure - (StorePath <$> digest <*> name <*> pure expectedRoot) + (StorePath <$> coerce digest <*> name <*> pure expectedRoot) diff --git a/hnix-store-core/src/System/Nix/ReadonlyStore.hs b/hnix-store-core/src/System/Nix/ReadonlyStore.hs index 77c4fd3..411650b 100644 --- a/hnix-store-core/src/System/Nix/ReadonlyStore.hs +++ b/hnix-store-core/src/System/Nix/ReadonlyStore.hs @@ -16,24 +16,25 @@ import System.Nix.Hash import System.Nix.Nar import System.Nix.StorePath import Control.Monad.State.Strict +import Data.Coerce ( coerce ) makeStorePath - :: forall hashAlgo - . (NamedAlgo hashAlgo) + :: forall h + . (NamedAlgo h) => FilePath -> ByteString - -> Digest hashAlgo + -> Digest h -> StorePathName -> StorePath -makeStorePath fp ty h nm = StorePath storeHash nm fp +makeStorePath fp ty h nm = StorePath (coerce storeHash) nm fp where - storeHash = hash s + storeHash = mkStorePathHash @h s s = BS.intercalate ":" $ ty:fmap encodeUtf8 - [ algoName @hashAlgo + [ algoName @h , encodeDigestWith Base16 h , T.pack fp , unStorePathName nm @@ -44,7 +45,7 @@ makeTextPath makeTextPath fp nm h refs = makeStorePath fp ty h nm where ty = - BS.intercalate ":" ("text" : sort (fmap storePathToRawFilePath (HS.toList refs))) + BS.intercalate ":" $ "text" : sort (storePathToRawFilePath <$> HS.toList refs) makeFixedOutputPath :: forall hashAlgo diff --git a/hnix-store-core/src/System/Nix/StorePath.hs b/hnix-store-core/src/System/Nix/StorePath.hs index 3d97f49..6fca8d6 100644 --- a/hnix-store-core/src/System/Nix/StorePath.hs +++ b/hnix-store-core/src/System/Nix/StorePath.hs @@ -6,7 +6,8 @@ module System.Nix.StorePath StorePath(..) , StorePathName , StorePathSet - , StorePathHashAlgo + , mkStorePathHashPart + , StorePathHashPart(..) , ContentAddressableAddress(..) , NarHashMode(..) , -- * Manipulating 'StorePathName' diff --git a/hnix-store-core/tests/Arbitrary.hs b/hnix-store-core/tests/Arbitrary.hs index 34e362a..6b9e571 100644 --- a/hnix-store-core/tests/Arbitrary.hs +++ b/hnix-store-core/tests/Arbitrary.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -11,9 +12,10 @@ import qualified Data.Text as T import Test.Tasty.QuickCheck import System.Nix.Hash -import System.Nix.Internal.Hash import System.Nix.StorePath import System.Nix.Internal.StorePath +import Control.Applicative ( liftA3 ) +import Data.Coerce ( coerce ) genSafeChar :: Gen Char genSafeChar = choose ('\1', '\127') -- ASCII without \NUL @@ -22,7 +24,7 @@ nonEmptyString :: Gen String nonEmptyString = listOf1 genSafeChar dir :: Gen String -dir = ('/':) <$> (listOf1 $ elements $ '/':['a'..'z']) +dir = ('/':) <$> listOf1 (elements $ '/':['a'..'z']) instance Arbitrary StorePathName where arbitrary = StorePathName . T.pack <$> ((:) <$> s1 <*> listOf sn) @@ -31,8 +33,8 @@ instance Arbitrary StorePathName where s1 = elements $ alphanum <> "+-_?=" sn = elements $ alphanum <> "+-._?=" -instance Arbitrary (Digest StorePathHashAlgo) where - arbitrary = hash . BSC.pack <$> arbitrary +instance Arbitrary StorePathHashPart where + arbitrary = mkStorePathHashPart . BSC.pack <$> arbitrary instance Arbitrary (Digest 'SHA256) where arbitrary = hash . BSC.pack <$> arbitrary @@ -42,15 +44,19 @@ newtype NixLike = NixLike {getNixLike :: StorePath} instance Arbitrary NixLike where arbitrary = - NixLike - <$> (StorePath - <$> arbitraryTruncatedDigest - <*> arbitrary - <*> pure "/nix/store" - ) + NixLike <$> + (liftA3 StorePath + arbitraryTruncatedDigest + arbitrary + (pure "/nix/store") + ) where -- 160-bit hash, 20 bytes, 32 chars in base32 - arbitraryTruncatedDigest = Digest . BSC.pack <$> replicateM 20 genSafeChar + arbitraryTruncatedDigest = coerce . BSC.pack <$> replicateM 20 genSafeChar instance Arbitrary StorePath where - arbitrary = StorePath <$> arbitrary <*> arbitrary <*> dir + arbitrary = + liftA3 StorePath + arbitrary + arbitrary + dir diff --git a/hnix-store-core/tests/Hash.hs b/hnix-store-core/tests/Hash.hs index 011e42e..a578517 100644 --- a/hnix-store-core/tests/Hash.hs +++ b/hnix-store-core/tests/Hash.hs @@ -6,13 +6,12 @@ module Hash where -import Control.Monad (forM_) +import Control.Monad ( forM_ ) import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Base16 as B16 import qualified System.Nix.Base32 as B32 import qualified Data.ByteString.Base64.Lazy as B64 import qualified Data.ByteString.Lazy as BSL -import Data.Text (Text) import Test.Hspec import Test.Tasty.QuickCheck @@ -20,6 +19,10 @@ import Test.Tasty.QuickCheck import System.Nix.Hash import System.Nix.StorePath import Arbitrary +import System.Nix.Internal.Base ( decodeWith + , encodeWith + ) +import Data.Coerce ( coerce ) spec_hash :: Spec spec_hash = do @@ -42,11 +45,8 @@ spec_hash = do let exampleStr = "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3" <> "c0d7b98883f9ee3:/nix/store:myfile" - shouldBe (encodeDigestWith32 @StorePathHashAlgo (hash exampleStr)) + shouldBe (encodeWith NixBase32 $ coerce $ mkStorePathHashPart exampleStr) "xv2iccirbrvklck36f1g7vldn5v58vck" - where - encodeDigestWith32 :: Digest a -> Text - encodeDigestWith32 = encodeDigestWith NixBase32 -- | Test that Nix-like base32 encoding roundtrips prop_nixBase32Roundtrip :: Property @@ -54,8 +54,8 @@ prop_nixBase32Roundtrip = forAllShrink nonEmptyString genericShrink $ \x -> pure (BSC.pack x) === (B32.decode . B32.encode . BSC.pack $ x) -- | API variants -prop_nixBase16Roundtrip :: Digest StorePathHashAlgo -> Property -prop_nixBase16Roundtrip x = pure x === (decodeDigestWith Base16 . encodeDigestWith Base16 $ x) +prop_nixBase16Roundtrip :: StorePathHashPart -> Property +prop_nixBase16Roundtrip x = pure (coerce x) === decodeWith Base16 (encodeWith Base16 $ coerce x) -- | Hash encoding conversion ground-truth. -- Similiar to nix/tests/hash.sh From d0b58e9e3db9ff8da54734b717981a56c5a2c8ed Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 9 Jun 2021 01:40:39 +0300 Subject: [PATCH 14/24] Core: Internal.Base: explicit export list --- hnix-store-core/src/System/Nix/Internal/Base.hs | 4 ++++ hnix-store-core/src/System/Nix/Internal/Hash.hs | 6 +----- hnix-store-core/src/System/Nix/Internal/StorePath.hs | 9 +++------ hnix-store-core/tests/Hash.hs | 4 +--- 4 files changed, 9 insertions(+), 14 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Base.hs b/hnix-store-core/src/System/Nix/Internal/Base.hs index a2da55c..c87ba82 100644 --- a/hnix-store-core/src/System/Nix/Internal/Base.hs +++ b/hnix-store-core/src/System/Nix/Internal/Base.hs @@ -1,6 +1,10 @@ {-# LANGUAGE CPP #-} module System.Nix.Internal.Base + ( BaseEncoding(Base16,NixBase32,Base64) + , encodeWith + , decodeWith + ) where import qualified Data.Text as T diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index ac373ad..cc7974d 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -25,10 +25,6 @@ import Data.List (foldl') import Data.Text (Text) import qualified Data.Text as T import System.Nix.Internal.Base - ( BaseEncoding(Base16,NixBase32,Base64) - , encodeWith - , decodeWith - ) import Data.Coerce (coerce) import System.Nix.Internal.Truncation (truncateInNixWay) @@ -137,7 +133,7 @@ mkStorePathHash bs = -- -- Use is the same as for 'hash'. This runs in constant space, but -- forces the entire bytestring. -hashLazy :: forall a.ValidAlgo a => BSL.ByteString -> Digest a +hashLazy :: forall a . ValidAlgo a => BSL.ByteString -> Digest a hashLazy bsl = finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl) diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 472e6b2..560c559 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -1,14 +1,14 @@ -{-# LANGUAGE TypeApplications #-} {-| Description : Representation of Nix store paths. -} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE TypeInType #-} -- Needed for GHC 8.4.4 for some reason +{-# LANGUAGE DataKinds #-} module System.Nix.Internal.StorePath where import System.Nix.Internal.Hash ( HashAlgorithm(SHA256) @@ -35,10 +35,7 @@ import qualified Data.Attoparsec.Text.Lazy as Parser.Text.Lazy import qualified System.FilePath as FilePath import Data.Hashable ( Hashable(..) ) import Data.HashSet ( HashSet ) -import System.Nix.Internal.Base ( BaseEncoding(..) - , encodeWith - , decodeWith - ) +import System.Nix.Internal.Base import Data.Coerce ( coerce ) -- | A path in a Nix store. diff --git a/hnix-store-core/tests/Hash.hs b/hnix-store-core/tests/Hash.hs index a578517..6af3af9 100644 --- a/hnix-store-core/tests/Hash.hs +++ b/hnix-store-core/tests/Hash.hs @@ -19,9 +19,7 @@ import Test.Tasty.QuickCheck import System.Nix.Hash import System.Nix.StorePath import Arbitrary -import System.Nix.Internal.Base ( decodeWith - , encodeWith - ) +import System.Nix.Internal.Base import Data.Coerce ( coerce ) spec_hash :: Spec From ef8a2c044c4fe8eeb9f6021226d6f773154d33eb Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 9 Jun 2021 01:44:11 +0300 Subject: [PATCH 15/24] Core: Internal.Base32: explicit export list --- hnix-store-core/src/System/Nix/Internal/Base32.hs | 7 ++++++- hnix-store-core/src/System/Nix/Internal/StorePath.hs | 1 - 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Base32.hs b/hnix-store-core/src/System/Nix/Internal/Base32.hs index 7fe9ab8..3fffe9a 100644 --- a/hnix-store-core/src/System/Nix/Internal/Base32.hs +++ b/hnix-store-core/src/System/Nix/Internal/Base32.hs @@ -1,4 +1,9 @@ -module System.Nix.Internal.Base32 where +module System.Nix.Internal.Base32 + ( encode + , decode + , digits32 + ) +where import Data.Bool ( bool ) diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 560c559..a9bc56c 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -19,7 +19,6 @@ import System.Nix.Internal.Hash ( HashAlgorithm(SHA256) import qualified System.Nix.Internal.Base32 as Nix.Base32 - ( digits32 ) import Data.ByteString ( ByteString ) import qualified Data.ByteString.Char8 as Bytes.Char8 From a2798b034af7fda11133ac1d384af3e1e7620e15 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 9 Jun 2021 01:53:30 +0300 Subject: [PATCH 16/24] Core: Internal.Hash: explicit export list --- hnix-store-core/src/System/Nix/Internal/Hash.hs | 15 ++++++++++++++- .../src/System/Nix/Internal/StorePath.hs | 10 ++-------- 2 files changed, 16 insertions(+), 9 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index cc7974d..1705ef2 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -12,7 +12,20 @@ Description : Cryptographic hashing interface for hnix-store, on top {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE CPP #-} -module System.Nix.Internal.Hash where +module System.Nix.Internal.Hash + ( HashAlgorithm(..) + , ValidAlgo(..) + , NamedAlgo(..) + , hash + , hashLazy + , Digest + , SomeNamedDigest(..) + , mkNamedDigest + , encodeDigestWith + , decodeDigestWith + , mkStorePathHash + ) +where import qualified Crypto.Hash.MD5 as MD5 import qualified Crypto.Hash.SHA1 as SHA1 diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index a9bc56c..bc8ec18 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -11,13 +11,8 @@ Description : Representation of Nix store paths. {-# LANGUAGE DataKinds #-} module System.Nix.Internal.StorePath where -import System.Nix.Internal.Hash ( HashAlgorithm(SHA256) - , Digest - , SomeNamedDigest - , mkStorePathHash - ) - - +import System.Nix.Internal.Hash +import System.Nix.Internal.Base import qualified System.Nix.Internal.Base32 as Nix.Base32 import Data.ByteString ( ByteString ) @@ -34,7 +29,6 @@ import qualified Data.Attoparsec.Text.Lazy as Parser.Text.Lazy import qualified System.FilePath as FilePath import Data.Hashable ( Hashable(..) ) import Data.HashSet ( HashSet ) -import System.Nix.Internal.Base import Data.Coerce ( coerce ) -- | A path in a Nix store. From 099d02dba3e47f241f4a1722baac0b37d890c52f Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 9 Jun 2021 01:55:37 +0300 Subject: [PATCH 17/24] Core: Internal.Signature: explicit export list --- hnix-store-core/src/System/Nix/Internal/Signature.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Signature.hs b/hnix-store-core/src/System/Nix/Internal/Signature.hs index 0dc0ad2..952f45d 100644 --- a/hnix-store-core/src/System/Nix/Internal/Signature.hs +++ b/hnix-store-core/src/System/Nix/Internal/Signature.hs @@ -4,7 +4,11 @@ Description : Nix-relevant interfaces to NaCl signatures. {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} -module System.Nix.Internal.Signature where +module System.Nix.Internal.Signature + ( Signature + , NarSignature(..) + ) +where import Data.ByteString ( ByteString ) From d196ba54487147d1903870d2d5c2fcddf10f2f20 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 9 Jun 2021 01:59:54 +0300 Subject: [PATCH 18/24] Core: Internal.StorePath: explicit export list --- .../src/System/Nix/Internal/StorePath.hs | 23 ++++++++++++++++++- hnix-store-core/src/System/Nix/StorePath.hs | 3 +-- hnix-store-core/tests/Arbitrary.hs | 3 +-- 3 files changed, 24 insertions(+), 5 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index bc8ec18..1d3d047 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -10,7 +10,28 @@ Description : Representation of Nix store paths. {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} -module System.Nix.Internal.StorePath where +module System.Nix.Internal.StorePath + ( -- * Basic store path types + StorePath(..) + , StorePathName(..) + , StorePathSet + , mkStorePathHashPart + , StorePathHashPart(..) + , ContentAddressableAddress(..) + , NarHashMode(..) + , -- * Manipulating 'StorePathName' + makeStorePathName + , validStorePathName + , -- * Rendering out 'StorePath's + storePathToFilePath + , storePathToRawFilePath + , storePathToText + , storePathToNarInfo + , -- * Parsing 'StorePath's + parsePath + , pathParser + ) +where import System.Nix.Internal.Hash import System.Nix.Internal.Base import qualified System.Nix.Internal.Base32 as Nix.Base32 diff --git a/hnix-store-core/src/System/Nix/StorePath.hs b/hnix-store-core/src/System/Nix/StorePath.hs index 6fca8d6..04b74ad 100644 --- a/hnix-store-core/src/System/Nix/StorePath.hs +++ b/hnix-store-core/src/System/Nix/StorePath.hs @@ -4,7 +4,7 @@ Description : Representation of Nix store paths. module System.Nix.StorePath ( -- * Basic store path types StorePath(..) - , StorePathName + , StorePathName(..) , StorePathSet , mkStorePathHashPart , StorePathHashPart(..) @@ -12,7 +12,6 @@ module System.Nix.StorePath , NarHashMode(..) , -- * Manipulating 'StorePathName' makeStorePathName - , unStorePathName , validStorePathName , -- * Rendering out 'StorePath's storePathToFilePath diff --git a/hnix-store-core/tests/Arbitrary.hs b/hnix-store-core/tests/Arbitrary.hs index 6b9e571..d91ba5c 100644 --- a/hnix-store-core/tests/Arbitrary.hs +++ b/hnix-store-core/tests/Arbitrary.hs @@ -11,8 +11,7 @@ import qualified Data.Text as T import Test.Tasty.QuickCheck -import System.Nix.Hash -import System.Nix.StorePath +import System.Nix.Internal.Hash import System.Nix.Internal.StorePath import Control.Applicative ( liftA3 ) import Data.Coerce ( coerce ) From 1200a4839fbe3d04bfa01d9f4cf27b45bbb29f6e Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 9 Jun 2021 02:01:30 +0300 Subject: [PATCH 19/24] Core: Internal.Truncation: explicit export list --- hnix-store-core/src/System/Nix/Internal/Hash.hs | 1 - hnix-store-core/src/System/Nix/Internal/Truncation.hs | 5 ++++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 1705ef2..49ea2d2 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -40,7 +40,6 @@ import qualified Data.Text as T import System.Nix.Internal.Base import Data.Coerce (coerce) import System.Nix.Internal.Truncation - (truncateInNixWay) -- | The universe of supported hash algorithms. -- diff --git a/hnix-store-core/src/System/Nix/Internal/Truncation.hs b/hnix-store-core/src/System/Nix/Internal/Truncation.hs index 0dddd2d..a143f7e 100644 --- a/hnix-store-core/src/System/Nix/Internal/Truncation.hs +++ b/hnix-store-core/src/System/Nix/Internal/Truncation.hs @@ -2,7 +2,10 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE DataKinds #-} -module System.Nix.Internal.Truncation where +module System.Nix.Internal.Truncation + ( truncateInNixWay + ) +where import qualified Data.ByteString as Bytes import Data.Bits (xor) From 8c7dc152d973e9f73919e1a47edc2fedd185e510 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 9 Jun 2021 02:04:20 +0300 Subject: [PATCH 20/24] Core: Internal.Nar.Parser: explicit export list --- hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs b/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs index 0a28fef..88ea42e 100644 --- a/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs +++ b/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs @@ -7,7 +7,13 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -module System.Nix.Internal.Nar.Parser where +module System.Nix.Internal.Nar.Parser + ( runParser + , parseNar + , testParser + , testParser' + ) +where import qualified Algebra.Graph as Graph import qualified Algebra.Graph.ToGraph as Graph From f395a0aba01006341d1dddad5f7f6b8a87255211 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 9 Jun 2021 02:07:00 +0300 Subject: [PATCH 21/24] Core: Internal.Nar.Streamer: explicit export list --- hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs b/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs index f1df605..00fb696 100644 --- a/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs +++ b/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs @@ -3,7 +3,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module System.Nix.Internal.Nar.Streamer where +module System.Nix.Internal.Nar.Streamer + ( streamNarIO + , IsExecutable(..) + ) +where import Control.Monad ( forM_ , when From 3ecbb2f5a592a1e44419e1fe7cd4c9f4de8a7202 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 9 Jun 2021 02:08:34 +0300 Subject: [PATCH 22/24] Core: tests: NarFormat: m clean-up --- hnix-store-core/tests/NarFormat.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/hnix-store-core/tests/NarFormat.hs b/hnix-store-core/tests/NarFormat.hs index 41e136e..382e0b5 100644 --- a/hnix-store-core/tests/NarFormat.hs +++ b/hnix-store-core/tests/NarFormat.hs @@ -26,9 +26,11 @@ import qualified Data.Map as Map import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Encoding as E -import System.Directory (doesDirectoryExist, doesPathExist, - removeDirectoryRecursive, - removeFile) +import System.Directory ( doesDirectoryExist + , doesPathExist + , removeDirectoryRecursive + , removeFile + ) import qualified System.Directory as Directory import System.Environment (getEnv) import System.FilePath ((<.>), ()) From 97146b41cc87327625e02b81971aeb2fd7d66a3f Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 9 Jun 2021 15:24:52 +0300 Subject: [PATCH 23/24] treewide: migrate crypto(hash-* -> nite) Reference: Main cause: https://github.com/haskell-hvr/cryptohash-sha512/issues/7 The whole `cryptohash-*` package family is abandoned, there is no signs of maintainer activity there, so it stopped following Haskell ecosystem & `base` releases. Knowing the human history & situation around it - it would not be reviwed, which gives experience to not hardcode on the (specifically when emotional) dependency. Experience I drawn from this story is to keep things simplier when possible & have more flexible systems as a result code. It was "a bit too much" for what hashing is, for the code to have 2 hashing type systems (external & internal) & reinventment of `HashAlgorithm` type duplicate. The whole code was really rigid with a lot of type applicating the data kinds, those are dependent type features & should be used cautiously, since interface became rigid to changes, so afterwards it is easier & effective to dismantle and recreate the subsystem then to evolve it. Previous hashing history: https://github.com/haskell-nix/hnix-store/issues/156 https://github.com/haskell-nix/hnix-store/issues/142 https://github.com/haskell-nix/hnix-store/pull/93 https://github.com/haskell-nix/hnix-store/issues/92 https://github.com/haskell-nix/hnix-store/issues/90 https://github.com/haskell-nix/hnix-store/issues/83 https://github.com/haskell-nix/hnix-store/pull/64 https://github.com/haskell-nix/hnix-store/pull/38 https://github.com/haskell-nix/hnix-store/pull/32 https://github.com/haskell-nix/hnix-store/pull/31 https://github.com/haskell-nix/hnix-store/pull/28 https://github.com/haskell-nix/hnix-store/pull/27 https://github.com/haskell-nix/hnix-store/pull/25 https://github.com/haskell-nix/hnix-store/issues/18 https://github.com/haskell-nix/hnix-store/pull/14 --- hnix-store-core/hnix-store-core.cabal | 8 +- hnix-store-core/src/System/Nix/Hash.hs | 8 +- .../src/System/Nix/Internal/Hash.hs | 154 ++++-------------- .../src/System/Nix/Internal/StorePath.hs | 9 +- .../src/System/Nix/ReadonlyStore.hs | 27 ++- hnix-store-core/tests/Arbitrary.hs | 7 +- hnix-store-core/tests/Hash.hs | 12 +- 7 files changed, 79 insertions(+), 146 deletions(-) diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index ce73f6e..cd33744 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -56,10 +56,9 @@ library , bytestring , cereal , containers - , cryptohash-md5 - , cryptohash-sha1 - , cryptohash-sha256 - , cryptohash-sha512 + -- Required for cryptonite low-level type convertion + , memory + , cryptonite , directory , filepath , hashable @@ -106,6 +105,7 @@ test-suite format-tests , binary , bytestring , containers + , cryptonite , directory , filepath , process diff --git a/hnix-store-core/src/System/Nix/Hash.hs b/hnix-store-core/src/System/Nix/Hash.hs index 8913348..25f07dd 100644 --- a/hnix-store-core/src/System/Nix/Hash.hs +++ b/hnix-store-core/src/System/Nix/Hash.hs @@ -2,16 +2,10 @@ Description : Cryptographic hashes for hnix-store. -} module System.Nix.Hash - ( Hash.Digest - - , Hash.HashAlgorithm(..) - , Hash.mkStorePathHash - , Hash.ValidAlgo(..) + ( Hash.mkStorePathHash , Hash.NamedAlgo(..) , Hash.SomeNamedDigest(..) - , Hash.hash - , Hash.hashLazy , Hash.mkNamedDigest , Base.BaseEncoding(..) diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 49ea2d2..7be72dd 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -13,12 +13,7 @@ Description : Cryptographic hashing interface for hnix-store, on top {-# LANGUAGE CPP #-} module System.Nix.Internal.Hash - ( HashAlgorithm(..) - , ValidAlgo(..) - , NamedAlgo(..) - , hash - , hashLazy - , Digest + ( NamedAlgo(..) , SomeNamedDigest(..) , mkNamedDigest , encodeDigestWith @@ -27,163 +22,86 @@ module System.Nix.Internal.Hash ) where -import qualified Crypto.Hash.MD5 as MD5 -import qualified Crypto.Hash.SHA1 as SHA1 -import qualified Crypto.Hash.SHA256 as SHA256 -import qualified Crypto.Hash.SHA512 as SHA512 +import qualified Crypto.Hash as C import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BSL -import qualified Data.Hashable as DataHashable -import Data.List (foldl') import Data.Text (Text) import qualified Data.Text as T import System.Nix.Internal.Base -import Data.Coerce (coerce) +import Data.ByteArray import System.Nix.Internal.Truncation --- | The universe of supported hash algorithms. --- --- Currently only intended for use at the type level. -data HashAlgorithm - = MD5 - | SHA1 - | SHA256 - | SHA512 - --- | The result of running a 'HashAlgorithm'. -newtype Digest (a :: HashAlgorithm) = - Digest BS.ByteString deriving (Eq, Ord, DataHashable.Hashable) - -instance Show (Digest a) where - show = ("Digest " <>) . show . encodeDigestWith NixBase32 - --- | The primitive interface for incremental hashing for a given --- 'HashAlgorithm'. Every 'HashAlgorithm' should have an instance. -class ValidAlgo (a :: HashAlgorithm) where - -- | The incremental state for constructing a hash. - type AlgoCtx a - - -- | Start building a new hash. - initialize :: AlgoCtx a - -- | Append a 'BS.ByteString' to the overall contents to be hashed. - update :: AlgoCtx a -> BS.ByteString -> AlgoCtx a - -- | Finish hashing and generate the output. - finalize :: AlgoCtx a -> Digest a - -- | A 'HashAlgorithm' with a canonical name, for serialization -- purposes (e.g. SRI hashes) -class ValidAlgo a => NamedAlgo (a :: HashAlgorithm) where +class C.HashAlgorithm a => NamedAlgo a where algoName :: Text - hashSize :: Int -instance NamedAlgo 'MD5 where +instance NamedAlgo C.MD5 where algoName = "md5" - hashSize = 16 -instance NamedAlgo 'SHA1 where +instance NamedAlgo C.SHA1 where algoName = "sha1" - hashSize = 20 -instance NamedAlgo 'SHA256 where +instance NamedAlgo C.SHA256 where algoName = "sha256" - hashSize = 32 -instance NamedAlgo 'SHA512 where +instance NamedAlgo C.SHA512 where algoName = "sha512" - hashSize = 64 -- | A digest whose 'NamedAlgo' is not known at compile time. -data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (Digest a) +data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (C.Digest a) instance Show SomeNamedDigest where show sd = case sd of - SomeDigest (digest :: Digest hashType) -> T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeDigestWith NixBase32 digest + SomeDigest (digest :: C.Digest hashType) -> T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeDigestWith NixBase32 digest mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest mkNamedDigest name sriHash = let (sriName, h) = T.breakOnEnd "-" sriHash in - if sriName == "" || sriName == (name <> "-") + if sriName == "" || sriName == name <> "-" then mkDigest h else Left $ T.unpack $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name where mkDigest h = case name of - "md5" -> SomeDigest <$> decodeGo @'MD5 h - "sha1" -> SomeDigest <$> decodeGo @'SHA1 h - "sha256" -> SomeDigest <$> decodeGo @'SHA256 h - "sha512" -> SomeDigest <$> decodeGo @'SHA512 h + "md5" -> SomeDigest <$> decodeGo C.MD5 h + "sha1" -> SomeDigest <$> decodeGo C.SHA1 h + "sha256" -> SomeDigest <$> decodeGo C.SHA256 h + "sha512" -> SomeDigest <$> decodeGo C.SHA512 h _ -> Left $ "Unknown hash name: " <> T.unpack name - decodeGo :: forall a . (NamedAlgo a, ValidAlgo a) => Text -> Either String (Digest a) - decodeGo h + decodeGo :: forall a . NamedAlgo a => a -> Text -> Either String (C.Digest a) + decodeGo a h | size == base16Len = decodeDigestWith Base16 h | size == base32Len = decodeDigestWith NixBase32 h | size == base64Len = decodeDigestWith Base64 h | otherwise = Left $ T.unpack sriHash <> " is not a valid " <> T.unpack name <> " hash. Its length (" <> show size <> ") does not match any of " <> show [base16Len, base32Len, base64Len] where size = T.length h - hsize = hashSize @a + hsize = C.hashDigestSize a base16Len = hsize * 2 base32Len = ((hsize * 8 - 1) `div` 5) + 1; base64Len = ((4 * hsize `div` 3) + 3) `div` 4 * 4; --- | Hash an entire (strict) 'BS.ByteString' as a single call. --- --- For example: --- > let d = hash "Hello, sha-256!" :: Digest SHA256 --- or --- > :set -XTypeApplications --- > let d = hash @SHA256 "Hello, sha-256!" -hash :: forall a . ValidAlgo a => BS.ByteString -> Digest a -hash bs = - finalize $ update @a (initialize @a) bs - -mkStorePathHash :: forall a . ValidAlgo a => BS.ByteString -> BS.ByteString +mkStorePathHash :: forall a . C.HashAlgorithm a => BS.ByteString -> BS.ByteString mkStorePathHash bs = - truncateInNixWay 20 $ coerce $ hash @a bs - --- | Hash an entire (lazy) 'BSL.ByteString' as a single call. --- --- Use is the same as for 'hash'. This runs in constant space, but --- forces the entire bytestring. -hashLazy :: forall a . ValidAlgo a => BSL.ByteString -> Digest a -hashLazy bsl = - finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl) - + truncateInNixWay 20 $ convert $ C.hash @BS.ByteString @a bs -- | Take BaseEncoding type of the output -> take the Digeest as input -> encode Digest -encodeDigestWith :: BaseEncoding -> Digest a -> T.Text -encodeDigestWith b = encodeWith b . coerce +encodeDigestWith :: BaseEncoding -> C.Digest a -> T.Text +encodeDigestWith b = encodeWith b . convert -- | Take BaseEncoding type of the input -> take the input itself -> decodeBase into Digest -decodeDigestWith :: BaseEncoding -> T.Text -> Either String (Digest a) -decodeDigestWith b x = Digest <$> decodeWith b x - - --- | Uses "Crypto.Hash.MD5" from cryptohash-md5. -instance ValidAlgo 'MD5 where - type AlgoCtx 'MD5 = MD5.Ctx - initialize = MD5.init - update = MD5.update - finalize = Digest . MD5.finalize - --- | Uses "Crypto.Hash.SHA1" from cryptohash-sha1. -instance ValidAlgo 'SHA1 where - type AlgoCtx 'SHA1 = SHA1.Ctx - initialize = SHA1.init - update = SHA1.update - finalize = Digest . SHA1.finalize - --- | Uses "Crypto.Hash.SHA256" from cryptohash-sha256. -instance ValidAlgo 'SHA256 where - type AlgoCtx 'SHA256 = SHA256.Ctx - initialize = SHA256.init - update = SHA256.update - finalize = Digest . SHA256.finalize - --- | Uses "Crypto.Hash.SHA512" from cryptohash-sha512. -instance ValidAlgo 'SHA512 where - type AlgoCtx 'SHA512 = SHA512.Ctx - initialize = SHA512.init - update = SHA512.update - finalize = Digest . SHA512.finalize +decodeDigestWith :: C.HashAlgorithm a => BaseEncoding -> T.Text -> Either String (C.Digest a) +decodeDigestWith b x = + do + bs <- decodeWith b x + let + toEither = + maybeToRight + ("Cryptonite was not able to convert '(ByteString -> Digest a)' for: '" <> show bs <>"'.") + (toEither . C.digestFromByteString) bs + where + -- To not depend on @extra@ + maybeToRight :: b -> Maybe a -> Either b a + maybeToRight _ (Just r) = pure r + maybeToRight y Nothing = Left y diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index 1d3d047..e232d1a 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -51,6 +51,9 @@ import qualified System.FilePath as FilePath import Data.Hashable ( Hashable(..) ) import Data.HashSet ( HashSet ) import Data.Coerce ( coerce ) +import Crypto.Hash ( SHA256 + , Digest + ) -- | A path in a Nix store. -- @@ -96,7 +99,7 @@ newtype StorePathHashPart = StorePathHashPart ByteString deriving (Eq, Hashable, Ord, Show) mkStorePathHashPart :: ByteString -> StorePathHashPart -mkStorePathHashPart = coerce . mkStorePathHash @'SHA256 +mkStorePathHashPart = coerce . mkStorePathHash @SHA256 -- | A set of 'StorePath's. type StorePathSet = HashSet StorePath @@ -114,7 +117,7 @@ data ContentAddressableAddress = -- | The path is a plain file added via makeTextPath or -- addTextToStore. It is addressed according to a sha256sum of the -- file contents. - Text !(Digest 'SHA256) + Text !(Digest SHA256) | -- | 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'. @@ -134,7 +137,7 @@ data NarHashMode makeStorePathName :: Text -> Either String StorePathName makeStorePathName n = if validStorePathName n - then Right $ StorePathName n + then pure $ StorePathName n else Left $ reasonInvalid n reasonInvalid :: Text -> String diff --git a/hnix-store-core/src/System/Nix/ReadonlyStore.hs b/hnix-store-core/src/System/Nix/ReadonlyStore.hs index 411650b..44d18d0 100644 --- a/hnix-store-core/src/System/Nix/ReadonlyStore.hs +++ b/hnix-store-core/src/System/Nix/ReadonlyStore.hs @@ -17,6 +17,15 @@ import System.Nix.Nar import System.Nix.StorePath import Control.Monad.State.Strict import Data.Coerce ( coerce ) +import Crypto.Hash ( Context + , Digest + , hash + , hashlazy + , hashInit + , hashUpdate + , hashFinalize + , SHA256 + ) makeStorePath @@ -37,11 +46,11 @@ makeStorePath fp ty h nm = StorePath (coerce storeHash) nm fp [ algoName @h , encodeDigestWith Base16 h , T.pack fp - , unStorePathName nm + , coerce nm ] makeTextPath - :: FilePath -> StorePathName -> Digest 'SHA256 -> StorePathSet -> StorePath + :: FilePath -> StorePathName -> Digest SHA256 -> StorePathSet -> StorePath makeTextPath fp nm h refs = makeStorePath fp ty h nm where ty = @@ -61,7 +70,7 @@ makeFixedOutputPath fp recursive h = else makeStorePath fp "output:out" h' where h' = - hash @'SHA256 + hash @ByteString @SHA256 $ "fixed:out:" <> encodeUtf8 (algoName @hashAlgo) <> (if recursive then ":r:" else ":") @@ -83,10 +92,10 @@ computeStorePathForPath name pth recursive _pathFilter _repair = do selectedHash <- if recursive then recursiveContentHash else flatContentHash pure $ makeFixedOutputPath "/nix/store" recursive selectedHash name where - recursiveContentHash :: IO (Digest 'SHA256) - recursiveContentHash = finalize <$> execStateT streamNarUpdate (initialize @'SHA256) - streamNarUpdate :: StateT (AlgoCtx 'SHA256) IO () - streamNarUpdate = streamNarIO (modify . flip (update @'SHA256)) narEffectsIO pth + recursiveContentHash :: IO (Digest SHA256) + recursiveContentHash = hashFinalize <$> execStateT streamNarUpdate (hashInit @SHA256) + streamNarUpdate :: StateT (Context SHA256) IO () + streamNarUpdate = streamNarIO (modify . flip (hashUpdate @ByteString @SHA256)) narEffectsIO pth - flatContentHash :: IO (Digest 'SHA256) - flatContentHash = hashLazy <$> narReadFile narEffectsIO pth + flatContentHash :: IO (Digest SHA256) + flatContentHash = hashlazy <$> narReadFile narEffectsIO pth diff --git a/hnix-store-core/tests/Arbitrary.hs b/hnix-store-core/tests/Arbitrary.hs index d91ba5c..667c9a5 100644 --- a/hnix-store-core/tests/Arbitrary.hs +++ b/hnix-store-core/tests/Arbitrary.hs @@ -11,10 +11,13 @@ import qualified Data.Text as T import Test.Tasty.QuickCheck -import System.Nix.Internal.Hash import System.Nix.Internal.StorePath import Control.Applicative ( liftA3 ) import Data.Coerce ( coerce ) +import Crypto.Hash ( SHA256 + , Digest + , hash + ) genSafeChar :: Gen Char genSafeChar = choose ('\1', '\127') -- ASCII without \NUL @@ -35,7 +38,7 @@ instance Arbitrary StorePathName where instance Arbitrary StorePathHashPart where arbitrary = mkStorePathHashPart . BSC.pack <$> arbitrary -instance Arbitrary (Digest 'SHA256) where +instance Arbitrary (Digest SHA256) where arbitrary = hash . BSC.pack <$> arbitrary newtype NixLike = NixLike {getNixLike :: StorePath} diff --git a/hnix-store-core/tests/Hash.hs b/hnix-store-core/tests/Hash.hs index 6af3af9..e348f20 100644 --- a/hnix-store-core/tests/Hash.hs +++ b/hnix-store-core/tests/Hash.hs @@ -7,6 +7,7 @@ module Hash where import Control.Monad ( forM_ ) +import Data.ByteString ( ByteString ) import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Base16 as B16 import qualified System.Nix.Base32 as B32 @@ -21,6 +22,11 @@ import System.Nix.StorePath import Arbitrary import System.Nix.Internal.Base import Data.Coerce ( coerce ) +import Crypto.Hash ( MD5 + , SHA1 + , SHA256 + , hash + ) spec_hash :: Spec spec_hash = do @@ -28,13 +34,13 @@ spec_hash = do describe "hashing parity with nix-store" $ do it "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\"" $ - shouldBe (encodeDigestWith NixBase32 (hash @'SHA256 "nix-output:foo")) + shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA256 "nix-output:foo")) "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5" it "produces (base16 . md5) of \"Hello World\" the same as the thesis" $ - shouldBe (encodeDigestWith Base16 (hash @'MD5 "Hello World")) + shouldBe (encodeDigestWith Base16 (hash @ByteString @MD5 "Hello World")) "b10a8db164e0754105b7a99be72e3fe5" it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $ - shouldBe (encodeDigestWith NixBase32 (hash @'SHA1 "Hello World")) + shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA1 "Hello World")) "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a" -- The example in question: From e4948a9fe123ef4fc5a73a2370516793150d9bda Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Thu, 10 Jun 2021 15:24:29 +0300 Subject: [PATCH 24/24] Core: upd ChangeLog after migration to cryptonite --- hnix-store-core/ChangeLog.md | 36 ++++++++++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/hnix-store-core/ChangeLog.md b/hnix-store-core/ChangeLog.md index 5d3c26c..aa602a9 100644 --- a/hnix-store-core/ChangeLog.md +++ b/hnix-store-core/ChangeLog.md @@ -1,9 +1,41 @@ -# Revision history for hnix-store-core +# ChangeLog + +## WIP + +* Breaking: + + * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/97146b41cc87327625e02b81971aeb2fd7d66a3f) Migration from packages `cryptohash-` -> `cryptonite`: + `System.Nix.Hash`: + * rm `data HashAlgorithm` in favour of `cryptonite: class HashAlgorithm` + * rm `class ValidAlgo` in favour of `cryptonite: class HashAlgorithm`. + * `class NamedAlgo` removed `hashSize` in favour of `cryptonite: class HashAlgorithm: hashDigestSize`. Former became a subclas of the latter. + * rm `hash` in favour of `cryptonite: hash` + * rm `hashLazy` in favour of `cryptonite: hashlazy` + * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.Hash`: Base encoding/decoding function for hashes changed (due to changes in type system & separation of specially truncated Nix Store hasing): + * `encode(InBase -> DigestWith)` + * `decode(Base -> DigestWith)` + * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.StorePath`: + * rm `type StorePathHashAlgo = 'Truncated 20 'SHA256` in favour of `StorePathHashPart` & `mkStorePathHashPart`. + * rm `unStorePathName`, please use `GHC: coerce` for `StorePathName <-> Text`, `StorePathName` data constructor is provided. + * `Internal` modules now have export lists, if something, please contact. + + +* Additional: + + * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.StorePath`: + * exposed `StorePathName` data constructor to API. + * added `newtype StorePathHashPart = StorePathHashPart ByteString`. + * added builder `mkStorePathHashPart :: ByteString -> StorePathHashPart` + * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.Hash`: + * Nix store (which are specially truncated) hashes are now handled separately from other hashes: + * add `mkStorePathHash` - a function to create a content into Nix storepath-style hash: + `mkStorePathHash :: HashAlgorithm a => ByteString -> ByteString` + but recommend to at once use `mkStorePathHashPart`. + ## [0.4.3.0](https://github.com/haskell-nix/hnix-store/compare/0.4.2.0...0.4.3.0) 2021-05-30 * Additional: - * [(link)](https://github.com/haskell-nix/hnix-store/commit/b85f7c875fe6b0bca939ffbcd8b9bd0ab1598aa0) `System.Nix.ReadonlyStore`: add a readonly `computeStorePathForPath` * [(link)](https://github.com/haskell-nix/hnix-store/commit/db71ecea3109c0ba270fa98a9041a8556e35217f) `System.Nix.ReadonlyStore`: `computeStorePathForPath`: force SHA256 as it's the only valid choice * [(link)](https://github.com/haskell-nix/hnix-store/commit/5fddf3c66ba1bcabb72c4d6b6e09fb41a7acd62c): `makeTextPath`: order the references