Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 615 lines (543 sloc) 22.16 kB
e6acf42 @TomMD Fixed compilation error due to tagged module split
authored
1 {-# LANGUAGE CPP #-}
6355636 @TomMD Haddock headers
authored
2 {-|
3 Maintainer: Thomas.DuBuisson@gmail.com
4 Stability: beta
5 Portability: portable
de5c33d @TomMD Add klondikes modes patch
authored
6 Authors: Thomas DuBuisson, Francisco Blas Izquierdo Riera (klondike)
6355636 @TomMD Haddock headers
authored
7
6beed7f @TomMD Documentation fixes
authored
8
9 Generic mode implementations useable by any correct BlockCipher
10 instance Be aware there are no tests for CFB mode yet. See
11 'Test.Crypto'.
9f570a7 @TomMD Fix up the documentation
authored
12 -}
6beed7f @TomMD Documentation fixes
authored
13 module Crypto.Modes (
de5c33d @TomMD Add klondikes modes patch
authored
14 -- * Initialization Vector Type, Modifiers (for all ciphers, all modes that use IVs)
d30f98c @TomMD Improve haddock organization
authored
15 IV
de5c33d @TomMD Add klondikes modes patch
authored
16 , getIV, getIVIO, zeroIV
17 , incIV, dblIV
18 -- * Blockcipher modes. Names with a prime (') means strict, without a prime means lazy bytestrings.
d30f98c @TomMD Improve haddock organization
authored
19 , ecb, unEcb
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
20 , cbc, unCbc
21 , cfb, unCfb
22 , ofb, unOfb
23 , ecb', unEcb'
24 , cbc', unCbc'
25 , cfb', unCfb'
26 , ofb', unOfb'
de5c33d @TomMD Add klondikes modes patch
authored
27 , ctr, unCtr, ctr', unCtr'
28 , siv, unSiv, siv', unSiv'
d30f98c @TomMD Improve haddock organization
authored
29 -- * Authentication modes
de5c33d @TomMD Add klondikes modes patch
authored
30 , cbcMac', cbcMac, cMac, cMac'
d30f98c @TomMD Improve haddock organization
authored
31 -- * Combined modes (nothing here yet)
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
32 -- , gmc
33 -- , xts
34 -- , ccm
35 ) where
36
37 import qualified Data.ByteString as B
38 import qualified Data.ByteString.Lazy as L
39 import Data.Serialize
8729714 @TomMD Add instances, comments, finalize types
authored
40 import qualified Data.Serialize.Put as SP
41 import qualified Data.Serialize.Get as SG
de5c33d @TomMD Add klondikes modes patch
authored
42 import Data.Bits (xor, shift, (.&.), (.|.), testBit, setBit, clearBit, Bits, complementBit)
49906b5 @TomMD Remove need for ScopedTypeVariables extension in Crypto.Modes
authored
43 import Data.Tagged
da20109 @TomMD Moved from Data.Crypto.* to Crypto.* module names. Renamed RandomGen…
authored
44 import Crypto.Classes
45 import Crypto.Random
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
46 import Crypto.Util
de5c33d @TomMD Add klondikes modes patch
authored
47 import Crypto.CPoly
f75779a @TomMD Move to using entropy package. Remove optimization till GHC mem usag…
authored
48 import System.Entropy (getEntropy)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
49 import Control.Monad (liftM, forM_)
de5c33d @TomMD Add klondikes modes patch
authored
50 import Data.List (genericDrop)
51 import Data.Word (Word8)
52 import Data.List (genericDrop,genericReplicate,genericLength)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
53
e6acf42 @TomMD Fixed compilation error due to tagged module split
authored
54 #if MIN_VERSION_tagged(0,2,0)
55 import Data.Proxy
56 #endif
57
6beed7f @TomMD Documentation fixes
authored
58 -- |Initilization Vectors for BlockCipher implementations (IV k) are
59 -- used for various modes and guarrenteed to be blockSize bits long.
60 -- The common ways to obtain an IV are to generate one ('getIV' or
61 -- 'getIVIO') or to use one provided with the ciphertext (using the
62 -- 'Serialize' instance of IV).
de5c33d @TomMD Add klondikes modes patch
authored
63 --
6beed7f @TomMD Documentation fixes
authored
64 -- 'zeroIV' also exists and is of particular use for starting 'ctr'
65 -- mode with a fresh key.
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
66 data IV k = IV { initializationVector :: {-# UNPACK #-} !B.ByteString } deriving (Eq, Ord, Show)
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
67
02a3f5a @TomMD Fix OFB, AES OFB tests now work
authored
68 -- gather a specified number of bytes from the list of bytestrings
8729714 @TomMD Add instances, comments, finalize types
authored
69 collect :: Int -> [B.ByteString] -> [B.ByteString]
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
70 collect 0 _ = []
71 collect _ [] = []
72 collect i (b:bs)
73 | len < i = b : collect (i - len) bs
74 | len >= i = [B.take i b]
75 where
76 len = B.length b
77 {-# INLINE collect #-}
78
79 chunkFor :: (BlockCipher k) => k -> L.ByteString -> [B.ByteString]
8729714 @TomMD Add instances, comments, finalize types
authored
80 chunkFor k = go
81 where
82 blkSz = (blockSize `for` k) `div` 8
83 blkSzI = fromIntegral blkSz
84 go bs | L.length bs < blkSzI = []
85 | otherwise = let (blk,rest) = L.splitAt blkSzI bs in B.concat (L.toChunks blk) : go rest
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
86 {-# INLINE chunkFor #-}
87
88 chunkFor' :: (BlockCipher k) => k -> B.ByteString -> [B.ByteString]
8729714 @TomMD Add instances, comments, finalize types
authored
89 chunkFor' k = go
90 where
91 blkSz = (blockSize `for` k) `div` 8
92 go bs | B.length bs < blkSz = []
93 | otherwise = let (blk,rest) = B.splitAt blkSz bs in blk : go rest
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
94 {-# INLINE chunkFor' #-}
95
8729714 @TomMD Add instances, comments, finalize types
authored
96 -- |zipWith xor + Pack
6beed7f @TomMD Documentation fixes
authored
97 --
98 -- This is written intentionally to take advantage
99 -- of the bytestring libraries 'zipWith'' rewrite rule but at the
100 -- extra cost of the resulting lazy bytestring being more fragmented
101 -- than either of the two inputs.
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
102 zwp :: L.ByteString -> L.ByteString -> L.ByteString
8729714 @TomMD Add instances, comments, finalize types
authored
103 zwp a b =
104 let as = L.toChunks a
105 bs = L.toChunks b
106 in L.fromChunks (go as bs)
107 where
108 go [] _ = []
109 go _ [] = []
110 go (a:as) (b:bs) =
111 let l = min (B.length a) (B.length b)
112 (a',ar) = B.splitAt l a
113 (b',br) = B.splitAt l b
114 as' = if B.length ar == 0 then as else ar : as
115 bs' = if B.length br == 0 then bs else br : bs
116 in (zwp' a' b') : go as' bs'
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
117 {-# INLINEABLE zwp #-}
8729714 @TomMD Add instances, comments, finalize types
authored
118
119 -- |zipWith xor + Pack
6beed7f @TomMD Documentation fixes
authored
120 --
121 -- As a result of rewrite rules, this should automatically be
122 -- optimized (at compile time) to use the bytestring libraries
123 -- 'zipWith'' function.
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
124 zwp' :: B.ByteString -> B.ByteString -> B.ByteString
8729714 @TomMD Add instances, comments, finalize types
authored
125 zwp' a = B.pack . B.zipWith xor a
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
126 {-# INLINEABLE zwp' #-}
8729714 @TomMD Add instances, comments, finalize types
authored
127
128 -- |Cipher block chaining encryption mode on strict bytestrings
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
129 cbc' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)
8729714 @TomMD Add instances, comments, finalize types
authored
130 cbc' k (IV v) plaintext =
131 let blks = chunkFor' k plaintext
132 (cts, iv) = go blks v
133 in (B.concat cts, IV iv)
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
134 where
8729714 @TomMD Add instances, comments, finalize types
authored
135 go [] iv = ([], iv)
136 go (b:bs) iv =
137 let c = encryptBlock k (zwp' iv b)
138 (cs, ivFinal) = go bs c
139 in (c:cs, ivFinal)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
140 {-# INLINEABLE cbc' #-}
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
141
779671d @TomMD Add Typeable and Exception instances for GenError.
authored
142 -- |Cipher block chaining message authentication
c19d33f @TomMD add cbcMac functions
authored
143 cbcMac' :: BlockCipher k => k -> B.ByteString -> B.ByteString
de5c33d @TomMD Add klondikes modes patch
authored
144 cbcMac' k pt = encode $ snd $ cbc' k zeroIV pt
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
145 {-# INLINEABLE cbcMac' #-}
c19d33f @TomMD add cbcMac functions
authored
146
779671d @TomMD Add Typeable and Exception instances for GenError.
authored
147 -- |Cipher block chaining message authentication
c19d33f @TomMD add cbcMac functions
authored
148 cbcMac :: BlockCipher k => k -> L.ByteString -> L.ByteString
de5c33d @TomMD Add klondikes modes patch
authored
149 cbcMac k pt = L.fromChunks [encode $ snd $ cbc k zeroIV pt]
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
150 {-# INLINEABLE cbcMac #-}
c19d33f @TomMD add cbcMac functions
authored
151
8729714 @TomMD Add instances, comments, finalize types
authored
152 -- |Cipher block chaining decryption for strict bytestrings
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
153 unCbc' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
154 unCbc' k (IV v) ciphertext =
8729714 @TomMD Add instances, comments, finalize types
authored
155 let blks = chunkFor' k ciphertext
156 (pts, iv) = go blks v
157 in (B.concat pts, IV iv)
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
158 where
8729714 @TomMD Add instances, comments, finalize types
authored
159 go [] iv = ([], iv)
160 go (c:cs) iv =
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
161 let p = zwp' (decryptBlock k c) iv
8729714 @TomMD Add instances, comments, finalize types
authored
162 (ps, ivFinal) = go cs c
163 in (p:ps, ivFinal)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
164 {-# INLINEABLE unCbc' #-}
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
165
8729714 @TomMD Add instances, comments, finalize types
authored
166 -- |Cipher block chaining encryption for lazy bytestrings
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
167 cbc :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
168 cbc k (IV v) plaintext =
8729714 @TomMD Add instances, comments, finalize types
authored
169 let blks = chunkFor k plaintext
170 (cts, iv) = go blks v
171 in (L.fromChunks cts, IV iv)
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
172 where
8729714 @TomMD Add instances, comments, finalize types
authored
173 go [] iv = ([], iv)
174 go (b:bs) iv =
175 let c = encryptBlock k (zwp' iv b)
176 (cs, ivFinal) = go bs c
177 in (c:cs, ivFinal)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
178 {-# INLINEABLE cbc #-}
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
179
8729714 @TomMD Add instances, comments, finalize types
authored
180 -- |Cipher block chaining decryption for lazy bytestrings
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
181 unCbc :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
182 unCbc k (IV v) ciphertext =
8729714 @TomMD Add instances, comments, finalize types
authored
183 let blks = chunkFor k ciphertext
184 (pts, iv) = go blks v
185 in (L.fromChunks pts, IV iv)
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
186 where
8729714 @TomMD Add instances, comments, finalize types
authored
187 go [] iv = ([], iv)
188 go (c:cs) iv =
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
189 let p = zwp' (decryptBlock k c) iv
8729714 @TomMD Add instances, comments, finalize types
authored
190 (ps, ivFinal) = go cs c
191 in (p:ps, ivFinal)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
192 {-# INLINEABLE unCbc #-}
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
193
de5c33d @TomMD Add klondikes modes patch
authored
194 -- |Counter mode for lazy bytestrings
195 ctr :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> L.ByteString -> (L.ByteString, IV k)
196 ctr = unCtr
197
198 -- |Counter mode for lazy bytestrings
199 unCtr :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> L.ByteString -> (L.ByteString, IV k)
200 unCtr f k (IV iv) msg =
201 let ivStr = iterate f $ IV iv
202 ivLen = fromIntegral $ B.length iv
203 newIV = head $ genericDrop ((ivLen - 1 + L.length msg) `div` ivLen) ivStr
204 in (zwp (L.fromChunks $ map (encryptBlock k) $ map initializationVector ivStr) msg, newIV)
205
206 -- |Counter mode for strict bytestrings
207 ctr' :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> B.ByteString -> (B.ByteString, IV k)
208 ctr' = unCtr'
209
210 -- |Counter mode for strict bytestrings
211 unCtr' :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> B.ByteString -> (B.ByteString, IV k)
212 unCtr' f k (IV iv) msg =
213 let ivStr = iterate f $ IV iv
214 ivLen = fromIntegral $ B.length iv
215 newIV = head $ genericDrop ((ivLen - 1 + B.length msg) `div` ivLen) ivStr
216 in (zwp' (B.concat $ collect (B.length msg) (map (encryptBlock k . initializationVector) ivStr)) msg, newIV)
217
6beed7f @TomMD Documentation fixes
authored
218 -- |Generate cmac subkeys. The usage of seq tries to force evaluation
219 -- of both keys avoiding posible timing attacks
de5c33d @TomMD Add klondikes modes patch
authored
220 cMacSubk :: BlockCipher k => k -> (IV k, IV k)
221 cMacSubk k = (k1, k2) `seq` (k1, k2)
222 where
223 bSize = blockSizeBytes `for` k
224 k1 = dblIV $ IV $ encryptBlock k $ B.replicate bSize 0
225 k2 = dblIV $ k1
226
6beed7f @TomMD Documentation fixes
authored
227 -- |Pad the string as required by the cmac algorithm. In theory this
228 -- should work at bit level but since the API works at byte level we
229 -- do the same
de5c33d @TomMD Add klondikes modes patch
authored
230 cMacPad :: ([Word8], Bool, Int) -> Maybe (Word8,([Word8], Bool, Int))
231 cMacPad (_, _, 0) = Nothing
232 cMacPad ([], False, n) = Just (0,([], False, n-1))
233 cMacPad ([], True, n) = Just (128,([], False, n-1))
234 cMacPad (x:xs, b, n) = Just (x,(xs, b, n-1))
235
236 -- |Obtain the cmac with the specified subkey for lazy bytestrings
237 cMacWithSubK :: BlockCipher k => k -> (IV k, IV k) -> L.ByteString -> L.ByteString
238 cMacWithSubK k (IV k1, IV k2) l = L.fromChunks $ [go (chunkFor k t) $ B.replicate bSize1 0]
239 where
240 bSize1 = fromIntegral $ blockSizeBytes `for` k
241 bSize2 = fromIntegral $ blockSizeBytes `for` k
242 (t,e) = L.splitAt (((L.length l-1)`div` bSize2)*bSize2) l
243 pe = fst $ B.unfoldrN (bSize1) cMacPad (L.unpack e,True,bSize1)
244 fe | bSize2 == L.length e = zwp' k1 pe
245 | otherwise = zwp' k2 pe
246 go [] c = encryptBlock k (zwp' c fe)
247 go (x:xs) c = go xs $ encryptBlock k $ zwp' c x
248
249 -- |Obtain the cmac for lazy bytestrings
250 cMac :: BlockCipher k => k -> L.ByteString -> L.ByteString
251 cMac k = cMacWithSubK k (cMacSubk k)
252
253 -- |Obtain the cmac with the specified subkey for strict bytestrings
254 cMacWithSubK' :: BlockCipher k => k -> (IV k, IV k) -> B.ByteString -> B.ByteString
255 cMacWithSubK' k (IV k1, IV k2) b = go (chunkFor' k t) $ B.replicate bSize1 0
256 where
257 bSize1 = fromIntegral $ blockSizeBytes `for` k
258 bSize2 = fromIntegral $ blockSizeBytes `for` k
259 (t,e) = B.splitAt (((B.length b-1)`div` bSize2)*bSize2) b
260 pe = fst $ B.unfoldrN (bSize1) cMacPad (B.unpack e,True,bSize1)
261 fe | bSize2 == B.length e = zwp' k1 pe
262 | otherwise = zwp' k2 pe
263 go [] c = encryptBlock k (zwp' c fe)
264 go (x:xs) c = go xs $ encryptBlock k $ zwp' c x
265
266 -- |Obtain the cmac for strict bytestrings
267 cMac' :: BlockCipher k => k -> B.ByteString -> B.ByteString
268 cMac' k = cMacWithSubK' k (cMacSubk k)
269
270 -- |Generate the xor stream for the last step of the CMAC* algorithm
271 xorend :: Int -> (Int,[Word8]) -> Maybe (Word8,(Int,[Word8]))
272 xorend bsize (0, []) = Nothing
273 xorend bsize (n, x:xs) | n <= bsize = Just (x,((n-1),xs))
6beed7f @TomMD Documentation fixes
authored
274 | otherwise = Just (0,((n-1),(x:xs)))
de5c33d @TomMD Add klondikes modes patch
authored
275
276 -- |Obtain the CMAC* on lazy bytestrings
277 cMacStar :: BlockCipher k => k -> [L.ByteString] -> L.ByteString
278 cMacStar k l = go (lcmac (L.replicate bSize 0)) l
279 where
280 bSize = fromIntegral $ blockSizeBytes `for` k
281 bSizeb = fromIntegral $ blockSize `for` k
282 lcmac = cMacWithSubK k (cMacSubk k)
283 go s [] = s
284
285 -- |Obtain the CMAC* on strict bytestrings
286 cMacStar' :: BlockCipher k => k -> [B.ByteString] -> B.ByteString
287 cMacStar' k s = go (lcmac (B.replicate bSize 0)) s
288 where
289 bSize = fromIntegral $ blockSizeBytes `for` k
290 bSizeb = fromIntegral $ blockSize `for` k
291 lcmac = cMacWithSubK' k (cMacSubk k)
292 go s [] = s
293 go s [x] | (B.length x) >= bSize = lcmac $ zwp' x $ fst $ B.unfoldrN (B.length x) (xorend bSize) (fromIntegral $ B.length x,B.unpack s)
294 | otherwise = lcmac $ zwp' (dblB s) (fst $ B.unfoldrN bSize cMacPad (B.unpack x,True,bSize))
295 go s (x:xs) = go (zwp' (dblB s) (lcmac x)) xs
296
297
298
299 -- |Create the mask for SIV based ciphers
300 sivMask :: B.ByteString -> B.ByteString
301 sivMask b = snd $ B.mapAccumR (go) 0 b
302 where
303 go :: Int -> Word8 -> (Int,Word8)
304 go 24 w = (32,clearBit w 7)
305 go 56 w = (64,clearBit w 7)
306 go n w = (n+8,w)
307
6beed7f @TomMD Documentation fixes
authored
308 -- |SIV (Synthetic IV) mode for lazy bytestrings. First argument is
309 -- the optional list of bytestrings to be authenticated but not
310 -- encrypted As required by the specification this algorithm may
311 -- return nothing when certain constraints aren't met.
de5c33d @TomMD Add klondikes modes patch
authored
312 siv :: BlockCipher k => k -> k -> [L.ByteString] -> L.ByteString -> Maybe L.ByteString
313 siv k1 k2 xs m | length xs > bSizeb - 1 = Nothing
6beed7f @TomMD Documentation fixes
authored
314 | otherwise = Just $ L.append iv $ fst $ ctr incIV k2 (IV $ sivMask $ B.concat $ L.toChunks iv) m
de5c33d @TomMD Add klondikes modes patch
authored
315 where
316 bSize = fromIntegral $ blockSizeBytes `for` k1
317 bSizeb = fromIntegral $ blockSize `for` k1
318 iv = cMacStar k1 $ xs ++ [m]
319
320
6beed7f @TomMD Documentation fixes
authored
321 -- |SIV (Synthetic IV) for lazy bytestrings. First argument is the
322 -- optional list of bytestrings to be authenticated but not encrypted.
323 -- As required by the specification this algorithm may return nothing
324 -- when authentication fails.
de5c33d @TomMD Add klondikes modes patch
authored
325 unSiv :: BlockCipher k => k -> k -> [L.ByteString] -> L.ByteString -> Maybe L.ByteString
326 unSiv k1 k2 xs c | length xs > bSizeb - 1 = Nothing
6beed7f @TomMD Documentation fixes
authored
327 | L.length c < fromIntegral bSize = Nothing
328 | iv /= (cMacStar k1 $ xs ++ [dm]) = Nothing
329 | otherwise = Just dm
de5c33d @TomMD Add klondikes modes patch
authored
330 where
331 bSize = fromIntegral $ blockSizeBytes `for` k1
332 bSizeb = fromIntegral $ blockSize `for` k1
333 (iv,m) = L.splitAt (fromIntegral bSize) c
334 dm = fst $ unCtr incIV k2 (IV $ sivMask $ B.concat $ L.toChunks iv) m
335
6beed7f @TomMD Documentation fixes
authored
336 -- |SIV (Synthetic IV) mode for strict bytestrings. First argument is
337 -- the optional list of bytestrings to be authenticated but not
338 -- encrypted. As required by the specification this algorithm may
339 -- return nothing when certain constraints aren't met.
de5c33d @TomMD Add klondikes modes patch
authored
340 siv' :: BlockCipher k => k -> k -> [B.ByteString] -> B.ByteString -> Maybe B.ByteString
341 siv' k1 k2 xs m | length xs > bSizeb - 1 = Nothing
6beed7f @TomMD Documentation fixes
authored
342 | otherwise = Just $ B.append iv $ fst $ ctr' incIV k2 (IV $ sivMask iv) m
de5c33d @TomMD Add klondikes modes patch
authored
343 where
344 bSize = fromIntegral $ blockSizeBytes `for` k1
345 bSizeb = fromIntegral $ blockSize `for` k1
346 iv = cMacStar' k1 $ xs ++ [m]
347
348
349
6beed7f @TomMD Documentation fixes
authored
350 -- |SIV (Synthetic IV) for strict bytestrings First argument is the
351 -- optional list of bytestrings to be authenticated but not encrypted
352 -- As required by the specification this algorithm may return nothing
353 -- when authentication fails.
de5c33d @TomMD Add klondikes modes patch
authored
354 unSiv' :: BlockCipher k => k -> k -> [B.ByteString] -> B.ByteString -> Maybe B.ByteString
355 unSiv' k1 k2 xs c | length xs > bSizeb - 1 = Nothing
6beed7f @TomMD Documentation fixes
authored
356 | B.length c < bSize = Nothing
357 | iv /= (cMacStar' k1 $ xs ++ [dm]) = Nothing
358 | otherwise = Just dm
de5c33d @TomMD Add klondikes modes patch
authored
359 where
360 bSize = fromIntegral $ blockSizeBytes `for` k1
361 bSizeb = fromIntegral $ blockSize `for` k1
362 (iv,m) = B.splitAt bSize c
363 dm = fst $ unCtr' incIV k2 (IV $ sivMask iv) m
364
6beed7f @TomMD Documentation fixes
authored
365 -- |Increase an `IV` by one. This is way faster than decoding,
366 -- increasing, encoding
de5c33d @TomMD Add klondikes modes patch
authored
367 incIV :: BlockCipher k => IV k -> IV k
368 incIV (IV b) = IV $ snd $ B.mapAccumR (incw) True b
369 where
370 incw :: Bool -> Word8 -> (Bool, Word8)
371 incw True w = (w == maxBound, w + 1)
372 incw False w = (False, w)
373
374 -- |Accumulator based double operation
375 dblw :: Bool -> (Int,[Int],Bool) -> Word8 -> ((Int,[Int],Bool), Word8)
376 dblw hb (i,xs,b) w = dblw' hb
377 where
378 slw True w = (setBit (shift w 1) 0)
379 slw False w = (clearBit (shift w 1) 0)
380 cpolyw i [] w = ((i+8,[]),w)
381 cpolyw i (x:xs) w
382 | x < i +8 = (\(a,b) -> (a,complementBit b (x-i))) $ cpolyw i xs w
383 |otherwise = ((i+8,(x:xs)),w)
384 b' = testBit w 7
385 w' = slw b w
386 ((i',xs'),w'') = cpolyw i xs w'
387 dblw' False = i'`seq`xs'`seq`w''`seq`((i,xs,b'),w')
388 dblw' True = ((i',xs',b'),w'')
389
390
391 -- |Perform doubling as defined by the CMAC and SIV papers
392 dblIV :: BlockCipher k => IV k -> IV k
393 dblIV (IV b) = IV $ dblB b
394
395 -- |Perform doubling as defined by the CMAC and SIV papers
396 dblB :: B.ByteString -> B.ByteString
397 dblB b | B.null b = b
398 | otherwise = snd $ B.mapAccumR (dblw (testBit (B.head b) 7)) (0,cpoly2revlist (B.length b * 8),False) b
399
400 -- |Perform doubling as defined by the CMAC and SIV papers
401 dblL :: L.ByteString -> L.ByteString
402 dblL b | L.null b = b
403 | otherwise = snd $ L.mapAccumR (dblw (testBit (L.head b) 7)) (0,cpoly2revlist (L.length b * 8),False) b
404
405 -- |Cast a bigEndian ByteString into an Integer
406 decodeB :: B.ByteString -> Integer
407 decodeB = B.foldl' (\acc w -> (shift acc 8) + toInteger(w)) 0
408
6beed7f @TomMD Documentation fixes
authored
409 -- |Cast an Integer into a bigEndian ByteString of size k. It will
410 -- drop the MSBs in case the number is bigger than k and add 00s if it
411 -- is smaller.
de5c33d @TomMD Add klondikes modes patch
authored
412 encodeB :: (Ord a,Num a) => a -> Integer -> B.ByteString
413 encodeB k n = B.pack $ if lr > k then takel (lr - k) r else pad (k - lr) r
414 where
415 go 0 xs = xs
416 go n xs = go (shift n (-8)) (fromInteger (n .&. 255) : xs)
417 pad 0 xs = xs
418 pad n xs = 0 : pad (n-1) xs
419 takel 0 xs = xs
420 takel n (_:xs) = takel (n-1) xs
421 r = go n []
422 lr = genericLength r
423
424 -- |Cast a bigEndian ByteString into an Integer
425 decodeL :: L.ByteString -> Integer
426 decodeL = L.foldl' (\acc w -> (shift acc 8) + toInteger(w)) 0
427
6beed7f @TomMD Documentation fixes
authored
428 -- |Cast an Integer into a bigEndian ByteString of size k. It will
429 -- drop the MSBs in case the number is bigger than k and add 00s if it
430 -- is smaller.
de5c33d @TomMD Add klondikes modes patch
authored
431 encodeL :: (Ord a,Num a) => a -> Integer -> L.ByteString
432 encodeL k n = L.pack $ if lr > k then takel (lr - k) r else pad (k - lr) r
433 where go 0 xs = xs
434 go n xs = go (shift n (-8)) (fromInteger (n .&. 255) : xs)
435 pad 0 xs = xs
436 pad n xs = 0 : pad (n-1) xs
437 takel 0 xs = xs
438 takel n (_:xs) = takel (n-1) xs
439 r = go n []
440 lr = genericLength r
441
442
443 -- |Obtain an `IV` made only of zeroes
444 zeroIV :: (BlockCipher k) => IV k
445 zeroIV = iv
446 where bytes = ivBlockSizeBytes iv
447 iv = IV $ B.replicate bytes 0
448
779671d @TomMD Add Typeable and Exception instances for GenError.
authored
449 -- |Cook book mode - not really a mode at all. If you don't know what you're doing, don't use this mode^H^H^H^H library.
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
450 ecb :: BlockCipher k => k -> L.ByteString -> L.ByteString
8729714 @TomMD Add instances, comments, finalize types
authored
451 ecb k msg =
452 let chunks = chunkFor k msg
453 in L.fromChunks $ map (encryptBlock k) chunks
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
454 {-# INLINEABLE ecb #-}
8729714 @TomMD Add instances, comments, finalize types
authored
455
779671d @TomMD Add Typeable and Exception instances for GenError.
authored
456 -- |ECB decrypt, complementary to `ecb`.
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
457 unEcb :: BlockCipher k => k -> L.ByteString -> L.ByteString
8729714 @TomMD Add instances, comments, finalize types
authored
458 unEcb k msg =
459 let chunks = chunkFor k msg
460 in L.fromChunks $ map (decryptBlock k) chunks
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
461 {-# INLINEABLE unEcb #-}
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
462
779671d @TomMD Add Typeable and Exception instances for GenError.
authored
463 -- | Like `ecb` but for strict bytestrings
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
464 ecb' :: BlockCipher k => k -> B.ByteString -> B.ByteString
465 ecb' k msg =
8729714 @TomMD Add instances, comments, finalize types
authored
466 let chunks = chunkFor' k msg
467 in B.concat $ map (encryptBlock k) chunks
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
468 {-# INLINEABLE ecb' #-}
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
469
779671d @TomMD Add Typeable and Exception instances for GenError.
authored
470 -- |Decryption complement to `ecb'`
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
471 unEcb' :: BlockCipher k => k -> B.ByteString -> B.ByteString
472 unEcb' k ct =
473 let chunks = chunkFor' k ct
8729714 @TomMD Add instances, comments, finalize types
authored
474 in B.concat $ map (decryptBlock k) chunks
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
475 {-# INLINEABLE unEcb' #-}
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
476
6beed7f @TomMD Documentation fixes
authored
477 -- |Ciphertext feed-back encryption mode for lazy bytestrings (with s
478 -- == blockSize)
8729714 @TomMD Add instances, comments, finalize types
authored
479 cfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
480 cfb k (IV v) msg =
481 let blks = chunkFor k msg
482 (cs,ivF) = go v blks
483 in (L.fromChunks cs, IV ivF)
484 where
485 go iv [] = ([],iv)
486 go iv (b:bs) =
487 let c = zwp' (encryptBlock k iv) b
488 (cs,ivFinal) = go c bs
489 in (c:cs, ivFinal)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
490 {-# INLINEABLE cfb #-}
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
491
6beed7f @TomMD Documentation fixes
authored
492 -- |Ciphertext feed-back decryption mode for lazy bytestrings (with s
493 -- == blockSize)
8729714 @TomMD Add instances, comments, finalize types
authored
494 unCfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
495 unCfb k (IV v) msg =
496 let blks = chunkFor k msg
497 (ps, ivF) = go v blks
498 in (L.fromChunks ps, IV ivF)
499 where
500 go iv [] = ([], iv)
501 go iv (b:bs) =
502 let p = zwp' (encryptBlock k iv) b
503 (ps, ivF) = go b bs
504 in (p:ps, ivF)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
505 {-# INLINEABLE unCfb #-}
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
506
6beed7f @TomMD Documentation fixes
authored
507 -- |Ciphertext feed-back encryption mode for strict bytestrings (with
508 -- s == blockSize)
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
509 cfb' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)
510 cfb' k (IV v) msg =
511 let blks = chunkFor' k msg
512 (cs,ivF) = go v blks
513 in (B.concat cs, IV ivF)
514 where
515 go iv [] = ([],iv)
516 go iv (b:bs) =
517 let c = zwp' (encryptBlock k iv) b
518 (cs,ivFinal) = go c bs
519 in (c:cs, ivFinal)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
520 {-# INLINEABLE cfb' #-}
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
521
06f88ac @TomMD Add Haddock comments
authored
522 -- |Ciphertext feed-back decryption mode for strict bytestrings (with s == blockSize)
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
523 unCfb' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)
524 unCfb' k (IV v) msg =
525 let blks = chunkFor' k msg
526 (ps, ivF) = go v blks
527 in (B.concat ps, IV ivF)
528 where
529 go iv [] = ([], iv)
530 go iv (b:bs) =
531 let p = zwp' (encryptBlock k iv) b
532 (ps, ivF) = go b bs
533 in (p:ps, ivF)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
534 {-# INLINEABLE unCfb' #-}
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
535
06f88ac @TomMD Add Haddock comments
authored
536 -- |Output feedback mode for lazy bytestrings
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
537 ofb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)
538 ofb = unOfb
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
539 {-# INLINEABLE ofb #-}
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
540
06f88ac @TomMD Add Haddock comments
authored
541 -- |Output feedback mode for lazy bytestrings
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
542 unOfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)
543 unOfb k (IV iv) msg =
02a3f5a @TomMD Fix OFB, AES OFB tests now work
authored
544 let ivStr = drop 1 (iterate (encryptBlock k) iv)
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
545 ivLen = fromIntegral (B.length iv)
546 newIV = IV . B.concat . L.toChunks . L.take ivLen . L.drop (L.length msg) . L.fromChunks $ ivStr
8729714 @TomMD Add instances, comments, finalize types
authored
547 in (zwp (L.fromChunks ivStr) msg, newIV)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
548 {-# INLINEABLE unOfb #-}
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
549
06f88ac @TomMD Add Haddock comments
authored
550 -- |Output feedback mode for strict bytestrings
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
551 ofb' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)
552 ofb' = unOfb'
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
553 {-# INLINEABLE ofb' #-}
554
06f88ac @TomMD Add Haddock comments
authored
555 -- |Output feedback mode for strict bytestrings
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
556 unOfb' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)
557 unOfb' k (IV iv) msg =
02a3f5a @TomMD Fix OFB, AES OFB tests now work
authored
558 let ivStr = collect (B.length msg + ivLen) (drop 1 (iterate (encryptBlock k) iv))
8729714 @TomMD Add instances, comments, finalize types
authored
559 ivLen = B.length iv
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
560 mLen = fromIntegral (B.length msg)
561 newIV = IV . B.concat . L.toChunks . L.take (fromIntegral ivLen) . L.drop mLen . L.fromChunks $ ivStr
562 in (zwp' (B.concat ivStr) msg, newIV)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
563 {-# INLINEABLE unOfb' #-}
72bc8b5 @TomMD Remove cnt mode for now, add tests, export hashFunc'
authored
564
9f570a7 @TomMD Fix up the documentation
authored
565 -- |Obtain an `IV` using the provided CryptoRandomGenerator.
da20109 @TomMD Moved from Data.Crypto.* to Crypto.* module names. Renamed RandomGen…
authored
566 getIV :: (BlockCipher k, CryptoRandomGen g) => g -> Either GenError (IV k, g)
72bc8b5 @TomMD Remove cnt mode for now, add tests, export hashFunc'
authored
567 getIV g =
568 let bytes = ivBlockSizeBytes iv
716d469 @TomMD Swap order of arguments to match the rest of the community better (an…
authored
569 gen = genBytes bytes g
6e45644 @TomMD use Data.Crypto.Random instead of the random package RandomGen instance
authored
570 fromRight (Right x) = x
571 iv = IV (fst . fromRight $ gen)
572 in case gen of
573 Left err -> Left err
574 Right (bs,g')
575 | B.length bs == bytes -> Right (iv, g')
576 | otherwise -> Left (GenErrorOther "Generator failed to provide requested number of bytes")
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
577 {-# INLINEABLE getIV #-}
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
578
6beed7f @TomMD Documentation fixes
authored
579 -- | Obtain an 'IV' using the system entropy (see 'System.Crypto.Random')
dcad9a5 @TomMD Add getIVIO, export getIV* from Data.Crypto.Modes
authored
580 getIVIO :: (BlockCipher k) => IO (IV k)
581 getIVIO = do
53a30c1 @TomMD Remove need for MonoLocalBinds
authored
582 let p = Proxy
583 getTypedIV :: BlockCipher k => Proxy k -> IO (IV k)
584 getTypedIV pr = liftM IV (getEntropy (proxy blockSize pr `div` 8))
585 iv <- getTypedIV p
586 return (iv `asProxyTypeOf` ivProxy p)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
587 {-# INLINEABLE getIVIO #-}
588
49906b5 @TomMD Remove need for ScopedTypeVariables extension in Crypto.Modes
authored
589 ivProxy :: Proxy k -> Proxy (IV k)
590 ivProxy = reproxy
591
592 deIVProxy :: Proxy (IV k) -> Proxy k
593 deIVProxy = reproxy
594
595 proxyOf :: a -> Proxy a
596 proxyOf = const Proxy
dcad9a5 @TomMD Add getIVIO, export getIV* from Data.Crypto.Modes
authored
597
8729714 @TomMD Add instances, comments, finalize types
authored
598 ivBlockSizeBytes :: BlockCipher k => IV k -> Int
49906b5 @TomMD Remove need for ScopedTypeVariables extension in Crypto.Modes
authored
599 ivBlockSizeBytes iv =
600 let p = deIVProxy (proxyOf iv)
601 in proxy blockSize p `div` 8
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
602 {-# INLINEABLE ivBlockSizeBytes #-}
8729714 @TomMD Add instances, comments, finalize types
authored
603
604 instance (BlockCipher k) => Serialize (IV k) where
605 get = do
49906b5 @TomMD Remove need for ScopedTypeVariables extension in Crypto.Modes
authored
606 let p = Proxy
53a30c1 @TomMD Remove need for MonoLocalBinds
authored
607 doGet :: BlockCipher k => Proxy k -> Get (IV k)
8a29959 @TomMD CNT mode using Ryan's bytestring generation method
authored
608 doGet pr = liftM IV (SG.getByteString (proxy blockSizeBytes pr))
53a30c1 @TomMD Remove need for MonoLocalBinds
authored
609 iv <- doGet p
610 return (iv `asProxyTypeOf` ivProxy p)
8729714 @TomMD Add instances, comments, finalize types
authored
611 put (IV iv) = SP.putByteString iv
612
4246279 @TomMD Eliminate MonadRandom dep, other minor changes
authored
613 -- TODO: GCM, GMAC
b010141 @TomMD Initial stab at modes. Needs fixing, optimization (B.concat, not B.a…
authored
614 -- Consider the AES-only modes of XTS, CCM
Something went wrong with that request. Please try again.