@@ -13,12 +13,7 @@ Description : Cryptographic hashing interface for hnix-store, on top
1313{-# LANGUAGE CPP #-}
1414
1515module System.Nix.Internal.Hash
16- ( HashAlgorithm (.. )
17- , ValidAlgo (.. )
18- , NamedAlgo (.. )
19- , hash
20- , hashLazy
21- , Digest
16+ ( NamedAlgo (.. )
2217 , SomeNamedDigest (.. )
2318 , mkNamedDigest
2419 , encodeDigestWith
@@ -27,163 +22,86 @@ module System.Nix.Internal.Hash
2722 )
2823where
2924
30- import qualified Crypto.Hash.MD5 as MD5
31- import qualified Crypto.Hash.SHA1 as SHA1
32- import qualified Crypto.Hash.SHA256 as SHA256
33- import qualified Crypto.Hash.SHA512 as SHA512
25+ import qualified Crypto.Hash as C
3426import qualified Data.ByteString as BS
35- import qualified Data.ByteString.Lazy as BSL
36- import qualified Data.Hashable as DataHashable
37- import Data.List (foldl' )
3827import Data.Text (Text )
3928import qualified Data.Text as T
4029import System.Nix.Internal.Base
41- import Data.Coerce ( coerce )
30+ import Data.ByteArray
4231import System.Nix.Internal.Truncation
4332
44- -- | The universe of supported hash algorithms.
45- --
46- -- Currently only intended for use at the type level.
47- data HashAlgorithm
48- = MD5
49- | SHA1
50- | SHA256
51- | SHA512
52-
53- -- | The result of running a 'HashAlgorithm'.
54- newtype Digest (a :: HashAlgorithm ) =
55- Digest BS. ByteString deriving (Eq , Ord , DataHashable.Hashable )
56-
57- instance Show (Digest a ) where
58- show = (" Digest " <> ) . show . encodeDigestWith NixBase32
59-
60- -- | The primitive interface for incremental hashing for a given
61- -- 'HashAlgorithm'. Every 'HashAlgorithm' should have an instance.
62- class ValidAlgo (a :: HashAlgorithm ) where
63- -- | The incremental state for constructing a hash.
64- type AlgoCtx a
65-
66- -- | Start building a new hash.
67- initialize :: AlgoCtx a
68- -- | Append a 'BS.ByteString' to the overall contents to be hashed.
69- update :: AlgoCtx a -> BS. ByteString -> AlgoCtx a
70- -- | Finish hashing and generate the output.
71- finalize :: AlgoCtx a -> Digest a
72-
7333-- | A 'HashAlgorithm' with a canonical name, for serialization
7434-- purposes (e.g. SRI hashes)
75- class ValidAlgo a => NamedAlgo ( a :: HashAlgorithm ) where
35+ class C. HashAlgorithm a => NamedAlgo a where
7636 algoName :: Text
77- hashSize :: Int
7837
79- instance NamedAlgo ' MD5 where
38+ instance NamedAlgo C. MD5 where
8039 algoName = " md5"
81- hashSize = 16
8240
83- instance NamedAlgo ' SHA1 where
41+ instance NamedAlgo C. SHA1 where
8442 algoName = " sha1"
85- hashSize = 20
8643
87- instance NamedAlgo ' SHA256 where
44+ instance NamedAlgo C. SHA256 where
8845 algoName = " sha256"
89- hashSize = 32
9046
91- instance NamedAlgo ' SHA512 where
47+ instance NamedAlgo C. SHA512 where
9248 algoName = " sha512"
93- hashSize = 64
9449
9550-- | A digest whose 'NamedAlgo' is not known at compile time.
96- data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (Digest a )
51+ data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (C. Digest a )
9752
9853instance Show SomeNamedDigest where
9954 show sd = case sd of
100- SomeDigest (digest :: Digest hashType ) -> T. unpack $ " SomeDigest " <> algoName @ hashType <> " :" <> encodeDigestWith NixBase32 digest
55+ SomeDigest (digest :: C. Digest hashType ) -> T. unpack $ " SomeDigest " <> algoName @ hashType <> " :" <> encodeDigestWith NixBase32 digest
10156
10257mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest
10358mkNamedDigest name sriHash =
10459 let (sriName, h) = T. breakOnEnd " -" sriHash in
105- if sriName == " " || sriName == ( name <> " -" )
60+ if sriName == " " || sriName == name <> " -"
10661 then mkDigest h
10762 else Left $ T. unpack $ " Sri hash method " <> sriName <> " does not match the required hash type " <> name
10863 where
10964 mkDigest h = case name of
110- " md5" -> SomeDigest <$> decodeGo @ ' MD5 h
111- " sha1" -> SomeDigest <$> decodeGo @ ' SHA1 h
112- " sha256" -> SomeDigest <$> decodeGo @ ' SHA256 h
113- " sha512" -> SomeDigest <$> decodeGo @ ' SHA512 h
65+ " md5" -> SomeDigest <$> decodeGo C. MD5 h
66+ " sha1" -> SomeDigest <$> decodeGo C. SHA1 h
67+ " sha256" -> SomeDigest <$> decodeGo C. SHA256 h
68+ " sha512" -> SomeDigest <$> decodeGo C. SHA512 h
11469 _ -> Left $ " Unknown hash name: " <> T. unpack name
115- decodeGo :: forall a . ( NamedAlgo a , ValidAlgo a ) = > Text -> Either String (Digest a )
116- decodeGo h
70+ decodeGo :: forall a . NamedAlgo a => a - > Text -> Either String (C. Digest a )
71+ decodeGo a h
11772 | size == base16Len = decodeDigestWith Base16 h
11873 | size == base32Len = decodeDigestWith NixBase32 h
11974 | size == base64Len = decodeDigestWith Base64 h
12075 | 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]
12176 where
12277 size = T. length h
123- hsize = hashSize @ a
78+ hsize = C. hashDigestSize a
12479 base16Len = hsize * 2
12580 base32Len = ((hsize * 8 - 1 ) `div` 5 ) + 1 ;
12681 base64Len = ((4 * hsize `div` 3 ) + 3 ) `div` 4 * 4 ;
12782
12883
129- -- | Hash an entire (strict) 'BS.ByteString' as a single call.
130- --
131- -- For example:
132- -- > let d = hash "Hello, sha-256!" :: Digest SHA256
133- -- or
134- -- > :set -XTypeApplications
135- -- > let d = hash @SHA256 "Hello, sha-256!"
136- hash :: forall a . ValidAlgo a => BS. ByteString -> Digest a
137- hash bs =
138- finalize $ update @ a (initialize @ a ) bs
139-
140- mkStorePathHash :: forall a . ValidAlgo a => BS. ByteString -> BS. ByteString
84+ mkStorePathHash :: forall a . C. HashAlgorithm a => BS. ByteString -> BS. ByteString
14185mkStorePathHash bs =
142- truncateInNixWay 20 $ coerce $ hash @ a bs
143-
144- -- | Hash an entire (lazy) 'BSL.ByteString' as a single call.
145- --
146- -- Use is the same as for 'hash'. This runs in constant space, but
147- -- forces the entire bytestring.
148- hashLazy :: forall a . ValidAlgo a => BSL. ByteString -> Digest a
149- hashLazy bsl =
150- finalize $ foldl' (update @ a ) (initialize @ a ) (BSL. toChunks bsl)
151-
86+ truncateInNixWay 20 $ convert $ C. hash @ BS. ByteString @ a bs
15287
15388-- | Take BaseEncoding type of the output -> take the Digeest as input -> encode Digest
154- encodeDigestWith :: BaseEncoding -> Digest a -> T. Text
155- encodeDigestWith b = encodeWith b . coerce
89+ encodeDigestWith :: BaseEncoding -> C. Digest a -> T. Text
90+ encodeDigestWith b = encodeWith b . convert
15691
15792
15893-- | Take BaseEncoding type of the input -> take the input itself -> decodeBase into Digest
159- decodeDigestWith :: BaseEncoding -> T. Text -> Either String (Digest a )
160- decodeDigestWith b x = Digest <$> decodeWith b x
161-
162-
163- -- | Uses "Crypto.Hash.MD5" from cryptohash-md5.
164- instance ValidAlgo 'MD5 where
165- type AlgoCtx 'MD5 = MD5. Ctx
166- initialize = MD5. init
167- update = MD5. update
168- finalize = Digest . MD5. finalize
169-
170- -- | Uses "Crypto.Hash.SHA1" from cryptohash-sha1.
171- instance ValidAlgo 'SHA1 where
172- type AlgoCtx 'SHA1 = SHA1. Ctx
173- initialize = SHA1. init
174- update = SHA1. update
175- finalize = Digest . SHA1. finalize
176-
177- -- | Uses "Crypto.Hash.SHA256" from cryptohash-sha256.
178- instance ValidAlgo 'SHA256 where
179- type AlgoCtx 'SHA256 = SHA256. Ctx
180- initialize = SHA256. init
181- update = SHA256. update
182- finalize = Digest . SHA256. finalize
183-
184- -- | Uses "Crypto.Hash.SHA512" from cryptohash-sha512.
185- instance ValidAlgo 'SHA512 where
186- type AlgoCtx 'SHA512 = SHA512. Ctx
187- initialize = SHA512. init
188- update = SHA512. update
189- finalize = Digest . SHA512. finalize
94+ decodeDigestWith :: C. HashAlgorithm a => BaseEncoding -> T. Text -> Either String (C. Digest a )
95+ decodeDigestWith b x =
96+ do
97+ bs <- decodeWith b x
98+ let
99+ toEither =
100+ maybeToRight
101+ (" Cryptonite was not able to convert '(ByteString -> Digest a)' for: '" <> show bs <> " '." )
102+ (toEither . C. digestFromByteString) bs
103+ where
104+ -- To not depend on @extra@
105+ maybeToRight :: b -> Maybe a -> Either b a
106+ maybeToRight _ (Just r) = pure r
107+ maybeToRight y Nothing = Left y
0 commit comments