Skip to content

Commit 79f4c0f

Browse files
shlevyshlevy
committed
Clean up Hash module.
2 parents 8cc6595 + 44b97fb commit 79f4c0f

File tree

9 files changed

+128
-168
lines changed

9 files changed

+128
-168
lines changed

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,8 @@ extra-source-files: ChangeLog.md, README.md
1717
cabal-version: >=1.10
1818

1919
library
20-
exposed-modules: System.Nix.Build
20+
exposed-modules: System.Nix.Base32
21+
, System.Nix.Build
2122
, System.Nix.Derivation
2223
, System.Nix.GC
2324
, System.Nix.Hash

‎hnix-store-core/src/System/Nix/Base32.hs‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
{-|
2+
Description: Implementation of Nix's base32 encoding.
3+
-}
4+
module System.Nix.Base32 where
5+
6+
import qualified Data.ByteString as BS
7+
import qualified Data.Text as T
8+
import qualified Data.Vector as V
9+
10+
-- | Encode a 'BS.ByteString' in Nix's base32 encoding
11+
encode :: BS.ByteString -> T.Text
12+
encode c = T.pack $ concatMap char32 [nChar - 1, nChar - 2 .. 0]
13+
where
14+
digits32 = V.fromList "0123456789abcdfghijklmnpqrsvwxyz"
15+
-- The base32 encoding is 8/5's as long as the base256 digest. This `+ 1`
16+
-- `- 1` business is a bit odd, but has always been used in C++ since the
17+
-- base32 truncation was added in was first added in
18+
-- d58a11e019813902b6c4547ca61a127938b2cc20.
19+
nChar = fromIntegral $ ((BS.length c * 8 - 1) `div` 5) + 1
20+
21+
char32 :: Integer -> [Char]
22+
char32 i = [digits32 V.! digitInd]
23+
where
24+
byte j = BS.index c (fromIntegral j)
25+
fromIntegral' :: Num b => Integer -> b
26+
fromIntegral' = fromIntegral
27+
digitInd = fromIntegral' $
28+
sum [fromIntegral (byte j) * (256^j)
29+
| j <- [0 .. BS.length c - 1]]
30+
`div` (32^i)
31+
`mod` 32

‎hnix-store-core/src/System/Nix/Hash.hs‎

