diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,9 +1,44 @@ -# Revision history for hnix-store-core +# ChangeLog -## [0.4.3.0](https://github.com/haskell-nix/hnix-store/compare/0.4.2.0...0.4.3.0) 2021-05-30 +## [0.5.0.0](https://github.com/haskell-nix/hnix-store/compare/0.4.3.0...core-0.5.0.0) 2021-06-10 +* Breaking: + + * `System.Nix.Hash`: + * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/97146b41cc87327625e02b81971aeb2fd7d66a3f) Migration from packages `cryptohash-` -> `cryptonite`: + * rm `newtype Digest` in favour of `cryptonite: newtype Digest` + * 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 subclass 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) Base encoding/decoding function for hashes (digests) 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/97146b41cc87327625e02b81971aeb2fd7d66a3f) Support of GHC 9.0. + + * [(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 diff --git a/hnix-store-core.cabal b/hnix-store-core.cabal --- a/hnix-store-core.cabal +++ b/hnix-store-core.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hnix-store-core -version: 0.4.3.0 +version: 0.5.0.0 synopsis: Core effects for interacting with the Nix store. description: This package contains types and functions needed to describe @@ -33,7 +33,9 @@ , System.Nix.Build , System.Nix.Derivation , System.Nix.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 @@ -54,10 +56,9 @@ , bytestring , cereal , containers - , cryptohash-md5 - , cryptohash-sha1 - , cryptohash-sha256 - , cryptohash-sha512 + -- Required for cryptonite low-level type convertion + , memory + , cryptonite , directory , filepath , hashable @@ -104,6 +105,7 @@ , binary , bytestring , containers + , cryptonite , directory , filepath , process diff --git a/src/System/Nix/Hash.hs b/src/System/Nix/Hash.hs --- a/src/System/Nix/Hash.hs +++ b/src/System/Nix/Hash.hs @@ -2,21 +2,17 @@ Description : Cryptographic hashes for hnix-store. -} module System.Nix.Hash - ( Hash.Digest - - , Hash.HashAlgorithm(..) - , Hash.ValidAlgo(..) + ( Hash.mkStorePathHash , Hash.NamedAlgo(..) , Hash.SomeNamedDigest(..) - , Hash.hash - , Hash.hashLazy , Hash.mkNamedDigest - , Hash.BaseEncoding(..) - , Hash.encodeInBase - , Hash.decodeBase + , Base.BaseEncoding(..) + , Hash.encodeDigestWith + , Hash.decodeDigestWith ) where import qualified System.Nix.Internal.Hash as Hash +import qualified System.Nix.Internal.Base as Base diff --git a/src/System/Nix/Internal/Base.hs b/src/System/Nix/Internal/Base.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/Internal/Base.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE CPP #-} + +module System.Nix.Internal.Base + ( BaseEncoding(Base16,NixBase32,Base64) + , encodeWith + , decodeWith + ) +where + +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 + = 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 + +-- | 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/src/System/Nix/Internal/Base32.hs b/src/System/Nix/Internal/Base32.hs --- a/src/System/Nix/Internal/Base32.hs +++ b/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 ) @@ -22,7 +27,7 @@ -- | 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 +48,8 @@ [ 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 $ @@ -54,7 +59,7 @@ decode :: Text -> Either String ByteString decode what = bool - (Left "Invalid Base32 string") + (Left "Invalid NixBase32 string") (unsafeDecode what) (Data.Text.all (`elem` digits32) what) diff --git a/src/System/Nix/Internal/Hash.hs b/src/System/Nix/Internal/Hash.hs --- a/src/System/Nix/Internal/Hash.hs +++ b/src/System/Nix/Internal/Hash.hs @@ -12,223 +12,96 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE CPP #-} -module System.Nix.Internal.Hash where +module System.Nix.Internal.Hash + ( NamedAlgo(..) + , SomeNamedDigest(..) + , mkNamedDigest + , encodeDigestWith + , decodeDigestWith + , mkStorePathHash + ) +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.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 -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 GHC.TypeLits (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 - --- | The universe of supported hash algorithms. --- --- Currently only intended for use at the type level. -data HashAlgorithm - = MD5 - | SHA1 - | SHA256 - | SHA512 - | Truncated 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) = - Digest BS.ByteString deriving (Eq, Ord, DataHashable.Hashable) - -instance Show (Digest a) where - show = ("Digest " <>) . show . encodeInBase Base32 - --- | 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 +import System.Nix.Internal.Base +import Data.ByteArray +import System.Nix.Internal.Truncation -- | 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 <> ":" <> encodeInBase Base32 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 - | size == base16Len = decodeBase Base16 h - | size == base32Len = decodeBase Base32 h - | size == base64Len = decodeBase Base64 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 - --- | 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) - +mkStorePathHash :: forall a . C.HashAlgorithm a => BS.ByteString -> BS.ByteString +mkStorePathHash bs = + truncateInNixWay 20 $ convert $ C.hash @BS.ByteString @a bs -- | 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 Base64 = T.decodeUtf8 . Base64.encode . 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 -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 +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 - lDecode t = case Base16.decode (T.encodeUtf8 t) of - (x, "") -> Right $ Digest x - _ -> Left $ "Unable to decode base16 string" <> T.unpack t -#endif -decodeBase Base32 = fmap Digest . Base32.decode -decodeBase Base64 = fmap Digest . Base64.decode . T.encodeUtf8 - - --- | 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 - --- | Reuses the underlying 'ValidAlgo' instance, but does a --- 'truncateDigest' at the end. -instance (ValidAlgo a, 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 - --- | 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'. -truncateDigest - :: forall n a.(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) - - truncOutputByte :: Int -> Word8 - truncOutputByte i = foldl' (aux i) 0 [0 .. BS.length c - 1] - - inputByte :: Int -> Word8 - inputByte j = BS.index c (fromIntegral 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 + -- 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/src/System/Nix/Internal/Nar/Parser.hs b/src/System/Nix/Internal/Nar/Parser.hs --- a/src/System/Nix/Internal/Nar/Parser.hs +++ b/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 diff --git a/src/System/Nix/Internal/Nar/Streamer.hs b/src/System/Nix/Internal/Nar/Streamer.hs --- a/src/System/Nix/Internal/Nar/Streamer.hs +++ b/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 diff --git a/src/System/Nix/Internal/Signature.hs b/src/System/Nix/Internal/Signature.hs --- a/src/System/Nix/Internal/Signature.hs +++ b/src/System/Nix/Internal/Signature.hs @@ -4,7 +4,11 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} -module System.Nix.Internal.Signature where +module System.Nix.Internal.Signature + ( Signature + , NarSignature(..) + ) +where import Data.ByteString ( ByteString ) diff --git a/src/System/Nix/Internal/StorePath.hs b/src/System/Nix/Internal/StorePath.hs --- a/src/System/Nix/Internal/StorePath.hs +++ b/src/System/Nix/Internal/StorePath.hs @@ -1,29 +1,40 @@ {-| 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 - -module System.Nix.Internal.StorePath where -import System.Nix.Hash ( HashAlgorithm - ( Truncated - , SHA256 - ) - , Digest - , BaseEncoding(..) - , encodeInBase - , decodeBase - , SomeNamedDigest - ) - +{-# LANGUAGE DataKinds #-} +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 - ( digits32 ) import Data.ByteString ( ByteString ) import qualified Data.ByteString.Char8 as Bytes.Char8 @@ -39,6 +50,10 @@ 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. -- @@ -52,7 +67,7 @@ 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,8 +95,12 @@ } 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 @@ -98,7 +117,7 @@ = -- | 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'. @@ -118,7 +137,7 @@ 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 @@ -154,7 +173,7 @@ root <> "/" <> hashPart <> "-" <> name where root = Bytes.Char8.pack storePathRoot - hashPart = Text.encodeUtf8 $ encodeInBase Base32 storePathHash + hashPart = Text.encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash name = Text.encodeUtf8 $ unStorePathName storePathName -- | Render a 'StorePath' as a 'FilePath'. @@ -169,7 +188,7 @@ -- can be used to query binary caches. storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString storePathToNarInfo StorePath{..} = - Text.encodeUtf8 $ encodeInBase Base32 storePathHash <> ".narinfo" + Text.encodeUtf8 $ encodeWith NixBase32 (coerce storePathHash) <> ".narinfo" -- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking -- that store directory matches `expectedRoot`. @@ -177,8 +196,8 @@ parsePath expectedRoot x = let (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x - (digestPart, namePart) = Text.breakOn "-" $ Text.pack fname - digest = decodeBase Base32 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 +207,7 @@ 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 +219,7 @@ "Expecting path separator" digest <- - decodeBase Base32 + decodeWith NixBase32 <$> Parser.Text.Lazy.takeWhile1 (`elem` Nix.Base32.digits32) "Invalid Base32 part" @@ -219,4 +238,4 @@ either fail pure - (StorePath <$> digest <*> name <*> pure expectedRoot) + (StorePath <$> coerce digest <*> name <*> pure expectedRoot) diff --git a/src/System/Nix/Internal/Truncation.hs b/src/System/Nix/Internal/Truncation.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/Internal/Truncation.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} + +module System.Nix.Internal.Truncation + ( truncateInNixWay + ) +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 diff --git a/src/System/Nix/ReadonlyStore.hs b/src/System/Nix/ReadonlyStore.hs --- a/src/System/Nix/ReadonlyStore.hs +++ b/src/System/Nix/ReadonlyStore.hs @@ -16,35 +16,45 @@ 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 - :: 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 - , encodeInBase Base16 h + [ 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 = - BS.intercalate ":" ("text" : sort (fmap storePathToRawFilePath (HS.toList refs))) + BS.intercalate ":" $ "text" : sort (storePathToRawFilePath <$> HS.toList refs) makeFixedOutputPath :: forall hashAlgo @@ -60,11 +70,11 @@ else makeStorePath fp "output:out" h' where h' = - hash @'SHA256 + hash @ByteString @SHA256 $ "fixed:out:" <> encodeUtf8 (algoName @hashAlgo) <> (if recursive then ":r:" else ":") - <> encodeUtf8 (encodeInBase Base16 h) + <> encodeUtf8 (encodeDigestWith Base16 h) <> ":" computeStorePathForText @@ -82,10 +92,10 @@ 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/src/System/Nix/StorePath.hs b/src/System/Nix/StorePath.hs --- a/src/System/Nix/StorePath.hs +++ b/src/System/Nix/StorePath.hs @@ -4,14 +4,14 @@ module System.Nix.StorePath ( -- * Basic store path types StorePath(..) - , StorePathName + , StorePathName(..) , StorePathSet - , StorePathHashAlgo + , mkStorePathHashPart + , StorePathHashPart(..) , ContentAddressableAddress(..) , NarHashMode(..) , -- * Manipulating 'StorePathName' makeStorePathName - , unStorePathName , validStorePathName , -- * Rendering out 'StorePath's storePathToFilePath diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs --- a/tests/Arbitrary.hs +++ b/tests/Arbitrary.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -10,10 +11,13 @@ 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 ) +import Crypto.Hash ( SHA256 + , Digest + , hash + ) genSafeChar :: Gen Char genSafeChar = choose ('\1', '\127') -- ASCII without \NUL @@ -22,7 +26,7 @@ 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,10 +35,10 @@ 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 +instance Arbitrary (Digest SHA256) where arbitrary = hash . BSC.pack <$> arbitrary newtype NixLike = NixLike {getNixLike :: StorePath} @@ -42,15 +46,19 @@ 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/tests/Derivation.hs b/tests/Derivation.hs --- a/tests/Derivation.hs +++ b/tests/Derivation.hs @@ -20,11 +20,11 @@ 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/tests/Hash.hs b/tests/Hash.hs --- a/tests/Hash.hs +++ b/tests/Hash.hs @@ -6,13 +6,13 @@ module Hash where -import Control.Monad (forM_) +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 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 +20,13 @@ import System.Nix.Hash 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 @@ -27,13 +34,13 @@ 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 (encodeDigestWith NixBase32 (hash @ByteString @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 @ByteString @MD5 "Hello World")) "b10a8db164e0754105b7a99be72e3fe5" it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $ - shouldBe (encodeInBase Base32 (hash @'SHA1 "Hello World")) + shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA1 "Hello World")) "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a" -- The example in question: @@ -42,21 +49,17 @@ let exampleStr = "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3" <> "c0d7b98883f9ee3:/nix/store:myfile" - shouldBe (encodeInBase32 @StorePathHashAlgo (hash exampleStr)) + shouldBe (encodeWith NixBase32 $ coerce $ mkStorePathHashPart exampleStr) "xv2iccirbrvklck36f1g7vldn5v58vck" - where - encodeInBase32 :: Digest a -> Text - encodeInBase32 = encodeInBase Base32 -- | 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 :: 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 diff --git a/tests/NarFormat.hs b/tests/NarFormat.hs --- a/tests/NarFormat.hs +++ b/tests/NarFormat.hs @@ -26,9 +26,11 @@ 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 ((<.>), ())