crypto-api 0.5.2 → 0.6
raw patch · 5 files changed
+398/−32 lines, 5 filesdep +largeworddep ~base
Dependencies added: largeword
Dependency ranges changed: base
Files
- Crypto/Classes.hs +57/−6
- Crypto/Modes.hs +308/−21
- Crypto/Padding.hs +1/−1
- Crypto/Util.hs +26/−0
- crypto-api.cabal +6/−4
Crypto/Classes.hs view
@@ -13,18 +13,26 @@ -} module Crypto.Classes- ( Hash(..)+ ( + -- * Hash class and helper functions+ Hash(..)+ , hash+ , hash'+ , hashFunc+ , hashFunc'+ -- * Cipher classes and helper functions , BlockCipher(..) , blockSizeBytes+ , buildKeyIO , StreamCipher(..)+ , buildStreamKeyIO , AsymCipher(..)+ , buildKeyPairIO , Signing(..)+ , buildSigningKeyPairIO+ -- * Misc helper functions , for , (.::.)- , hash- , hash'- , hashFunc- , hashFunc' ) where import Data.Serialize@@ -36,6 +44,7 @@ import Data.Tagged import Crypto.Types import Crypto.Random+import System.Crypto.Random -- |The Hash class is intended as the generic interface -- targeted by maintainers of Haskell digest implementations.@@ -126,6 +135,20 @@ blockSizeBytes :: (BlockCipher k) => Tagged k ByteLength blockSizeBytes = fmap (`div` 8) blockSize +buildKeyIO :: (BlockCipher k) => IO k+buildKeyIO = go 0+ where+ go 1000 = error "Tried 1000 times to generate a key from the system entropy.\+ \ No keys were returned! Perhaps the system entropy is broken\+ \ or perhaps the BlockCipher instance being used has a non-flat\+ \ keyspace."+ go i = do+ let bs = keyLength+ kd <- getEntropy ((7 + untag bs) `div` 8)+ case buildKey kd of+ Nothing -> go (i+1)+ Just k -> return $ k `asTaggedTypeOf` bs+ -- |Asymetric ciphers (common ones being RSA or EC based) class (Serialize p, Serialize v) => AsymCipher p v where buildKeyPair :: CryptoRandomGen g => g -> BitLength -> Either GenError ((p,v),g) -- ^ build a public/private key pair using the provided generator@@ -134,6 +157,13 @@ publicKeyLength :: p -> BitLength privateKeyLength :: v -> BitLength +buildKeyPairIO :: AsymCipher p v => BitLength -> IO (Either GenError (p,v))+buildKeyPairIO bl = do+ g <- newGenIO :: IO SystemRandom+ case buildKeyPair g bl of+ Left err -> return (Left err)+ Right (k,_) -> return (Right k)+ -- | A stream cipher class. Instance are expected to work on messages as small as one byte -- The length of the resulting cipher text should be equal -- to the length of the input message.@@ -141,8 +171,22 @@ buildStreamKey :: B.ByteString -> Maybe k encryptStream :: k -> iv -> B.ByteString -> (B.ByteString, iv) decryptStream :: k -> iv -> B.ByteString -> (B.ByteString, iv)- streamKeyLength :: k -> BitLength+ streamKeyLength :: Tagged k BitLength +buildStreamKeyIO :: StreamCipher k iv => IO k+buildStreamKeyIO = go 0+ where+ go 1000 = error "Tried 1000 times to generate a stream key from the system entropy.\+ \ No keys were returned! Perhaps the system entropy is broken\+ \ or perhaps the BlockCipher instance being used has a non-flat\+ \ keyspace."+ go i = do+ let k = streamKeyLength+ kd <- getEntropy ((untag k + 7) `div` 8)+ case buildStreamKey kd of+ Nothing -> go (i+1)+ Just k' -> return $ k' `asTaggedTypeOf` k+ -- | A class for signing operations which inherently can not be as generic -- as asymetric ciphers (ex: DSA). class (Serialize p, Serialize v) => Signing p v | p -> v, v -> p where@@ -151,3 +195,10 @@ buildSigningPair :: CryptoRandomGen g => g -> BitLength -> Either GenError ((p, v), g) signingKeyLength :: v -> BitLength verifyingKeyLength :: p -> BitLength++buildSigningKeyPairIO :: (Signing p v) => BitLength -> IO (Either GenError (p,v))+buildSigningKeyPairIO bl = do+ g <- newGenIO :: IO SystemRandom+ case buildSigningPair g bl of+ Left err -> return $ Left err+ Right (k,_) -> return $ Right k
Crypto/Modes.hs view
@@ -3,17 +3,19 @@ Maintainer: Thomas.DuBuisson@gmail.com Stability: beta Portability: portable + Authors: Thomas DuBuisson, Francisco Blas Izquierdo Riera (klondike) Generic mode implementations useable by any correct BlockCipher instance - Be aware there are no tests for CFB mode yet. See "Test.Crypto".+ Be aware there are no tests for CFB mode yet. See "Test.Crypto". -} module Crypto.Modes (- -- * Initialization Vector Type (for all ciphers for all modes that use IVs)+ -- * Initialization Vector Type, Modifiers (for all ciphers, all modes that use IVs) IV- , getIV, getIVIO- -- * Blockcipher modes of operation. Note name' (with a prime) means strict, without a prime means lazy bytestrings.+ , getIV, getIVIO, zeroIV+ , incIV, dblIV+ -- * Blockcipher modes. Names with a prime (') means strict, without a prime means lazy bytestrings. , ecb, unEcb , cbc, unCbc , cfb, unCfb@@ -22,13 +24,14 @@ , cbc', unCbc' , cfb', unCfb' , ofb', unOfb'+ , ctr, unCtr, ctr', unCtr'+ , siv, unSiv, siv', unSiv' -- * Authentication modes- , cbcMac', cbcMac+ , cbcMac', cbcMac, cMac, cMac' -- * Combined modes (nothing here yet) -- , gmc -- , xts -- , ccm- -- , ctr, unCtr, ctr', unCtr' ) where import qualified Data.ByteString as B@@ -36,22 +39,30 @@ import Data.Serialize import qualified Data.Serialize.Put as SP import qualified Data.Serialize.Get as SG-import Data.Bits (xor)+import Data.Bits (xor, shift, (.&.), (.|.), testBit, setBit, clearBit, Bits, complementBit) import Data.Tagged import Crypto.Classes import Crypto.Random+import Crypto.Util+import Crypto.CPoly import System.Crypto.Random (getEntropy)-import Control.Monad (liftM)+import Control.Monad (liftM, forM_)+import Data.List (genericDrop)+import Data.Word (Word8)+import Data.List (genericDrop,genericReplicate,genericLength)+ #if MIN_VERSION_tagged(0,2,0) import Data.Proxy #endif - -- |Initilization Vectors for BlockCipher implementations (IV k) are used -- for various modes and guarrenteed to be blockSize bits long. The common -- ways to obtain an IV are to generate one ('getIV' or 'getIVIO') or to -- use one provided with the ciphertext (using the 'Serialize' instance of IV).-data IV k = IV { initializationVector :: B.ByteString } deriving (Eq, Ord, Show)+--+-- 'zeroIV' also exists and is of particular use for starting 'ctr' mode with+-- a fresh key.+data IV k = IV { initializationVector :: {-# UNPACK #-} !B.ByteString } deriving (Eq, Ord, Show) -- gather a specified number of bytes from the list of bytestrings collect :: Int -> [B.ByteString] -> [B.ByteString]@@ -86,6 +97,7 @@ -- libraries 'zipWith'' rewrite rule but at the extra cost of the -- resulting lazy bytestring being more fragmented than either of the -- two inputs.+zwp :: L.ByteString -> L.ByteString -> L.ByteString zwp a b = let as = L.toChunks a bs = L.toChunks b@@ -100,11 +112,14 @@ as' = if B.length ar == 0 then as else ar : as bs' = if B.length br == 0 then bs else br : bs in (zwp' a' b') : go as' bs'+{-# INLINEABLE zwp #-} -- |zipWith xor + Pack -- As a result of rewrite rules, this should automatically be optimized (at compile time) -- to use the bytestring libraries 'zipWith'' function.+zwp' :: B.ByteString -> B.ByteString -> B.ByteString zwp' a = B.pack . B.zipWith xor a+{-# INLINEABLE zwp' #-} -- |Cipher block chaining encryption mode on strict bytestrings cbc' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)@@ -118,12 +133,15 @@ let c = encryptBlock k (zwp' iv b) (cs, ivFinal) = go bs c in (c:cs, ivFinal)+{-# INLINEABLE cbc' #-} cbcMac' :: BlockCipher k => k -> B.ByteString -> B.ByteString-cbcMac' k pt = encode $ snd $ cbc' k (IV (B.replicate (blockSize `for` k) 0)) pt+cbcMac' k pt = encode $ snd $ cbc' k zeroIV pt+{-# INLINEABLE cbcMac' #-} cbcMac :: BlockCipher k => k -> L.ByteString -> L.ByteString-cbcMac k pt = L.fromChunks [encode $ snd $ cbc k (IV (B.replicate (blockSize `for` k) 0)) pt]+cbcMac k pt = L.fromChunks [encode $ snd $ cbc k zeroIV pt]+{-# INLINEABLE cbcMac #-} -- |Cipher block chaining decryption for strict bytestrings unCbc' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)@@ -137,6 +155,7 @@ let p = zwp' (decryptBlock k c) iv (ps, ivFinal) = go cs c in (p:ps, ivFinal)+{-# INLINEABLE unCbc' #-} -- |Cipher block chaining encryption for lazy bytestrings cbc :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)@@ -150,6 +169,7 @@ let c = encryptBlock k (zwp' iv b) (cs, ivFinal) = go bs c in (c:cs, ivFinal)+{-# INLINEABLE cbc #-} -- |Cipher block chaining decryption for lazy bytestrings unCbc :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)@@ -163,26 +183,290 @@ let p = zwp' (decryptBlock k c) iv (ps, ivFinal) = go cs c in (p:ps, ivFinal)+{-# INLINEABLE unCbc #-} +-- |Counter mode for lazy bytestrings+ctr :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> L.ByteString -> (L.ByteString, IV k)+ctr = unCtr++-- |Counter mode for lazy bytestrings+unCtr :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> L.ByteString -> (L.ByteString, IV k)+unCtr f k (IV iv) msg =+ let ivStr = iterate f $ IV iv+ ivLen = fromIntegral $ B.length iv+ newIV = head $ genericDrop ((ivLen - 1 + L.length msg) `div` ivLen) ivStr+ in (zwp (L.fromChunks $ map (encryptBlock k) $ map initializationVector ivStr) msg, newIV)++-- |Counter mode for strict bytestrings+ctr' :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> B.ByteString -> (B.ByteString, IV k)+ctr' = unCtr'++-- |Counter mode for strict bytestrings+unCtr' :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> B.ByteString -> (B.ByteString, IV k)+unCtr' f k (IV iv) msg =+ let ivStr = iterate f $ IV iv+ ivLen = fromIntegral $ B.length iv+ newIV = head $ genericDrop ((ivLen - 1 + B.length msg) `div` ivLen) ivStr+ in (zwp' (B.concat $ collect (B.length msg) (map (encryptBlock k . initializationVector) ivStr)) msg, newIV)++-- |Generate cmac subkeys+-- |The usage of seq tries to force evaluation of both keys avoiding posible timing attacks+cMacSubk :: BlockCipher k => k -> (IV k, IV k)+cMacSubk k = (k1, k2) `seq` (k1, k2)+ where+ bSize = blockSizeBytes `for` k+ k1 = dblIV $ IV $ encryptBlock k $ B.replicate bSize 0+ k2 = dblIV $ k1++-- |Pad the string as required by the cmac algorithm. In theory this should work+-- | at bit level but since the API works at byte level we do the same+cMacPad :: ([Word8], Bool, Int) -> Maybe (Word8,([Word8], Bool, Int))+cMacPad (_, _, 0) = Nothing+cMacPad ([], False, n) = Just (0,([], False, n-1))+cMacPad ([], True, n) = Just (128,([], False, n-1))+cMacPad (x:xs, b, n) = Just (x,(xs, b, n-1))++-- |Obtain the cmac with the specified subkey for lazy bytestrings+cMacWithSubK :: BlockCipher k => k -> (IV k, IV k) -> L.ByteString -> L.ByteString+cMacWithSubK k (IV k1, IV k2) l = L.fromChunks $ [go (chunkFor k t) $ B.replicate bSize1 0]+ where+ bSize1 = fromIntegral $ blockSizeBytes `for` k+ bSize2 = fromIntegral $ blockSizeBytes `for` k+ (t,e) = L.splitAt (((L.length l-1)`div` bSize2)*bSize2) l+ pe = fst $ B.unfoldrN (bSize1) cMacPad (L.unpack e,True,bSize1)+ fe | bSize2 == L.length e = zwp' k1 pe+ | otherwise = zwp' k2 pe+ go [] c = encryptBlock k (zwp' c fe)+ go (x:xs) c = go xs $ encryptBlock k $ zwp' c x++-- |Obtain the cmac for lazy bytestrings+cMac :: BlockCipher k => k -> L.ByteString -> L.ByteString+cMac k = cMacWithSubK k (cMacSubk k)++-- |Obtain the cmac with the specified subkey for strict bytestrings+cMacWithSubK' :: BlockCipher k => k -> (IV k, IV k) -> B.ByteString -> B.ByteString+cMacWithSubK' k (IV k1, IV k2) b = go (chunkFor' k t) $ B.replicate bSize1 0+ where+ bSize1 = fromIntegral $ blockSizeBytes `for` k+ bSize2 = fromIntegral $ blockSizeBytes `for` k+ (t,e) = B.splitAt (((B.length b-1)`div` bSize2)*bSize2) b+ pe = fst $ B.unfoldrN (bSize1) cMacPad (B.unpack e,True,bSize1)+ fe | bSize2 == B.length e = zwp' k1 pe+ | otherwise = zwp' k2 pe+ go [] c = encryptBlock k (zwp' c fe)+ go (x:xs) c = go xs $ encryptBlock k $ zwp' c x++-- |Obtain the cmac for strict bytestrings+cMac' :: BlockCipher k => k -> B.ByteString -> B.ByteString+cMac' k = cMacWithSubK' k (cMacSubk k)++-- |Generate the xor stream for the last step of the CMAC* algorithm+xorend :: Int -> (Int,[Word8]) -> Maybe (Word8,(Int,[Word8]))+xorend bsize (0, []) = Nothing+xorend bsize (n, x:xs) | n <= bsize = Just (x,((n-1),xs))+ | otherwise = Just (0,((n-1),(x:xs)))++-- |Obtain the CMAC* on lazy bytestrings+cMacStar :: BlockCipher k => k -> [L.ByteString] -> L.ByteString+cMacStar k l = go (lcmac (L.replicate bSize 0)) l+ where+ bSize = fromIntegral $ blockSizeBytes `for` k+ bSizeb = fromIntegral $ blockSize `for` k+ lcmac = cMacWithSubK k (cMacSubk k)+ go s [] = s++-- |Obtain the CMAC* on strict bytestrings+cMacStar' :: BlockCipher k => k -> [B.ByteString] -> B.ByteString+cMacStar' k s = go (lcmac (B.replicate bSize 0)) s+ where+ bSize = fromIntegral $ blockSizeBytes `for` k+ bSizeb = fromIntegral $ blockSize `for` k+ lcmac = cMacWithSubK' k (cMacSubk k)+ go s [] = s+ 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)+ | otherwise = lcmac $ zwp' (dblB s) (fst $ B.unfoldrN bSize cMacPad (B.unpack x,True,bSize))+ go s (x:xs) = go (zwp' (dblB s) (lcmac x)) xs++++-- |Create the mask for SIV based ciphers+sivMask :: B.ByteString -> B.ByteString+sivMask b = snd $ B.mapAccumR (go) 0 b+ where+ go :: Int -> Word8 -> (Int,Word8)+ go 24 w = (32,clearBit w 7)+ go 56 w = (64,clearBit w 7)+ go n w = (n+8,w)++-- |SIV (Synthetic IV) mode for lazy bytestrings+-- |First argument is the optional list of bytestrings to be authenticated+-- | but not encrypted+-- |As required by the specification this algorithm may return nothing when+-- | certain constraints aren't met.+siv :: BlockCipher k => k -> k -> [L.ByteString] -> L.ByteString -> Maybe L.ByteString+siv k1 k2 xs m | length xs > bSizeb - 1 = Nothing+ | otherwise = Just $ L.append iv $ fst $ ctr incIV k2 (IV $ sivMask $ B.concat $ L.toChunks iv) m+ where+ bSize = fromIntegral $ blockSizeBytes `for` k1+ bSizeb = fromIntegral $ blockSize `for` k1+ iv = cMacStar k1 $ xs ++ [m]+++-- |SIV (Synthetic IV) for lazy bytestrings+-- |First argument is the optional list of bytestrings to be authenticated+-- | but not encrypted+-- |As required by the specification this algorithm may return nothing when+-- | authentication fails+unSiv :: BlockCipher k => k -> k -> [L.ByteString] -> L.ByteString -> Maybe L.ByteString+unSiv k1 k2 xs c | length xs > bSizeb - 1 = Nothing+ | L.length c < fromIntegral bSize = Nothing+ | iv /= (cMacStar k1 $ xs ++ [dm]) = Nothing+ | otherwise = Just dm+ where+ bSize = fromIntegral $ blockSizeBytes `for` k1+ bSizeb = fromIntegral $ blockSize `for` k1+ (iv,m) = L.splitAt (fromIntegral bSize) c+ dm = fst $ unCtr incIV k2 (IV $ sivMask $ B.concat $ L.toChunks iv) m++-- |SIV (Synthetic IV) mode for strict bytestrings+-- |First argument is the optional list of bytestrings to be authenticated+-- | but not encrypted+-- |As required by the specification this algorithm may return nothing when+-- | certain constraints aren't met.+siv' :: BlockCipher k => k -> k -> [B.ByteString] -> B.ByteString -> Maybe B.ByteString+siv' k1 k2 xs m | length xs > bSizeb - 1 = Nothing+ | otherwise = Just $ B.append iv $ fst $ ctr' incIV k2 (IV $ sivMask iv) m+ where+ bSize = fromIntegral $ blockSizeBytes `for` k1+ bSizeb = fromIntegral $ blockSize `for` k1+ iv = cMacStar' k1 $ xs ++ [m]++++-- |SIV (Synthetic IV) for strict bytestrings+-- |First argument is the optional list of bytestrings to be authenticated+-- | but not encrypted+-- |As required by the specification this algorithm may return nothing when+-- | authentication fails+unSiv' :: BlockCipher k => k -> k -> [B.ByteString] -> B.ByteString -> Maybe B.ByteString+unSiv' k1 k2 xs c | length xs > bSizeb - 1 = Nothing+ | B.length c < bSize = Nothing+ | iv /= (cMacStar' k1 $ xs ++ [dm]) = Nothing+ | otherwise = Just dm+ where+ bSize = fromIntegral $ blockSizeBytes `for` k1+ bSizeb = fromIntegral $ blockSize `for` k1+ (iv,m) = B.splitAt bSize c+ dm = fst $ unCtr' incIV k2 (IV $ sivMask iv) m++-- |Increase an `IV` by one+-- |This is way faster than decoding, increasing, encoding +incIV :: BlockCipher k => IV k -> IV k+incIV (IV b) = IV $ snd $ B.mapAccumR (incw) True b+ where+ incw :: Bool -> Word8 -> (Bool, Word8)+ incw True w = (w == maxBound, w + 1)+ incw False w = (False, w)++-- |Accumulator based double operation+dblw :: Bool -> (Int,[Int],Bool) -> Word8 -> ((Int,[Int],Bool), Word8)+dblw hb (i,xs,b) w = dblw' hb+ where+ slw True w = (setBit (shift w 1) 0)+ slw False w = (clearBit (shift w 1) 0)+ cpolyw i [] w = ((i+8,[]),w)+ cpolyw i (x:xs) w+ | x < i +8 = (\(a,b) -> (a,complementBit b (x-i))) $ cpolyw i xs w+ |otherwise = ((i+8,(x:xs)),w)+ b' = testBit w 7+ w' = slw b w+ ((i',xs'),w'') = cpolyw i xs w'+ dblw' False = i'`seq`xs'`seq`w''`seq`((i,xs,b'),w')+ dblw' True = ((i',xs',b'),w'')+++-- |Perform doubling as defined by the CMAC and SIV papers+dblIV :: BlockCipher k => IV k -> IV k+dblIV (IV b) = IV $ dblB b++-- |Perform doubling as defined by the CMAC and SIV papers+dblB :: B.ByteString -> B.ByteString+dblB b | B.null b = b+ | otherwise = snd $ B.mapAccumR (dblw (testBit (B.head b) 7)) (0,cpoly2revlist (B.length b * 8),False) b++-- |Perform doubling as defined by the CMAC and SIV papers+dblL :: L.ByteString -> L.ByteString+dblL b | L.null b = b+ | otherwise = snd $ L.mapAccumR (dblw (testBit (L.head b) 7)) (0,cpoly2revlist (L.length b * 8),False) b++-- |Cast a bigEndian ByteString into an Integer+decodeB :: B.ByteString -> Integer+decodeB = B.foldl' (\acc w -> (shift acc 8) + toInteger(w)) 0++-- |Cast an Integer into a bigEndian ByteString of size k+-- |It will drop the MSBs in case the number is bigger than k and add 00s if it+-- |is smaller+encodeB :: (Ord a,Num a) => a -> Integer -> B.ByteString+encodeB k n = B.pack $ if lr > k then takel (lr - k) r else pad (k - lr) r+ where+ go 0 xs = xs + go n xs = go (shift n (-8)) (fromInteger (n .&. 255) : xs)+ pad 0 xs = xs+ pad n xs = 0 : pad (n-1) xs+ takel 0 xs = xs+ takel n (_:xs) = takel (n-1) xs+ r = go n []+ lr = genericLength r++-- |Cast a bigEndian ByteString into an Integer+decodeL :: L.ByteString -> Integer+decodeL = L.foldl' (\acc w -> (shift acc 8) + toInteger(w)) 0++-- |Cast an Integer into a bigEndian ByteString of size k+-- |It will drop the MSBs in case the number is bigger than k and add 00s if it+-- |is smaller+encodeL :: (Ord a,Num a) => a -> Integer -> L.ByteString+encodeL k n = L.pack $ if lr > k then takel (lr - k) r else pad (k - lr) r+ where go 0 xs = xs + go n xs = go (shift n (-8)) (fromInteger (n .&. 255) : xs)+ pad 0 xs = xs+ pad n xs = 0 : pad (n-1) xs+ takel 0 xs = xs+ takel n (_:xs) = takel (n-1) xs+ r = go n []+ lr = genericLength r+++-- |Obtain an `IV` made only of zeroes+zeroIV :: (BlockCipher k) => IV k+zeroIV = iv+ where bytes = ivBlockSizeBytes iv+ iv = IV $ B.replicate bytes 0++ ecb :: BlockCipher k => k -> L.ByteString -> L.ByteString ecb k msg = let chunks = chunkFor k msg in L.fromChunks $ map (encryptBlock k) chunks+{-# INLINEABLE ecb #-} unEcb :: BlockCipher k => k -> L.ByteString -> L.ByteString unEcb k msg = let chunks = chunkFor k msg in L.fromChunks $ map (decryptBlock k) chunks+{-# INLINEABLE unEcb #-} ecb' :: BlockCipher k => k -> B.ByteString -> B.ByteString ecb' k msg = let chunks = chunkFor' k msg in B.concat $ map (encryptBlock k) chunks+{-# INLINEABLE ecb' #-} unEcb' :: BlockCipher k => k -> B.ByteString -> B.ByteString unEcb' k ct = let chunks = chunkFor' k ct in B.concat $ map (decryptBlock k) chunks+{-# INLINEABLE unEcb' #-} -- |Ciphertext feed-back encryption mode for lazy bytestrings (with s == blockSize) cfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)@@ -196,6 +480,7 @@ let c = zwp' (encryptBlock k iv) b (cs,ivFinal) = go c bs in (c:cs, ivFinal)+{-# INLINEABLE cfb #-} -- |Ciphertext feed-back decryption mode for lazy bytestrings (with s == blockSize) unCfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)@@ -209,6 +494,7 @@ let p = zwp' (encryptBlock k iv) b (ps, ivF) = go b bs in (p:ps, ivF)+{-# INLINEABLE unCfb #-} -- |Ciphertext feed-back encryption mode for strict bytestrings (with s == blockSize) cfb' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)@@ -222,6 +508,7 @@ let c = zwp' (encryptBlock k iv) b (cs,ivFinal) = go c bs in (c:cs, ivFinal)+{-# INLINEABLE cfb' #-} -- |Ciphertext feed-back decryption mode for strict bytestrings (with s == blockSize) unCfb' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)@@ -235,10 +522,12 @@ let p = zwp' (encryptBlock k iv) b (ps, ivF) = go b bs in (p:ps, ivF)+{-# INLINEABLE unCfb' #-} -- |Output feedback mode for lazy bytestrings ofb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k) ofb = unOfb+{-# INLINEABLE ofb #-} -- |Output feedback mode for lazy bytestrings unOfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)@@ -247,10 +536,12 @@ ivLen = fromIntegral (B.length iv) newIV = IV . B.concat . L.toChunks . L.take ivLen . L.drop (L.length msg) . L.fromChunks $ ivStr in (zwp (L.fromChunks ivStr) msg, newIV)+{-# INLINEABLE unOfb #-} -- |Output feedback mode for strict bytestrings ofb' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k) ofb' = unOfb'+{-# INLINEABLE ofb' #-} -- |Output feedback mode for strict bytestrings unOfb' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)@@ -260,14 +551,7 @@ mLen = fromIntegral (B.length msg) newIV = IV . B.concat . L.toChunks . L.take (fromIntegral ivLen) . L.drop mLen . L.fromChunks $ ivStr in (zwp' (B.concat ivStr) msg, newIV)--unfoldK :: (b -> Maybe (a,b)) -> b -> ([a],b)-unfoldK f i = - case (f i) of- Nothing -> ([], i)- Just (a,i') ->- let (as, iF) = unfoldK f i'- in (a:as, iF)+{-# INLINEABLE unOfb' #-} -- |Obtain an `IV` using the provided CryptoRandomGenerator. getIV :: (BlockCipher k, CryptoRandomGen g) => g -> Either GenError (IV k, g)@@ -281,6 +565,7 @@ Right (bs,g') | B.length bs == bytes -> Right (iv, g') | otherwise -> Left (GenErrorOther "Generator failed to provide requested number of bytes")+{-# INLINEABLE getIV #-} -- | Obtain an `IV` using the system entropy (see "System.Crypto.Random") getIVIO :: (BlockCipher k) => IO (IV k)@@ -290,6 +575,7 @@ getTypedIV pr = liftM IV (getEntropy (proxy blockSize pr `div` 8)) iv <- getTypedIV p return (iv `asProxyTypeOf` ivProxy p)+{-# INLINEABLE getIVIO #-} ivProxy :: Proxy k -> Proxy (IV k) ivProxy = reproxy@@ -304,12 +590,13 @@ ivBlockSizeBytes iv = let p = deIVProxy (proxyOf iv) in proxy blockSize p `div` 8+{-# INLINEABLE ivBlockSizeBytes #-} instance (BlockCipher k) => Serialize (IV k) where get = do let p = Proxy doGet :: BlockCipher k => Proxy k -> Get (IV k)- doGet pr = liftM IV (SG.getByteString (proxy blockSize pr `div` 8))+ doGet pr = liftM IV (SG.getByteString (proxy blockSizeBytes pr)) iv <- doGet p return (iv `asProxyTypeOf` ivProxy p) put (IV iv) = SP.putByteString iv
Crypto/Padding.hs view
@@ -130,7 +130,7 @@ padLen = l - ((B.length bs + 1) `rem` l) pLen = fromIntegral padLen --- | A static espPad allows reuse of a single B.pack'ed pad for all calls to padESP+-- A static espPad allows reuse of a single B.pack'ed pad for all calls to padESP espPad = B.pack [1..255] -- | unpad and return the padded message (Nothing is returned if the padding is invalid)
+ Crypto/Util.hs view
@@ -0,0 +1,26 @@+module Crypto.Util where+import qualified Data.ByteString as B+import Data.ByteString.Unsafe (unsafeIndex)+import Data.Bits (shiftL, shiftR)++-- |@incBS bs@ inefficiently computes the value @i2bs (8 * B.length bs) (bs2i bs + 1)@+incBS :: B.ByteString -> B.ByteString+incBS bs = B.concat (go bs (B.length bs - 1))+ where+ go bs i+ | B.length bs == 0 = []+ | unsafeIndex bs i == 0xFF = (go (B.init bs) (i-1)) ++ [B.singleton 0]+ | otherwise = [B.init bs] ++ [B.singleton $ (unsafeIndex bs i) + 1]+{-# INLINE incBS #-}+++-- |@i2bs bitLen i@ converts @i@ to a 'ByteString' of @bitLen@ bits (must be a multiple of 8).+i2bs :: Int -> Integer -> B.ByteString+i2bs l i = B.unfoldr (\l' -> if l' < 0 then Nothing else Just (fromIntegral (i `shiftR` l'), l' - 8)) (l-8)+{-# INLINE i2bs #-}++-- |@bs2i bs@ converts the 'ByteString' @bs@ to an 'Integer' (inverse of 'i2bs')+bs2i :: B.ByteString -> Integer+bs2i bs = B.foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0 bs+{-# INLINE bs2i #-}+
crypto-api.cabal view
@@ -1,9 +1,9 @@ name: crypto-api-version: 0.5.2+version: 0.6 license: BSD3 license-file: LICENSE-copyright: Thomas DuBuisson <thomas.dubuisson@gmail.com>-author: Thomas DuBuisson <thomas.dubuisson@gmail.com>+copyright: Thomas DuBuisson <thomas.dubuisson@gmail.com>, Francisco Blas Izquierdo Riera (klondike) (see AUTHORS)+author: Thomas DuBuisson <thomas.dubuisson@gmail.com>, Francisco Blas Izquierdo Riera (klondike) maintainer: Thomas DuBuisson <thomas.dubuisson@gmail.com> description: A generic interface for cryptographic operations, platform independent quality RNG, property tests@@ -52,10 +52,12 @@ Build-Depends: base == 4.*, bytestring >= 0.9 && < 0.10, cereal >= 0.2 && < 0.4,- tagged >= 0.1 && < 0.3+ tagged >= 0.1 && < 0.3,+ largeword >= 1.0.0 ghc-options: -O2 hs-source-dirs: exposed-modules: Crypto.Classes, Crypto.Types, Crypto.HMAC, Crypto.Modes, System.Crypto.Random, Crypto.Random, Crypto.Padding+ other-modules: Crypto.Util if os(windows) cpp-options: -DisWindows extra-libraries: advapi32