packages feed

crypto-api 0.12.2.2 → 0.13

raw patch · 9 files changed

+580/−413 lines, 9 files

Files

Crypto/Classes.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}+{-# LANGUAGE ParallelListComp #-} {-|  Maintainer: Thomas.DuBuisson@gmail.com  Stability: beta@@ -16,8 +17,8 @@         (         -- * Hash class and helper functions           Hash(..)-        , hashFunc         , hashFunc'+        , hashFunc         -- * Cipher classes and helper functions         , BlockCipher(..)         , blockSizeBytes@@ -35,21 +36,31 @@         , buildSigningKeyPairGen         -- * Misc helper functions         , encode+        , zeroIV         , incIV+        , getIV, getIVIO+        , chunkFor, chunkFor'         , module Crypto.Util+        , module Crypto.Types         ) where +import Data.Data+import Data.Typeable import Data.Serialize+import qualified Data.Serialize.Get as SG+import qualified Data.Serialize.Put as SP import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as B import qualified Data.ByteString.Internal as I import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State (StateT(..), runStateT)-import Data.Bits ((.|.), xor, shiftR)+import Control.Monad (liftM)+import Data.Bits import Data.List (foldl', genericDrop) import Data.Word (Word8, Word16, Word64) import Data.Tagged+import Data.Proxy import Crypto.Types import Crypto.Random import Crypto.Util@@ -57,6 +68,7 @@ import Foreign (Ptr) import Foreign.C (CChar(..), CInt(..)) import System.Entropy+import {-# SOURCE #-} Crypto.Modes  -- |The Hash class is intended as the generic interface -- targeted by maintainers of Haskell digest implementations.@@ -131,10 +143,10 @@  -- |The BlockCipher class is intended as the generic interface -- targeted by maintainers of Haskell cipher implementations.--- Using this generic interface higher level functions--- such as 'cbc', and other functions from Data.Crypto.Modes, provide a useful API--- for comsumers of cipher implementations. --+-- Minimum complete definition: blockSize, encryptBlock, decryptBlock,+-- buildKey, and keyLength.+-- -- Instances must handle unaligned data class ( Serialize k) => BlockCipher k where   blockSize     :: Tagged k BitLength                   -- ^ The size of a single block; the smallest unit on which the cipher operates.@@ -156,12 +168,23 @@   -- | Cipherblock Chaining (decryption)   unCbc         :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)   unCbc = modeUnCbc'+   -- | Counter (encryption)   ctr           :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)   ctr = modeCtr' incIV+   -- | Counter (decryption)   unCtr         :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)   unCtr = modeUnCtr' incIV++  -- | Counter (encryption)+  ctrLazy           :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)+  ctrLazy = modeCtr incIV++  -- | Counter (decryption)+  unCtrLazy         :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)+  unCtrLazy = modeUnCtr incIV+   -- | Ciphertext feedback (encryption)   cfb           :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)   cfb = modeCfb'@@ -171,10 +194,262 @@   -- | Output feedback (encryption)   ofb           :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)   ofb = modeOfb'+   -- | Output feedback (decryption)   unOfb         :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)   unOfb = modeUnOfb' +  -- |Cipher block chaining encryption for lazy bytestrings+  cbcLazy       :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)+  cbcLazy = modeCbc++  -- |Cipher block chaining decryption for lazy bytestrings+  unCbcLazy     :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)+  unCbcLazy = modeUnCbc++  -- |SIV (Synthetic IV) mode for lazy bytestrings. The third 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.+  sivLazy :: k -> k -> [L.ByteString] -> L.ByteString -> Maybe L.ByteString+  sivLazy = modeSiv++  -- |SIV (Synthetic IV) for lazy bytestrings.  The third 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.+  unSivLazy :: k -> k -> [L.ByteString] -> L.ByteString -> Maybe L.ByteString+  unSivLazy = modeUnSiv++  -- |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 :: k -> k -> [B.ByteString] -> B.ByteString -> Maybe B.ByteString+  siv = modeSiv'++  -- |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 :: k -> k -> [B.ByteString] -> B.ByteString -> Maybe B.ByteString+  unSiv = modeUnSiv'++  -- |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.+  ecbLazy :: k -> L.ByteString -> L.ByteString+  ecbLazy = modeEcb++  -- |ECB decrypt, complementary to `ecb`.+  unEcbLazy :: k -> L.ByteString -> L.ByteString+  unEcbLazy = modeUnEcb++  -- |Ciphertext feed-back encryption mode for lazy bytestrings (with s+  -- == blockSize)+  cfbLazy :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)+  cfbLazy = modeCfb++  -- |Ciphertext feed-back decryption mode for lazy bytestrings (with s+  -- == blockSize)+  unCfbLazy :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)+  unCfbLazy = modeUnCfb++  -- |Output feedback mode for lazy bytestrings+  ofbLazy  :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)+  ofbLazy = modeOfb++  -- |Output feedback mode for lazy bytestrings+  unOfbLazy :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)+  unOfbLazy = modeUnOfb++-- |Output feedback mode for lazy bytestrings+modeOfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)+modeOfb = modeUnOfb+{-# INLINEABLE modeOfb #-}++-- |Output feedback mode for lazy bytestrings+modeUnOfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)+modeUnOfb k (IV iv) msg =+        let ivStr = drop 1 (iterate (encryptBlock k) iv)+            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 modeUnOfb #-}+++-- |Ciphertext feed-back encryption mode for lazy bytestrings (with s+-- == blockSize)+modeCfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)+modeCfb k (IV v) msg =+        let blks = chunkFor k msg+            (cs,ivF) = go v blks+        in (L.fromChunks cs, IV ivF)+  where+  go iv [] = ([],iv)+  go iv (b:bs) =+        let c = zwp' (encryptBlock k iv) b+            (cs,ivFinal) = go c bs+        in (c:cs, ivFinal)+{-# INLINEABLE modeCfb #-}++-- |Ciphertext feed-back decryption mode for lazy bytestrings (with s+-- == blockSize)+modeUnCfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)+modeUnCfb k (IV v) msg = +        let blks = chunkFor k msg+            (ps, ivF) = go v blks+        in (L.fromChunks ps, IV ivF)+  where+  go iv [] = ([], iv)+  go iv (b:bs) =+        let p = zwp' (encryptBlock k iv) b+            (ps, ivF) = go b bs+        in (p:ps, ivF)+{-# INLINEABLE modeUnCfb #-}++-- |Obtain an `IV` using the provided CryptoRandomGenerator.+getIV :: (BlockCipher k, CryptoRandomGen g) => g -> Either GenError (IV k, g)+getIV g =+        let bytes = ivBlockSizeBytes iv+            gen = genBytes bytes g+            fromRight (Right x) = x+            iv  = IV (fst  . fromRight $ gen)+        in case gen of+                Left err -> Left err+                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)+getIVIO = do+        let p = Proxy+            getTypedIV :: BlockCipher k => Proxy k -> IO (IV k)+            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 = const Proxy++deIVProxy :: Proxy (IV k) -> Proxy k+deIVProxy = const Proxy++-- |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.+modeEcb :: BlockCipher k => k -> L.ByteString -> L.ByteString+modeEcb k msg =+        let chunks = chunkFor k msg+        in L.fromChunks $ map (encryptBlock k) chunks+{-# INLINEABLE modeEcb #-}++-- |ECB decrypt, complementary to `ecb`.+modeUnEcb :: BlockCipher k => k -> L.ByteString -> L.ByteString+modeUnEcb k msg =+        let chunks = chunkFor k msg+        in L.fromChunks $ map (decryptBlock k) chunks+{-# INLINEABLE modeUnEcb #-}++-- |SIV (Synthetic IV) mode for lazy bytestrings. The third 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.+modeSiv :: BlockCipher k => k -> k -> [L.ByteString] -> L.ByteString -> Maybe L.ByteString+modeSiv k1 k2 xs m+    | length xs > bSizeb - 1 = Nothing+    | otherwise = Just+                . L.append iv+                . fst+                . ctrLazy 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.  The third 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.+modeUnSiv :: BlockCipher k => k -> k -> [L.ByteString] -> L.ByteString -> Maybe L.ByteString+modeUnSiv 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 $ modeUnCtr 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.+modeSiv' :: BlockCipher k => k -> k -> [B.ByteString] -> B.ByteString -> Maybe B.ByteString+modeSiv' k1 k2 xs m | length xs > bSizeb - 1 = Nothing+                | otherwise = Just $ B.append iv $ fst $ Crypto.Classes.ctr 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.+modeUnSiv' :: BlockCipher k => k -> k -> [B.ByteString] -> B.ByteString -> Maybe B.ByteString+modeUnSiv' 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 $ Crypto.Classes.unCtr k2 (IV $ sivMask iv) m+++modeCbc :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)+modeCbc k (IV v) plaintext =+        let blks = chunkFor k plaintext+            (cts, iv) = go blks v+        in (L.fromChunks cts, IV iv)+  where+  go [] iv = ([], iv)+  go (b:bs) iv =+        let c = encryptBlock k (zwp' iv b)+            (cs, ivFinal) = go bs c+        in (c:cs, ivFinal)+{-# INLINEABLE modeCbc #-}++modeUnCbc :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)+modeUnCbc k (IV v) ciphertext =+        let blks = chunkFor k ciphertext+            (pts, iv) = go blks v+        in (L.fromChunks pts, IV iv)+  where+  go [] iv = ([], iv)+  go (c:cs) iv =+        let p = zwp' (decryptBlock k c) iv+            (ps, ivFinal) = go cs c+        in (p:ps, ivFinal)+{-# INLINEABLE modeUnCbc #-}++-- |Counter mode for lazy bytestrings+modeCtr :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> L.ByteString -> (L.ByteString, IV k)+modeCtr = modeUnCtr++-- |Counter  mode for lazy bytestrings+modeUnCtr :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> L.ByteString -> (L.ByteString, IV k)+modeUnCtr 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)++ -- |The number of bytes in a block cipher block blockSizeBytes :: (BlockCipher k) => Tagged k ByteLength blockSizeBytes = fmap (`div` 8) blockSize@@ -207,10 +482,10 @@         Just k  -> return $ k `asTaggedTypeOf` bs  -- |Asymetric ciphers (common ones being RSA or EC based)-class (Serialize p, Serialize v) => AsymCipher p v | p -> v, v -> p where+class AsymCipher p v | p -> v, v -> p where   buildKeyPair :: CryptoRandomGen g => g -> BitLength -> Either GenError ((p,v),g) -- ^ build a public/private key pair using the provided generator-  encryptAsym      :: (CryptoRandomGen g) => g -> p -> B.ByteString -> Either GenError (B.ByteString,g) -- ^ Asymetric encryption-  decryptAsym      :: v -> B.ByteString -> Maybe B.ByteString  -- ^ Asymetric decryption+  encryptAsym      :: (CryptoRandomGen g) => g -> p -> B.ByteString -> Either GenError (B.ByteString, g) -- ^ Asymetric encryption+  decryptAsym      :: (CryptoRandomGen g) => g -> v -> B.ByteString -> Either GenError (B.ByteString, g) -- ^ Asymetric decryption   publicKeyLength  :: p -> BitLength   privateKeyLength :: v -> BitLength @@ -379,13 +654,13 @@         in (p:ps, ivF) {-# INLINEABLE modeUnCfb' #-} -chunkFor' :: (BlockCipher k) => k -> B.ByteString -> [B.ByteString]-chunkFor' k = go+toChunks :: Int -> B.ByteString -> [B.ByteString]+toChunks n val = go val   where-  blkSz = (blockSize `for` k) `div` 8-  go bs | B.length bs < blkSz = []-        | otherwise           = let (blk,rest) = B.splitAt blkSz bs in blk : go rest-{-# INLINE chunkFor' #-}+  go b+    | B.length b == 0 = []+    | otherwise       = let (h,t) = B.splitAt n b+                        in h : go t  -- |Increase an `IV` by one.  This is way faster than decoding, -- increasing, encoding@@ -395,13 +670,60 @@        incw :: Word16 -> Word8 -> (Word16, Word8)        incw i w = let nw=i+(fromIntegral w) in (shiftR nw 8, fromIntegral nw) --- gather a specified number of bytes from the list of bytestrings-collect :: Int -> [B.ByteString] -> [B.ByteString]-collect 0 _ = []-collect _ [] = []-collect i (b:bs)-        | len < i  = b : collect (i - len) bs-        | len >= i = [B.take i b]+-- |Obtain an `IV` made only of zeroes+zeroIV :: (BlockCipher k) => IV k+zeroIV = iv+  where bytes = ivBlockSizeBytes iv+        iv  = IV $ B.replicate  bytes 0++zeroIVcwc :: BlockCipher k => IV k+zeroIVcwc = iv+  where bytes = ivBlockSizeBytes iv - 5  -- a constant of cwc (4 bytes for ctr mode, 1 for a sort of header on the iv)+        iv    = IV $ B.replicate bytes 0++-- Break a bytestring into block size chunks.+chunkFor :: (BlockCipher k) => k -> L.ByteString -> [B.ByteString]+chunkFor k = go   where-  len = B.length b-{-# INLINE collect #-}+  blkSz = (blockSize `for` k) `div` 8+  blkSzI = fromIntegral blkSz+  go bs | L.length bs < blkSzI = []+        | otherwise            = let (blk,rest) = L.splitAt blkSzI bs in B.concat (L.toChunks blk) : go rest+{-# INLINE chunkFor #-}++-- Break a bytestring into block size chunks.+chunkFor' :: (BlockCipher k) => k -> B.ByteString -> [B.ByteString]+chunkFor' k = go+  where+  blkSz = (blockSize `for` k) `div` 8+  go bs | B.length bs < blkSz = []+        | otherwise           = let (blk,rest) = B.splitAt blkSz bs in blk : go rest+{-# INLINE chunkFor' #-}++-- |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)++ivBlockSizeBytes :: BlockCipher k => IV k -> Int+ivBlockSizeBytes iv =+        let p = deIVProxy (proxyOf iv)+        in proxy blockSize p `div` 8+ where+  proxyOf :: a -> Proxy a+  proxyOf = const Proxy+{-# 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 blockSizeBytes pr))+                iv <- doGet p+                return (iv `asProxyTypeOf` ivProxy p)+        put (IV iv) = SP.putByteString iv+
+ Crypto/Classes.hs-boot view
@@ -0,0 +1,4 @@+module Crypto.Classes where+    import Crypto.Types+    class BlockCipher k+    zeroIV :: (BlockCipher k) => IV k
+ Crypto/Classes/Exceptions.hs view
@@ -0,0 +1,132 @@+-- |The module mirrors 'Crypto.Classes' except that errors are thrown as+-- exceptions instead of having returning types of @Either error result@+-- or @Maybe result@.+--+-- NB This module is experimental and might go away or be re-arranged.+{-# LANGUAGE DeriveDataTypeable #-}+module Crypto.Classes.Exceptions +    ( C.Hash(..)+    , C.hashFunc', C.hashFunc+    , C.BlockCipher, C.blockSize, C.encryptBlock, C.decryptBlock+    , C.keyLength+    , C.getIVIO, C.blockSizeBytes, C.keyLengthBytes, C.buildKeyIO+    , C.AsymCipher, C.publicKeyLength, C.privateKeyLength, C.buildKeyPairIO+    , C.Signing, C.signingKeyLength, C.verifyingKeyLength, C.verify+    , C.incIV, C.zeroIV, R.CryptoRandomGen, R.genSeedLength, R.reseedInfo, R.reseedPeriod, R.newGenIO+    --  Types+    , R.GenError(..), R.ReseedInfo(..), CipherError(..)+    -- Modes+    , C.ecb, C.unEcb, C.cbc, C.unCbc, C.ctr, C.unCtr, C.ctrLazy, C.unCtrLazy+    , C.cfb, C.unCfb, C.ofb, C.unOfb, C.cbcLazy, C.unCbcLazy, C.sivLazy, C.unSivLazy+    , C.siv, C.unSiv, C.ecbLazy, C.unEcbLazy, C.cfbLazy, C.unCfbLazy, C.ofbLazy+    , C.unOfbLazy+    -- Wrapped functions+    , buildKey, getIV, buildKeyGen+    , buildKeyPair, encryptAsym, decryptAsym+    , newGen, genBytes, genBytesWithEntropy, reseed, splitGen+    ) where++import qualified Crypto.Random     as R+import           Crypto.Random     (CryptoRandomGen)+import           Crypto.Types+import qualified Crypto.Classes    as C+import qualified Control.Exception as X+import qualified Data.ByteString   as B+import           Data.Data+import           Data.Typeable++data CipherError = GenError R.GenError+                 | KeyGenFailure+        deriving (Show, Read, Eq, Ord, Data, Typeable)++instance X.Exception CipherError++mExcept :: (X.Exception e) => e -> Maybe a -> a+mExcept e = maybe (X.throw e) id++eExcept :: (X.Exception e) => Either e a -> a+eExcept = either X.throw id++-- |Key construction from raw material (typically including key expansion)+--+-- This is a wrapper that can throw a 'CipherError' on exception.+buildKey :: C.BlockCipher k => B.ByteString -> k+buildKey = mExcept KeyGenFailure . C.buildKey++-- |Random 'IV' generation+--+-- This is a wrapper that can throw a 'GenError' on exception.+getIV :: (C.BlockCipher k, CryptoRandomGen g) => g -> (IV k, g)+getIV = eExcept . C.getIV++-- |Symmetric key generation+--+-- This is a wrapper that can throw a 'GenError' on exception.+buildKeyGen :: (CryptoRandomGen g, C.BlockCipher k) => g -> (k, g)+buildKeyGen = eExcept . C.buildKeyGen++-- |Asymetric key generation+--+-- This is a wrapper that can throw a 'GenError' on exception.+buildKeyPair :: (CryptoRandomGen g, C.AsymCipher p v) => g -> BitLength -> ((p,v), g)+buildKeyPair g = eExcept . C.buildKeyPair g++-- |Asymmetric encryption+--+-- This is a wrapper that can throw a 'GenError' on exception.+encryptAsym :: (CryptoRandomGen g, C.AsymCipher p v) => g -> p -> B.ByteString -> (B.ByteString, g)+encryptAsym g p = eExcept . C.encryptAsym g p++-- |Asymmetric decryption+--+-- This is a wrapper that can throw a GenError on exception.+decryptAsym :: (CryptoRandomGen g, C.AsymCipher p v) => g -> v -> B.ByteString -> (B.ByteString, g)+decryptAsym g v = eExcept . C.decryptAsym g v++-- |Instantiate a new random bit generator.  The provided+-- bytestring should be of length >= genSeedLength.  If the+-- bytestring is shorter then the call may fail (suggested+-- error: `NotEnoughEntropy`).  If the bytestring is of+-- sufficent length the call should always succeed.+--+-- This is a wrapper that can throw 'GenError' types as exceptions.+newGen :: CryptoRandomGen g => B.ByteString -> g+newGen = eExcept . R.newGen++-- | @genBytes len g@ generates a random ByteString of length+-- @len@ and new generator.  The 'MonadCryptoRandom' package+-- has routines useful for converting the ByteString to+-- commonly needed values (but 'cereal' or other+-- deserialization libraries would also work).+--+-- This is a wrapper that can throw 'GenError' types as exceptions.+genBytes :: CryptoRandomGen g => ByteLength -> g -> (B.ByteString, g)+genBytes l = eExcept . R.genBytes l++-- |@genBytesWithEntropy g i entropy@ generates @i@ random bytes and use+-- the additional input @entropy@ in the generation of the requested data+-- to increase the confidence our generated data is a secure random stream.+--+-- This is a wrapper that can throw 'GenError' types as exceptions.+genBytesWithEntropy :: CryptoRandomGen g => ByteLength -> B.ByteString -> g -> (B.ByteString, g)+genBytesWithEntropy l b = eExcept . R.genBytesWithEntropy l b++-- |If the generator has produced too many random bytes on its existing+-- seed it will throw a `NeedReseed` exception.  In that case, reseed the+-- generator using this function and a new high-entropy seed of length >=+-- `genSeedLength`.  Using bytestrings that are too short can result in an+-- exception (`NotEnoughEntropy`).+reseed :: CryptoRandomGen g => B.ByteString -> g -> g+reseed l = eExcept . R.reseed l++-- | While the safety and wisdom of a splitting function depends on the+-- properties of the generator being split, several arguments from+-- informed people indicate such a function is safe for NIST SP 800-90+-- generators.  (see libraries\@haskell.org discussion around Sept, Oct+-- 2010).  You can find implementations of such generators in the 'DRBG'+-- package.+--+-- This is a wrapper for 'Crypto.Random.splitGen' which throws errors as+-- exceptions.+splitGen :: CryptoRandomGen g => g -> (g,g)+splitGen = eExcept . R.splitGen
Crypto/Modes.hs view
@@ -12,18 +12,11 @@ -} module Crypto.Modes (         -- * Initialization Vector Type, Modifiers (for all ciphers, all modes that use IVs)-          getIV, getIVIO, zeroIV-        , dblIV-        -- * Blockcipher modes for lazy bytestrings. Versions for strict bytestrings are in 'Crypto.Classes'.-        , Crypto.Modes.ecb, Crypto.Modes.unEcb-        , Crypto.Modes.cbc, Crypto.Modes.unCbc-        , Crypto.Modes.cfb, Crypto.Modes.unCfb-        , Crypto.Modes.ofb, Crypto.Modes.unOfb-        , Crypto.Modes.ctr, Crypto.Modes.unCtr-        , siv, unSiv, siv', unSiv'+          dblIV         -- * Authentication modes-        , cbcMac', cbcMac, cMac, cMac' -        -- * Combined modes (nothing here yet)+        , cbcMac', cbcMac, cMac, cMac'+        , cMacStar, cMacStar'+        -- Combined modes (nothing here yet)         -- , gmc         -- , xts         -- , ccm@@ -36,7 +29,7 @@ import qualified Data.Serialize.Get as SG import Data.Bits (xor, shift, (.&.), (.|.), testBit, setBit, clearBit, Bits, complementBit) import Data.Tagged-import Crypto.Classes (BlockCipher(..), for, blockSizeBytes, incIV)+import Crypto.Classes (BlockCipher(..), for, blockSizeBytes, incIV, zeroIV, chunkFor, chunkFor') import Crypto.Random import Crypto.Util import Crypto.CPoly@@ -51,137 +44,17 @@ import Data.Proxy #endif --- gather a specified number of bytes from the list of bytestrings-collect :: Int -> [B.ByteString] -> [B.ByteString]-collect 0 _ = []-collect _ [] = []-collect i (b:bs)-        | len < i  = b : collect (i - len) bs-        | len >= i = [B.take i b]-  where-  len = B.length b-{-# INLINE collect #-}--chunkFor :: (BlockCipher k) => k -> L.ByteString -> [B.ByteString]-chunkFor k = go-  where-  blkSz = (blockSize `for` k) `div` 8-  blkSzI = fromIntegral blkSz-  go bs | L.length bs < blkSzI = []-        | otherwise            = let (blk,rest) = L.splitAt blkSzI bs in B.concat (L.toChunks blk) : go rest-{-# INLINE chunkFor #-}--chunkFor' :: (BlockCipher k) => k -> B.ByteString -> [B.ByteString]-chunkFor' k = go-  where-  blkSz = (blockSize `for` k) `div` 8-  go bs | B.length bs < blkSz = []-        | otherwise           = let (blk,rest) = B.splitAt blkSz bs in blk : go rest-{-# INLINE chunkFor' #-}---- |zipWith xor + Pack--- --- This is written intentionally to take advantage--- of the bytestring 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-        in L.fromChunks (go as bs)-  where-  go [] _ = []-  go _ [] = []-  go (a:as) (b:bs) =-        let l = min (B.length a) (B.length b)-            (a',ar) = B.splitAt l a-            (b',br) = B.splitAt l b-            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 #-}---- |Cipher block chaining encryption mode on strict bytestrings-cbc' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)-cbc' k (IV v) plaintext =-        let blks = chunkFor' k plaintext-            (cts, iv) = go blks v-        in (B.concat cts, IV iv)-  where-  go [] iv = ([], iv)-  go (b:bs) iv =-        let c = encryptBlock k (zwp' iv b)-            (cs, ivFinal) = go bs c-        in (c:cs, ivFinal)-{-# INLINEABLE cbc' #-}- -- |Cipher block chaining message authentication cbcMac' :: BlockCipher k => k -> B.ByteString -> B.ByteString-cbcMac' k pt = encode $ snd $ cbc' k zeroIV pt+cbcMac' k pt = encode $ snd $ cbc k zeroIV pt {-# INLINEABLE cbcMac' #-}  -- |Cipher block chaining message authentication cbcMac :: BlockCipher k => k -> L.ByteString -> L.ByteString-cbcMac k pt = L.fromChunks [encode $ snd $ Crypto.Modes.cbc k zeroIV pt]+cbcMac k pt = L.fromChunks [encode $ snd $ cbcLazy k zeroIV pt] {-# INLINEABLE cbcMac #-} --- |Cipher block chaining decryption for strict bytestrings-unCbc' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)-unCbc' k (IV v) ciphertext =-        let blks = chunkFor' k ciphertext-            (pts, iv) = go blks v-        in (B.concat pts, IV iv)-  where-  go [] iv = ([], iv)-  go (c:cs) iv =-        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)-cbc k (IV v) plaintext =-        let blks = chunkFor k plaintext-            (cts, iv) = go blks v-        in (L.fromChunks cts, IV iv)-  where-  go [] iv = ([], iv)-  go (b:bs) iv =-        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)-unCbc k (IV v) ciphertext =-        let blks = chunkFor k ciphertext-            (pts, iv) = go blks v-        in (L.fromChunks pts, IV iv)-  where-  go [] iv = ([], iv)-  go (c:cs) iv =-        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 = Crypto.Modes.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)---- |Generate cmac subkeys.  The usage of seq tries to force evaluation--- of both keys avoiding posible timing attacks+-- |Generate cmac subkeys. cMacSubk :: BlockCipher k => k -> (IV k, IV k) cMacSubk k = (k1, k2) `seq` (k1, k2)   where@@ -232,13 +105,6 @@ 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@@ -262,69 +128,11 @@                 | 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 $ Crypto.Modes.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 $ Crypto.Modes.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 $ Crypto.Classes.ctr 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 $ Crypto.Classes.unCtr k2 (IV $ sivMask iv) m+-- |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)))  -- |Accumulator based double operation dblw :: Bool -> (Int,[Int],Bool) -> Word8 -> ((Int,[Int],Bool), Word8)@@ -392,177 +200,6 @@         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---- |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.-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 #-}---- |ECB decrypt, complementary to `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 #-}---- | Like `ecb` but for strict bytestrings-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' #-}---- |Decryption complement to `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)-cfb k (IV v) msg =-        let blks = chunkFor k msg-            (cs,ivF) = go v blks-        in (L.fromChunks cs, IV ivF)-  where-  go iv [] = ([],iv)-  go iv (b:bs) =-        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)-unCfb k (IV v) msg = -        let blks = chunkFor k msg-            (ps, ivF) = go v blks-        in (L.fromChunks ps, IV ivF)-  where-  go iv [] = ([], iv)-  go iv (b:bs) =-        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)-cfb' k (IV v) msg =-        let blks = chunkFor' k msg-            (cs,ivF) = go v blks-        in (B.concat cs, IV ivF)-  where-  go iv [] = ([],iv)-  go iv (b:bs) =-        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)-unCfb' k (IV v) msg =-        let blks = chunkFor' k msg-            (ps, ivF) = go v blks-        in (B.concat ps, IV ivF)-  where-  go iv [] = ([], iv)-  go iv (b:bs) =-        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 = Crypto.Modes.unOfb-{-# INLINEABLE ofb #-}---- |Output feedback mode for lazy bytestrings-unOfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)-unOfb k (IV iv) msg =-        let ivStr = drop 1 (iterate (encryptBlock k) iv)-            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)-unOfb' k (IV iv) msg =-        let ivStr = collect (B.length msg + ivLen) (drop 1 (iterate (encryptBlock k) iv))-            ivLen = B.length iv-            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)-{-# INLINEABLE unOfb' #-}---- |Obtain an `IV` using the provided CryptoRandomGenerator.-getIV :: (BlockCipher k, CryptoRandomGen g) => g -> Either GenError (IV k, g)-getIV g =-        let bytes = ivBlockSizeBytes iv-            gen = genBytes bytes g-            fromRight (Right x) = x-            iv  = IV (fst  . fromRight $ gen)-        in case gen of-                Left err -> Left err-                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)-getIVIO = do-        let p = Proxy-            getTypedIV :: BlockCipher k => Proxy k -> IO (IV k)-            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 = const Proxy--deIVProxy :: Proxy (IV k) -> Proxy k-deIVProxy = const Proxy--proxyOf :: a -> Proxy a-proxyOf = const Proxy--ivBlockSizeBytes :: BlockCipher k => IV k -> Int-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 blockSizeBytes pr))-                iv <- doGet p-                return (iv `asProxyTypeOf` ivProxy p)-        put (IV iv) = SP.putByteString iv  -- TODO: GCM, GMAC -- Consider the AES-only modes of XTS, CCM
+ Crypto/Modes.hs-boot view
@@ -0,0 +1,24 @@+{-# LANGUAGE CPP #-}+{-|+ Maintainer: Thomas.DuBuisson@gmail.com+ Stability: beta+ Portability: portable + Authors: Thomas DuBuisson+++ Generic mode implementations useable by any correct BlockCipher+ instance Be aware there are no tests for CFB mode yet.  See+ 'Test.Crypto'.+-}+module Crypto.Modes where+  import {-# SOURCE #-} Crypto.Classes+  import Crypto.Types+  import Data.ByteString as B+  import Data.ByteString.Lazy as L+  dblIV   :: BlockCipher k => IV k -> IV k+  cbcMac' :: BlockCipher k => k -> B.ByteString -> B.ByteString+  cbcMac  :: BlockCipher k => k -> L.ByteString -> L.ByteString+  cMac    :: BlockCipher k => k -> L.ByteString -> L.ByteString+  cMac'   :: BlockCipher k => k -> B.ByteString -> B.ByteString+  cMacStar :: BlockCipher k => k -> [L.ByteString] -> L.ByteString+  cMacStar' :: BlockCipher k => k -> [B.ByteString] -> B.ByteString
Crypto/Random.hs view
@@ -39,6 +39,7 @@ import Crypto.Types import Crypto.Util import Data.Bits (xor, setBit, shiftR, shiftL, (.&.))+import Data.Data import Data.List (foldl') import Data.Tagged import Data.Typeable@@ -75,14 +76,14 @@         | NeedsInfiniteSeed     -- ^ This generator can not be                                 -- instantiated or reseeded with a                                 -- finite seed (ex: 'SystemRandom')-  deriving (Eq, Ord, Show, Read, Typeable)+  deriving (Eq, Ord, Show, Read, Data, Typeable)  data ReseedInfo     = InXBytes {-# UNPACK #-} !Word64   -- ^ Generator needs reseeded in X bytes     | InXCalls {-# UNPACK #-} !Word64   -- ^ Generator needs reseeded in X calls-    | NotSoon           -- ^ The bound is over 2^64 bytes or calls-    | Never             -- ^ This generator never reseeds (ex: 'SystemRandom')-  deriving (Eq, Ord, Show, Read, Typeable)+    | NotSoon                           -- ^ The bound is over 2^64 bytes or calls+    | Never                             -- ^ This generator never reseeds (ex: 'SystemRandom')+  deriving (Eq, Ord, Show, Read, Data, Typeable)  instance Exception GenError @@ -152,7 +153,7 @@                                 in Right (zwp' entropy' bs, g')          -- |If the generator has produced too many random bytes on its-        -- existing seed it will throw `NeedReseed`.  In that case,+        -- existing seed it will return `NeedReseed`.  In that case,         -- reseed the generator using this function and a new         -- high-entropy seed of length >= `genSeedLength`.  Using         -- bytestrings that are too short can result in an error@@ -177,7 +178,7 @@                         Left _ -> go (i+1)                         Right g -> return (g `asProxyTypeOf` p) --- |get a random number generator based on the standard system entropy source+-- |Get a random number generator based on the standard system entropy source getSystemGen :: IO SystemRandom getSystemGen = do         ch <- openHandle@@ -207,11 +208,11 @@   genSeedLength = Tagged maxBound   genBytes req (SysRandom bs) =     let reqI = fromIntegral req-        rnd = L.take reqI bs+        rnd  = L.take reqI bs         rest = L.drop reqI bs     in if L.length rnd == reqI         then Right (B.concat $ L.toChunks rnd, SysRandom rest)-        else Left $ RequestedTooManyBytes+        else Left RequestedTooManyBytes   reseed _ _ = Left NeedsInfiniteSeed   newGenIO = getSystemGen   reseedInfo _ = Never@@ -221,7 +222,8 @@ -- properties of the generator being split, several arguments from -- informed people indicate such a function is safe for NIST SP 800-90 -- generators.  (see libraries\@haskell.org discussion around Sept, Oct--- 2010)+-- 2010).  You can find implementations of such generators in the 'DRBG'+-- package. splitGen :: CryptoRandomGen g => g -> Either GenError (g,g) splitGen g =   let e = genBytes (genSeedLength `for` g) g
Crypto/Types.hs view
@@ -1,8 +1,12 @@+{-# LANGUAGE DeriveDataTypeable #-} -- |Type aliases used throughout the crypto-api modules. module Crypto.Types where -import Data.ByteString as B-import Data.ByteString.Lazy as L+import qualified Control.Exception      as X+import           Data.Data+import           Data.Typeable+import           Data.ByteString        as B+import           Data.ByteString.Lazy   as L  -- |Initilization Vectors for BlockCipher implementations (IV k) are -- used for various modes and guarrenteed to be blockSize bits long.@@ -16,9 +20,16 @@                } deriving (Eq, Ord, Show)  - -- |The length of a field (usually a ByteString) in bits type BitLength = Int  -- |The length fo a field in bytes. type ByteLength = Int++data BlockCipherError = InputTooLong String+                      | AuthenticationFailed String+                      | Other String+  deriving (Eq, Ord, Show, Read, Data, Typeable)++instance X.Exception BlockCipherError+
Crypto/Util.hs view
@@ -2,6 +2,7 @@ module Crypto.Util where  import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L import Data.ByteString.Unsafe (unsafeIndex, unsafeUseAsCStringLen) import Data.Bits (shiftL, shiftR) import Data.Bits (xor, setBit, shiftR, shiftL)@@ -85,4 +86,38 @@ zwp' :: B.ByteString -> B.ByteString -> B.ByteString zwp' a = B.pack . B.zipWith xor a {-# INLINE zwp' #-}++-- |zipWith xor + Pack+--+-- This is written intentionally to take advantage+-- of the bytestring 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+        in L.fromChunks (go as bs)+  where+  go [] _ = []+  go _ [] = []+  go (a:as) (b:bs) =+        let l = min (B.length a) (B.length b)+            (a',ar) = B.splitAt l a+            (b',br) = B.splitAt l b+            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 #-}++-- gather a specified number of bytes from the list of bytestrings+collect :: Int -> [B.ByteString] -> [B.ByteString]+collect 0 _ = []+collect _ [] = []+collect i (b:bs)+        | len < i  = b : collect (i - len) bs+        | len >= i = [B.take i b]+  where+  len = B.length b+{-# INLINE collect #-}
crypto-api.cabal view
@@ -1,5 +1,5 @@ name:           crypto-api-version:        0.12.2.2+version:        0.13 license:        BSD3 license-file:   LICENSE copyright:      Thomas DuBuisson <thomas.dubuisson@gmail.com>@@ -43,7 +43,7 @@   hs-source-dirs:   exposed-modules: Crypto.Classes, Crypto.Types, Crypto.HMAC,                    Crypto.Random, Crypto.Padding, Crypto.Modes,-                   Crypto.Util+                   Crypto.Util, Crypto.Classes.Exceptions   other-modules: Crypto.CPoly   extensions: ForeignFunctionInterface, MultiParamTypeClasses,               BangPatterns, FunctionalDependencies, FlexibleInstances,