crypto-api 0.12.2.2 → 0.13.3
raw patch · 9 files changed
Files
- Crypto/Classes.hs +348/−24
- Crypto/Classes.hs-boot +133/−0
- Crypto/Classes/Exceptions.hs +141/−0
- Crypto/Modes.hs +14/−383
- Crypto/Modes.hs-boot +24/−0
- Crypto/Random.hs +15/−11
- Crypto/Types.hs +14/−3
- Crypto/Util.hs +35/−0
- crypto-api.cabal +2/−2
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.Entropy')+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@@ -184,7 +459,7 @@ keyLengthBytes :: (BlockCipher k) => Tagged k ByteLength keyLengthBytes = fmap (`div` 8) keyLength --- |Build a symmetric key using the system entropy (see 'System.Crypto.Random')+-- |Build a symmetric key using the system entropy (see 'System.Entropy') buildKeyIO :: (BlockCipher k) => IO k buildKeyIO = buildKeyM getEntropy fail @@ -207,14 +482,15 @@ 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 -- |Build a pair of asymmetric keys using the system random generator.+-- WARNING: This function opens a file handle which will never be closed! buildKeyPairIO :: AsymCipher p v => BitLength -> IO (Either GenError (p,v)) buildKeyPairIO bl = do g <- newGenIO :: IO SystemRandom@@ -267,6 +543,7 @@ verifyingKeyLength :: p -> BitLength -- |Build a signing key using the system random generator+-- WARNING: This function opens a file handle which will never be closed! buildSigningKeyPairIO :: (Signing p v) => BitLength -> IO (Either GenError (p,v)) buildSigningKeyPairIO bl = do g <- newGenIO :: IO SystemRandom@@ -379,13 +656,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 +672,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,133 @@+{-|+ Maintainer: Thomas.DuBuisson@gmail.com+ Stability: beta+ Portability: portable + Authors: Thomas DuBuisson++This is the heart of the crypto-api package. By making (or having) an instance+of Hash, AsymCipher, BlockCipher or StreamCipher you provide (or obtain) access+to any infrastructure built on these primitives include block cipher modes of+operation, hashing, hmac, signing, etc. These classes allow users to build+routines that are agnostic to the algorithm used so changing algorithms is as+simple as changing a type signature.+-}+module Crypto.Classes where++ import Data.ByteString as B+ import Data.ByteString.Lazy as L+ import Crypto.Types+ import Data.Serialize+ import Data.Tagged++ class ( Serialize k) => BlockCipher k where+ blockSize :: Tagged k BitLength -- ^ The size of a single block; the smallest unit on which the cipher operates.+ encryptBlock :: k -> B.ByteString -> B.ByteString -- ^ encrypt data of size @n*blockSize@ where @n `elem` [0..]@ (ecb encryption)+ decryptBlock :: k -> B.ByteString -> B.ByteString -- ^ decrypt data of size @n*blockSize@ where @n `elem` [0..]@ (ecb decryption)+ buildKey :: B.ByteString -> Maybe k -- ^ smart constructor for keys from a bytestring.+ keyLength :: Tagged k BitLength -- ^ length of the cryptographic key++ -- * Modes of operation over strict bytestrings+ -- | Electronic Cookbook (encryption)+ ecb :: k -> B.ByteString -> B.ByteString+ ecb = modeEcb'+ -- | Electronic Cookbook (decryption)+ unEcb :: k -> B.ByteString -> B.ByteString+ unEcb = modeUnEcb'+ -- | Cipherblock Chaining (encryption)+ cbc :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)+ cbc = modeCbc'+ -- | 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'+ -- | Ciphertext feedback (decryption)+ unCfb :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)+ unCfb = modeUnCfb'+ -- | 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
+ Crypto/Classes/Exceptions.hs view
@@ -0,0 +1,141 @@+-- |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 + ( -- * Classes+ C.Hash(..), C.AsymCipher, R.CryptoRandomGen, C.BlockCipher+ -- * Hashing Operations+ , C.hashFunc', C.hashFunc+ -- * Symmetric Cryptographic Operations+ -- ** Helpers+ , C.blockSize, C.blockSizeBytes+ , C.keyLength, C.keyLengthBytes+ , C.incIV+ -- ** Primitives+ , C.encryptBlock, C.decryptBlock+ -- * Key and IV construction+ , buildKey, C.buildKeyIO, buildKeyGen+ , getIV ,C.getIVIO, C.zeroIV+ -- ** Block Cipher Modes of Operation+ , 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+ -- * RNG Operations+ , newGen, genBytes, genBytesWithEntropy, reseed, splitGen+ , R.genSeedLength, R.reseedInfo, R.reseedPeriod, R.newGenIO+ -- * Info Types+ , R.GenError(..), R.ReseedInfo(..), CipherError(..)+ -- * Asymmetric cryptographic operations+ , buildKeyPair, encryptAsym, decryptAsym+ , C.Signing, C.signingKeyLength, C.verifyingKeyLength, C.verify+ , C.publicKeyLength, C.privateKeyLength, C.buildKeyPairIO+ ) 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
@@ -2,28 +2,15 @@ {-| 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'.+ Portability: portable -} 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 +23,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 +38,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 +99,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 +122,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 +194,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
@@ -9,7 +9,7 @@ This module is for instantiating cryptographicly strong determinitic random bit generators (DRBGs, aka PRNGs) For the simple use case of using the system random number generator-('System.Crypto.Random') to seed the DRBG:+('System.Entropy') to seed the DRBG: @ g <- newGenIO @@@ -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,15 +153,16 @@ 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 -- (`NotEnoughEntropy`). reseed :: B.ByteString -> g -> Either GenError g - -- |By default this uses "System.Crypto.Random" to obtain+ -- |By default this uses "System.Entropy" to obtain -- entropy for `newGen`.+ -- WARNING: The default implementation opens a file handle which will never be closed! newGenIO :: IO g newGenIO = go 0 where@@ -177,7 +179,8 @@ 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+-- WARNING: This function opens a file handle which will never be closed! getSystemGen :: IO SystemRandom getSystemGen = do ch <- openHandle@@ -207,11 +210,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 +224,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.3 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,