1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module : Crypto.Hash
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- Generalized cryptographic hash interface, that you can use with cryptographic hash
-- algorithm that belong to the HashAlgorithm type class.
--
-- > import Crypto.Hash
-- >
-- > sha1 :: ByteString -> Digest SHA1
-- > sha1 = hash
-- >
-- > hexSha3_512 :: ByteString -> String
-- > hexSha3_512 bs = show (hash bs :: Digest SHA3_512)
module Crypto.Hash (
-- * Types
Context,
Digest,
-- * Functions
digestFromByteString,
-- * Hash methods parametrized by algorithm
hashInitWith,
hashWith,
hashPrefixWith,
-- * Hash methods
hashInit,
hashUpdates,
hashUpdate,
hashFinalize,
hashFinalizePrefix,
hashBlockSize,
hashDigestSize,
hash,
hashPrefix,
hashlazy,
-- * Hash algorithms
module Crypto.Hash.Algorithms,
) where
import Basement.Block (Block, unsafeFreeze)
import Basement.Block.Mutable (copyFromPtr, new)
import Basement.Types.OffsetSize (CountOf (..))
import Crypto.Hash.Algorithms
import Crypto.Hash.Types
import Crypto.Internal.ByteArray (ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Compat (unsafeDoIO)
import qualified Data.ByteString.Lazy as L
import Data.Int (Int32)
import Data.Word (Word8)
import Foreign.Ptr (Ptr, plusPtr)
-- | Hash a strict bytestring into a digest.
hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a
hash bs = hashFinalize $ hashUpdate hashInit bs
-- | Hash the first N bytes of a bytestring, with code path independent from N.
hashPrefix
:: (ByteArrayAccess ba, HashAlgorithmPrefix a) => ba -> Int -> Digest a
hashPrefix = hashFinalizePrefix hashInit
-- | Hash a lazy bytestring into a digest.
hashlazy :: HashAlgorithm a => L.ByteString -> Digest a
hashlazy lbs = hashFinalize $ hashUpdates hashInit (L.toChunks lbs)
-- | Initialize a new context for this hash algorithm
hashInit :: forall a. HashAlgorithm a => Context a
hashInit = Context $ B.allocAndFreeze (hashInternalContextSize (undefined :: a)) $ \(ptr :: Ptr (Context a)) ->
hashInternalInit ptr
-- | run hashUpdates on one single bytestring and return the updated context.
hashUpdate
:: (ByteArrayAccess ba, HashAlgorithm a) => Context a -> ba -> Context a
hashUpdate ctx b
| B.null b = ctx
| otherwise = hashUpdates ctx [b]
-- | Update the context with a list of strict bytestring,
-- and return a new context with the updates.
hashUpdates
:: forall a ba
. (HashAlgorithm a, ByteArrayAccess ba)
=> Context a
-> [ba]
-> Context a
hashUpdates c l
| null ls = c
| otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) ->
mapM_ (\b -> B.withByteArray b (processBlocks ctx (B.length b))) ls
where
ls = filter (not . B.null) l
-- process the data in 2GB chunks to fit in uint32_t and Int on 32 bit systems
processBlocks ctx bytesLeft dataPtr
| bytesLeft == 0 = return ()
| otherwise = do
hashInternalUpdate ctx dataPtr (fromIntegral actuallyProcessed)
processBlocks
ctx
(bytesLeft - actuallyProcessed)
(dataPtr `plusPtr` actuallyProcessed)
where
actuallyProcessed = min bytesLeft (fromIntegral (maxBound :: Int32))
-- | Finalize a context and return a digest.
hashFinalize
:: forall a
. HashAlgorithm a
=> Context a
-> Digest a
hashFinalize !c =
Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do
((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig
return ()
-- | Update the context with the first N bytes of a bytestring and return the
-- digest. The code path is independent from N but much slower than a normal
-- 'hashUpdate'. The function can be called for the last bytes of a message, in
-- order to exclude a variable padding, without leaking the padding length. The
-- begining of the message, never impacted by the padding, should preferably go
-- through 'hashUpdate' for better performance.
hashFinalizePrefix
:: forall a ba
. (HashAlgorithmPrefix a, ByteArrayAccess ba)
=> Context a
-> ba
-> Int
-> Digest a
hashFinalizePrefix !c b len =
Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do
((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) ->
B.withByteArray b $ \d ->
hashInternalFinalizePrefix
ctx
d
(fromIntegral $ B.length b)
(fromIntegral len)
dig
return ()
-- | Initialize a new context for a specified hash algorithm
hashInitWith :: HashAlgorithm alg => alg -> Context alg
hashInitWith _ = hashInit
-- | Run the 'hash' function but takes an explicit hash algorithm parameter
hashWith :: (ByteArrayAccess ba, HashAlgorithm alg) => alg -> ba -> Digest alg
hashWith _ = hash
-- | Run the 'hashPrefix' function but takes an explicit hash algorithm parameter
hashPrefixWith
:: (ByteArrayAccess ba, HashAlgorithmPrefix alg) => alg -> ba -> Int -> Digest alg
hashPrefixWith _ = hashPrefix
-- | Try to transform a bytearray into a Digest of specific algorithm.
--
-- If the digest is not the right size for the algorithm specified, then
-- Nothing is returned.
digestFromByteString
:: forall a ba. (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a)
digestFromByteString = from undefined
where
from :: a -> ba -> Maybe (Digest a)
from alg bs
| B.length bs == (hashDigestSize alg) =
Just $ Digest $ unsafeDoIO $ copyBytes bs
| otherwise = Nothing
copyBytes :: ba -> IO (Block Word8)
copyBytes ba = do
muArray <- new count
B.withByteArray ba $ \ptr -> copyFromPtr ptr muArray 0 count
unsafeFreeze muArray
where
count = CountOf (B.length ba)
|