Lines changed: 5 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,27 +1,17 @@
11
{-|
22
Description : Cryptographic hashes for hnix-store.
3-
Maintainer : Shea Levy <[email protected]>; Greg Hale <[email protected]>
43
-}
5-
{-# LANGUAGE DataKinds #-}
6-
{-# LANGUAGE TypeApplications #-}
7-
{-# LANGUAGE ScopedTypeVariables #-}
8-
{-# LANGUAGE FlexibleContexts #-}
9-
{-# LANGUAGE TypeApplications #-}
10-
{-# LANGUAGE TypeFamilies #-}
11-
{-# LANGUAGE TypeOperators #-}
12-
{-# LANGUAGE CPP #-}
134
module System.Nix.Hash (
145
HNix.Digest
156

16-
, HNix.HashAlgorithm
17-
, HNix.HashAlgorithm'(..)
18-
, HNix.AlgoVal(..)
19-
, HNix.HasDigest(..)
7+
, HNix.HashAlgorithm(..)
8+
, HNix.ValidAlgo(..)
9+
, HNix.NamedAlgo(..)
2010
, HNix.hash
2111
, HNix.hashLazy
2212

23-
, HNix.printAsBase32
13+
, HNix.encodeBase32
14+
, HNix.encodeBase16
2415
) where
2516

2617
import qualified System.Nix.Internal.Hash as HNix
27-

‎hnix-store-core/src/System/Nix/Internal/Hash.hs‎

Lines changed: 75 additions & 132 deletions
Original file line numberDiff line numberDiff line change
@@ -1,17 +1,13 @@
11
{-|
2-
Description : Cryptographic hashes for hnix-store.
3-
Maintainer : Greg Hale <[email protected]>
2+
Description : Cryptographic hashing interface for hnix-store, on top
3+
of the cryptohash family of libraries.
44
-}
55
{-# LANGUAGE AllowAmbiguousTypes #-}
6-
{-# LANGUAGE DataKinds #-}
76
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
8-
{-# LANGUAGE PolyKinds #-}
9-
{-# LANGUAGE RankNTypes #-}
107
{-# LANGUAGE TypeFamilies #-}
11-
{-# LANGUAGE KindSignatures #-}
128
{-# LANGUAGE ScopedTypeVariables #-}
139
{-# LANGUAGE TypeApplications #-}
14-
{-# LANGUAGE TypeInType #-}
10+
{-# LANGUAGE DataKinds #-}
1511
{-# LANGUAGE OverloadedStrings #-}
1612

1713
module System.Nix.Internal.Hash where
@@ -21,162 +17,129 @@ import qualified Crypto.Hash.SHA1 as SHA1
2117
import qualified Crypto.Hash.SHA256 as SHA256
2218
import qualified Data.ByteString as BS
2319
import qualified Data.ByteString.Base16 as Base16
24-
import qualified Data.ByteString.Char8 as BSC
2520
import Data.Bits (xor)
26-
import qualified Data.ByteString as BS
2721
import qualified Data.ByteString.Lazy as BSL
2822
import qualified Data.Hashable as DataHashable
29-
import Data.Kind (Type)
3023
import Data.List (foldl')
31-
import Data.Monoid
3224
import Data.Proxy (Proxy(Proxy))
3325
import Data.Text (Text)
3426
import qualified Data.Text as T
3527
import qualified Data.Text.Encoding as T
36-
import qualified Data.Vector as V
3728
import Data.Word (Word8)
38-
import GHC.TypeLits
29+
import GHC.TypeLits (Nat, KnownNat, natVal)
30+
import qualified System.Nix.Base32 as Base32
3931

40-
-- | A tag for different hashing algorithms
41-
-- Also used as a type-level tag for hash digests
42-
-- (e.g. @Digest SHA256@ is the type for a sha256 hash)
32+
-- | The universe of supported hash algorithms.
4333
--
44-
-- When used at the type level, `n` is `Nat`
45-
data HashAlgorithm' n
34+
-- Currently only intended for use at the type level.
35+
data HashAlgorithm
4636
= MD5
4737
| SHA1
4838
| SHA256
49-
| Truncated n (HashAlgorithm' n)
50-
deriving (Eq, Show)
51-
52-
class HashAlgoText a where
53-
algoString :: Proxy a -> Text
39+
| Truncated Nat HashAlgorithm
40+
-- ^ The hash algorithm obtained by truncating the result of the
41+
-- input 'HashAlgorithm' to the given number of bytes. See
42+
-- 'truncateDigest' for a description of the truncation algorithm.
43+
44+
-- | The result of running a 'HashAlgorithm'.
45+
newtype Digest (a :: HashAlgorithm) =
46+
Digest BS.ByteString deriving (Show, Eq, Ord, DataHashable.Hashable)
47+
48+
-- | The primitive interface for incremental hashing for a given
49+
-- 'HashAlgorithm'. Every 'HashAlgorithm' should have an instance.
50+
class ValidAlgo (a :: HashAlgorithm) where
51+
-- | The incremental state for constructing a hash.
52+
type AlgoCtx a
53+
54+
-- | Start building a new hash.
55+
initialize :: AlgoCtx a
56+
-- | Append a 'BS.ByteString' to the overall contents to be hashed.
57+
update :: AlgoCtx a -> BS.ByteString -> AlgoCtx a
58+
-- | Finish hashing and generate the output.
59+
finalize :: AlgoCtx a -> Digest a
5460

55-
instance HashAlgoText 'MD5 where
56-
algoString (Proxy :: Proxy 'MD5) = "md5"
61+
-- | A 'HashAlgorithm' with a canonical name, for serialization
62+
-- purposes (e.g. SRI hashes)
63+
class NamedAlgo (a :: HashAlgorithm) where
64+
algoName :: Text
5765

58-
instance HashAlgoText 'SHA1 where
59-
algoString (Proxy :: Proxy 'SHA1) = "sha1"
66+
instance NamedAlgo 'MD5 where
67+
algoName = "md5"
6068

61-
instance HashAlgoText 'SHA256 where
62-
algoString (Proxy :: Proxy 'SHA256) = "sha256"
69+
instance NamedAlgo 'SHA1 where
70+
algoName = "sha1"
6371

64-
type HashAlgorithm = HashAlgorithm' Nat
72+
instance NamedAlgo 'SHA256 where
73+
algoName = "sha256"
6574

66-
-- | Types with kind @HashAlgorithm@ may be a @HasDigest@ instance
67-
-- if they are able to hash bytestrings via the init/update/finalize
68-
-- API of cryptonite
75+
-- | Hash an entire (strict) 'BS.ByteString' as a single call.
6976
--
70-
-- Each instance defined here simply defers to one of the underlying
71-
-- monomorphic hashing libraries, such as `cryptohash-sha256`.
72-
class HasDigest (a :: HashAlgorithm) where
73-
74-
type AlgoCtx a :: Type
75-
76-
initialize :: AlgoCtx a
77-
update :: AlgoCtx a -> BS.ByteString -> AlgoCtx a
78-
finalize :: AlgoCtx a -> Digest a
79-
80-
81-
-- | The cryptographic hash of of a strict bytestring, where hash
82-
-- algorithm is chosen by the type of the digest
8377
-- For example:
8478
-- > let d = hash "Hello, sha-256!" :: Digest SHA256
8579
-- or
8680
-- > :set -XTypeApplications
8781
-- > let d = hash @SHA256 "Hello, sha-256!"
88-
hash :: forall a.HasDigest a => BS.ByteString -> Digest a
82+
hash :: forall a.ValidAlgo a => BS.ByteString -> Digest a
8983
hash bs =
9084
finalize $ update @a (initialize @a) bs
9185

92-
-- | The cryptographic hash of a lazy bytestring. Use is the same
93-
-- as for @hash@. This runs in constant space, but forces the
94-
-- entire bytestring
95-
hashLazy :: forall a.HasDigest a => BSL.ByteString -> Digest a
86+
-- | Hash an entire (lazy) 'BSL.ByteString' as a single call.
87+
--
88+
-- Use is the same as for 'hash'. This runs in constant space, but
89+
-- forces the entire bytestring.
90+
hashLazy :: forall a.ValidAlgo a => BSL.ByteString -> Digest a
9691
hashLazy bsl =
9792
finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl)
9893

99-
digestText32 :: forall a. HashAlgoText a => Digest a -> T.Text
100-
digestText32 d = algoString (Proxy :: Proxy a) <> ":" <> printAsBase32 d
101-
102-
digestText16 :: forall a. HashAlgoText a => Digest a -> T.Text
103-
digestText16 (Digest bs) = algoString (Proxy :: Proxy a) <> ":" <> T.decodeUtf8 (Base16.encode bs)
94+
-- | Encode a 'Digest' in the special Nix base-32 encoding.
95+
encodeBase32 :: Digest a -> T.Text
96+
encodeBase32 (Digest bs) = Base32.encode bs
10497

105-
-- | Convert any Digest to a base32-encoded string.
106-
-- This is not used in producing store path hashes
107-
printAsBase32 :: Digest a -> T.Text
108-
printAsBase32 (Digest bs) = printHashBytes32 bs
98+
-- | Encode a 'Digest' in hex.
99+
encodeBase16 :: Digest a -> T.Text
100+
encodeBase16 (Digest bs) = T.decodeUtf8 (Base16.encode bs)
109101

110-
111-
instance HasDigest MD5 where
102+
-- | Uses "Crypto.Hash.MD5" from cryptohash-md5.
103+
instance ValidAlgo 'MD5 where
112104
type AlgoCtx 'MD5 = MD5.Ctx
113105
initialize = MD5.init
114106
update = MD5.update
115107
finalize = Digest . MD5.finalize
116108

117-
instance HasDigest 'SHA1 where
118-
type AlgoCtx SHA1 = SHA1.Ctx
109+
-- | Uses "Crypto.Hash.SHA1" from cryptohash-sha1.
110+
instance ValidAlgo 'SHA1 where
111+
type AlgoCtx 'SHA1 = SHA1.Ctx
119112
initialize = SHA1.init
120113
update = SHA1.update
121114
finalize = Digest . SHA1.finalize
122115

123-
instance HasDigest 'SHA256 where
124-
type AlgoCtx SHA256 = SHA256.Ctx
116+
-- | Uses "Crypto.Hash.SHA256" from cryptohash-sha256.
117+
instance ValidAlgo 'SHA256 where
118+
type AlgoCtx 'SHA256 = SHA256.Ctx
125119
initialize = SHA256.init
126120
update = SHA256.update
127121
finalize = Digest . SHA256.finalize
128122

129-
instance (HasDigest a, KnownNat n) => HasDigest (Truncated n a) where
130-
type AlgoCtx (Truncated n a) = AlgoCtx a
123+
-- | Reuses the underlying 'ValidAlgo' instance, but does a
124+
-- 'truncateDigest' at the end.
125+
instance (ValidAlgo a, KnownNat n) => ValidAlgo ('Truncated n a) where
126+
type AlgoCtx ('Truncated n a) = AlgoCtx a
131127
initialize = initialize @a
132128
update = update @a
133129
finalize = truncateDigest @n . finalize @a
134130

135-
-- | A raw hash digest, with a type-level tag
136-
newtype Digest (a :: HashAlgorithm) = Digest
137-
{ digestBytes :: BS.ByteString
138-
-- ^ The bytestring in a Digest is an opaque string of bytes,
139-
-- not some particular text encoding.
140-
} deriving (Show, Eq, Ord, DataHashable.Hashable)
141-
142-
143-
-- instance DataHashable.Hashable (Digest a) where
144-
-- hashWithSalt a (Digest bs) = DataHashable.hashWithSalt a bs
145-
-- hashWithSalt = coerce . DataHash
146-
147-
148-
-- | Internal function for encoding bytestrings into base32 according to
149-
-- nix's convention
150-
printHashBytes32 :: BS.ByteString -> T.Text
151-
printHashBytes32 c = T.pack $ concatMap char32 [nChar - 1, nChar - 2 .. 0]
152-
where
153-
-- The base32 encoding is 8/5's as long as the base256 digest. This `+ 1`
154-
-- `- 1` business is a bit odd, but has always been used in C++ since the
155-
-- base32 truncation was added in was first added in
156-
-- d58a11e019813902b6c4547ca61a127938b2cc20.
157-
nChar = fromIntegral $ ((BS.length c * 8 - 1) `div` 5) + 1
158-
159-
char32 :: Integer -> [Char]
160-
char32 i = [digits32 V.! digitInd]
161-
where
162-
byte j = BS.index c (fromIntegral j)
163-
digitInd = fromIntegral $
164-
sum [fromIntegral (byte j) * (256^j)
165-
| j <- [0 .. BS.length c - 1]]
166-
`div` (32^i)
167-
`mod` 32
168-
169-
170-
-- | Internal function for producing the bitwise truncation of bytestrings.
171-
-- When truncation length is greater than the length of the bytestring,
172-
-- but less than twice the bytestring length, truncation splits the
173-
-- bytestring into a head part (truncation length) and tail part (leftover
174-
-- part) right-pads the leftovers with 0 to the truncation length, and
175-
-- combines the two strings bytewise with `xor`
176-
truncateDigest :: forall n a.(HasDigest a, KnownNat n) => Digest a -> Digest (Truncated n a)
177-
truncateDigest (Digest c) = Digest $ BS.pack $ map truncOutputByte [0.. n-1]
131+
-- | Bytewise truncation of a 'Digest'.
132+
--
133+
-- When truncation length is greater than the length of the bytestring
134+
-- but less than twice the bytestring length, truncation splits the
135+
-- bytestring into a head part (truncation length) and tail part
136+
-- (leftover part), right-pads the leftovers with 0 to the truncation
137+
-- length, and combines the two strings bytewise with 'xor'.
138+
truncateDigest
139+
:: forall n a.(KnownNat n) => Digest a -> Digest ('Truncated n a)
140+
truncateDigest (Digest c) =
141+
Digest $ BS.pack $ map truncOutputByte [0.. n-1]
178142
where
179-
180143
n = fromIntegral $ natVal (Proxy @n)
181144

182145
truncOutputByte :: Int -> Word8
@@ -189,23 +152,3 @@ truncateDigest (Digest c) = Digest $ BS.pack $ map truncOutputByte [0.. n-1]
189152
aux i x j = if j `mod` fromIntegral n == fromIntegral i
190153
then xor x (inputByte $ fromIntegral j)
191154
else x
192-
193-
digits32 :: V.Vector Char
194-
digits32 = V.fromList "0123456789abcdfghijklmnpqrsvwxyz"
195-
196-
197-
-- | Convert type-level @HashAlgorithm@ into the value level
198-
class AlgoVal (a :: HashAlgorithm) where
199-
algoVal :: HashAlgorithm' Integer
200-
201-
instance AlgoVal MD5 where
202-
algoVal = MD5
203-
204-
instance AlgoVal SHA1 where
205-
algoVal = SHA1
206-
207-
instance AlgoVal SHA256 where
208-
algoVal = SHA256
209-
210-
instance forall a n.(AlgoVal a, KnownNat n) => AlgoVal (Truncated n a) where
211-
algoVal = Truncated (natVal (Proxy @n)) (algoVal @a)

‎hnix-store-core/src/System/Nix/Path.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ module System.Nix.Path
2020
) where
2121

2222
import System.Nix.Hash (Digest(..),
23-
HashAlgorithm'(Truncated, SHA256))
23+
HashAlgorithm(Truncated, SHA256))
2424
import System.Nix.Internal.Hash
2525
import qualified Data.ByteString as BS
2626
import qualified Data.ByteString.Char8 as BSC
@@ -63,7 +63,7 @@ data Path = Path !(Digest PathHashAlgo) !PathName
6363
deriving (Eq, Ord, Show)
6464

6565
pathToText :: Text -> Path -> Text
66-
pathToText storeDir (Path h nm) = storeDir <> "/" <> printAsBase32 h <> "-" <> pathNameContents nm
66+
pathToText storeDir (Path h nm) = storeDir <> "/" <> encodeBase32 h <> "-" <> pathNameContents nm
6767

6868
type PathSet = HashSet Path
6969

‎hnix-store-core/src/System/Nix/ReadonlyStore.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -10,19 +10,20 @@ import qualified Data.HashSet as HS
1010
import Data.Text (Text)
1111
import qualified Data.Text as T
1212
import Data.Text.Encoding
13-
import System.Nix.Internal.Hash
13+
import System.Nix.Hash
1414
import System.Nix.Path
1515

1616
makeStorePath :: Text -> Text -> Digest 'SHA256 -> Text -> Path
1717
makeStorePath storeDir ty h nm = Path storeHash (PathName nm)
1818
where
1919
s = T.intercalate ":"
2020
[ ty
21-
, digestText16 h
21+
, algoName @'SHA256
22+
, encodeBase16 h
2223
, storeDir
2324
, nm
2425
]
25-
storeHash = truncateDigest $ hash $ encodeUtf8 s
26+
storeHash = hash $ encodeUtf8 s
2627

2728
makeTextPath :: Text -> Text -> Digest 'SHA256 -> PathSet -> Path
2829
makeTextPath storeDir nm h refs = makeStorePath storeDir ty h nm

0 commit comments

Comments
 (0)