{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# LANGUAGE ParallelListComp #-}
{-|
 Maintainer: Thomas.DuBuisson@gmail.com
 Stability: beta
 Portability: portable 

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
        (
        -- * Hash class and helper functions
          Hash(..)
        , hashFunc'
        , hashFunc
        -- * Cipher classes and helper functions
        , BlockCipher(..)
        , blockSizeBytes
        , keyLengthBytes
        , buildKeyIO
        , buildKeyGen
        , StreamCipher(..)
        , buildStreamKeyIO
        , buildStreamKeyGen
        , AsymCipher(..)
        , buildKeyPairIO
        , buildKeyPairGen
        , Signing(..)
        , buildSigningKeyPairIO
        , 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 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
import System.IO.Unsafe (unsafePerformIO)
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.
-- Using this generic interface, higher level functions
-- such as 'hash' and 'hash'' provide a useful API
-- for comsumers of hash implementations.
--
-- Any instantiated implementation must handle unaligned data.
--
-- Minimum complete definition: 'outputLength', 'blockLength', 'initialCtx',
-- 'updateCtx', and 'finalize'.
class (Serialize d, Eq d, Ord d)
    => Hash ctx d | d -> ctx, ctx -> d where
  outputLength  :: Tagged d BitLength         -- ^ The size of the digest when encoded
  blockLength   :: Tagged d BitLength         -- ^ The amount of data operated on in each round of the digest computation
  initialCtx    :: ctx                        -- ^ An initial context, provided with the first call to 'updateCtx'
  updateCtx     :: ctx -> B.ByteString -> ctx -- ^ Used to update a context, repeatedly called until all data is exhausted
                                              --   must operate correctly for imputs of @n*blockLength@ bytes for @n `elem` [0..]@
  finalize      :: ctx -> B.ByteString -> d   -- ^ Finializing a context, plus any message data less than the block size, into a digest

  -- |Hash a lazy ByteString, creating a digest
  hash :: (Hash ctx d) => L.ByteString -> d
  hash ByteString
msg = d
res
    where
    res :: d
res = ctx -> ByteString -> d
forall ctx d. Hash ctx d => ctx -> ByteString -> d
finalize ctx
ctx ByteString
end
    ctx :: ctx
ctx = (ctx -> ByteString -> ctx) -> ctx -> [ByteString] -> ctx
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ctx -> ByteString -> ctx
forall ctx d. Hash ctx d => ctx -> ByteString -> ctx
updateCtx ctx
forall ctx d. Hash ctx d => ctx
initialCtx [ByteString]
blks
    ([ByteString]
blks,ByteString
end) = ByteString -> Int -> ([ByteString], ByteString)
makeBlocks ByteString
msg Int
blockLen
    blockLen :: Int
blockLen = (Tagged d Int
forall ctx d. Hash ctx d => Tagged d Int
blockLength Tagged d Int -> d -> Int
forall a b. Tagged a b -> a -> b
.::. d
res) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8

  -- |Hash a strict ByteString, creating a digest
  hash' :: (Hash ctx d) => B.ByteString -> d
  hash' ByteString
msg = d
res
    where
    res :: d
res = ctx -> ByteString -> d
forall ctx d. Hash ctx d => ctx -> ByteString -> d
finalize (ctx -> ByteString -> ctx
forall ctx d. Hash ctx d => ctx -> ByteString -> ctx
updateCtx ctx
forall ctx d. Hash ctx d => ctx
initialCtx ByteString
top) ByteString
end
    (ByteString
top, ByteString
end) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
remlen ByteString
msg
    remlen :: Int
remlen = ByteString -> Int
B.length ByteString
msg Int -> Int -> Int
forall a. Num a => a -> a -> a
- (ByteString -> Int
B.length ByteString
msg Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
bLen)
    bLen :: Int
bLen = Tagged d Int
forall ctx d. Hash ctx d => Tagged d Int
blockLength Tagged d Int -> d -> Int
forall a b. Tagged a b -> a -> b
`for` d
res Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8

-- |Obtain a lazy hash function whose result is the same type
-- as the given digest, which is discarded.  If the type is already inferred then
-- consider using the 'hash' function instead.
hashFunc :: Hash c d => d -> (L.ByteString -> d)
hashFunc :: forall c d. Hash c d => d -> ByteString -> d
hashFunc d
d = ByteString -> d
f
  where
  f :: ByteString -> d
f = ByteString -> d
forall ctx d. (Hash ctx d, Hash ctx d) => ByteString -> d
hash
  a :: d
a = ByteString -> d
f ByteString
forall a. HasCallStack => a
undefined d -> d -> d
forall a. a -> a -> a
`asTypeOf` d
d

-- |Obtain a strict hash function whose result is the same type
-- as the given digest, which is discarded.  If the type is already inferred then
-- consider using the 'hash'' function instead.
hashFunc' :: Hash c d => d -> (B.ByteString -> d)
hashFunc' :: forall c d. Hash c d => d -> ByteString -> d
hashFunc' d
d = ByteString -> d
f
  where
  f :: ByteString -> d
f = ByteString -> d
forall ctx d. (Hash ctx d, Hash ctx d) => ByteString -> d
hash'
  a :: d
a = ByteString -> d
f ByteString
forall a. HasCallStack => a
undefined d -> d -> d
forall a. a -> a -> a
`asTypeOf` d
d

{-# INLINABLE makeBlocks #-}
makeBlocks :: L.ByteString -> ByteLength -> ([B.ByteString], B.ByteString)
makeBlocks :: ByteString -> Int -> ([ByteString], ByteString)
makeBlocks ByteString
msg Int
len = [ByteString] -> ([ByteString], ByteString)
go (ByteString -> [ByteString]
L.toChunks ByteString
msg)
  where
  go :: [ByteString] -> ([ByteString], ByteString)
go [] = ([],ByteString
B.empty)
  go (ByteString
x:[ByteString]
xs)
    | ByteString -> Int
B.length ByteString
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len =
        let l :: Int
l = ByteString -> Int
B.length ByteString
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
len
            (ByteString
top,ByteString
end) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
l ByteString
x
            ([ByteString]
rest,ByteString
trueEnd) = [ByteString] -> ([ByteString], ByteString)
go (ByteString
endByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
xs)
        in (ByteString
topByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
rest, ByteString
trueEnd)
    | Bool
otherwise =
        case [ByteString]
xs of
                [] -> ([], ByteString
x)
                (ByteString
a:[ByteString]
as) -> [ByteString] -> ([ByteString], ByteString)
go (ByteString -> ByteString -> ByteString
B.append ByteString
x ByteString
a ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
as)

-- |The BlockCipher class is intended as the generic interface
-- targeted by maintainers of Haskell 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.
  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 = k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
modeEcb'
  -- | Electronic Cookbook (decryption)
  unEcb         :: k -> B.ByteString -> B.ByteString
  unEcb = k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
modeUnEcb'
  -- | Cipherblock Chaining (encryption)
  cbc           :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)
  cbc = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeCbc'
  -- | Cipherblock Chaining (decryption)
  unCbc         :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)
  unCbc = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCbc'

  -- | Counter (encryption)
  ctr           :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)
  ctr = (IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
(IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
modeCtr' IV k -> IV k
forall k. BlockCipher k => IV k -> IV k
incIV

  -- | Counter (decryption)
  unCtr         :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)
  unCtr = (IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
(IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCtr' IV k -> IV k
forall k. BlockCipher k => IV k -> IV k
incIV

  -- | Counter (encryption)
  ctrLazy           :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)
  ctrLazy = (IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
(IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
modeCtr IV k -> IV k
forall k. BlockCipher k => IV k -> IV k
incIV

  -- | Counter (decryption)
  unCtrLazy         :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)
  unCtrLazy = (IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
(IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCtr IV k -> IV k
forall k. BlockCipher k => IV k -> IV k
incIV

  -- | Ciphertext feedback (encryption)
  cfb           :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)
  cfb = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeCfb'
  -- | Ciphertext feedback (decryption)
  unCfb         :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)
  unCfb = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCfb'
  -- | Output feedback (encryption)
  ofb           :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)
  ofb = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeOfb'

  -- | Output feedback (decryption)
  unOfb         :: k -> IV k -> B.ByteString -> (B.ByteString, IV k)
  unOfb = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnOfb'

  -- |Cipher block chaining encryption for lazy bytestrings
  cbcLazy       :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)
  cbcLazy = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeCbc

  -- |Cipher block chaining decryption for lazy bytestrings
  unCbcLazy     :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)
  unCbcLazy = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
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 = k -> k -> [ByteString] -> ByteString -> Maybe ByteString
forall k.
BlockCipher k =>
k -> k -> [ByteString] -> ByteString -> Maybe ByteString
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 = k -> k -> [ByteString] -> ByteString -> Maybe ByteString
forall k.
BlockCipher k =>
k -> k -> [ByteString] -> ByteString -> Maybe ByteString
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 = k -> k -> [ByteString] -> ByteString -> Maybe ByteString
forall k.
BlockCipher k =>
k -> k -> [ByteString] -> ByteString -> Maybe ByteString
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 = k -> k -> [ByteString] -> ByteString -> Maybe ByteString
forall k.
BlockCipher k =>
k -> k -> [ByteString] -> ByteString -> Maybe ByteString
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 = k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
modeEcb

  -- |ECB decrypt, complementary to `ecb`.
  unEcbLazy :: k -> L.ByteString -> L.ByteString
  unEcbLazy = k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
modeUnEcb

  -- |Ciphertext feed-back encryption mode for lazy bytestrings (with s
  -- == blockSize)
  cfbLazy :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)
  cfbLazy = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeCfb

  -- |Ciphertext feed-back decryption mode for lazy bytestrings (with s
  -- == blockSize)
  unCfbLazy :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)
  unCfbLazy = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCfb

  -- |Output feedback mode for lazy bytestrings
  ofbLazy  :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)
  ofbLazy = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeOfb

  -- |Output feedback mode for lazy bytestrings
  unOfbLazy :: k -> IV k -> L.ByteString -> (L.ByteString, IV k)
  unOfbLazy = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnOfb

-- |Output feedback mode for lazy bytestrings
modeOfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)
modeOfb :: forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeOfb = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnOfb
{-# INLINEABLE modeOfb #-}

-- |Output feedback mode for lazy bytestrings
modeUnOfb :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)
modeUnOfb :: forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnOfb k
k (IV ByteString
iv) ByteString
msg =
        let ivStr :: [ByteString]
ivStr = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
1 ((ByteString -> ByteString) -> ByteString -> [ByteString]
forall a. (a -> a) -> a -> [a]
iterate (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k) ByteString
iv)
            ivLen :: Int64
ivLen = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
iv)
            newIV :: IV k
newIV = ByteString -> IV k
forall k. ByteString -> IV k
IV (ByteString -> IV k)
-> ([ByteString] -> ByteString) -> [ByteString] -> IV k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString])
-> ([ByteString] -> ByteString) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
L.take Int64
ivLen (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
L.drop (ByteString -> Int64
L.length ByteString
msg) (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
L.fromChunks ([ByteString] -> IV k) -> [ByteString] -> IV k
forall a b. (a -> b) -> a -> b
$ [ByteString]
ivStr
        in (ByteString -> ByteString -> ByteString
zwp ([ByteString] -> ByteString
L.fromChunks [ByteString]
ivStr) ByteString
msg, IV k
forall {k}. IV k
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 :: forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeCfb k
k (IV ByteString
v) ByteString
msg =
        let blks :: [ByteString]
blks = k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor k
k ByteString
msg
            ([ByteString]
cs,ByteString
ivF) = ByteString -> [ByteString] -> ([ByteString], ByteString)
go ByteString
v [ByteString]
blks
        in ([ByteString] -> ByteString
L.fromChunks [ByteString]
cs, ByteString -> IV k
forall k. ByteString -> IV k
IV ByteString
ivF)
  where
  go :: ByteString -> [ByteString] -> ([ByteString], ByteString)
go ByteString
iv [] = ([],ByteString
iv)
  go ByteString
iv (ByteString
b:[ByteString]
bs) =
        let c :: ByteString
c = ByteString -> ByteString -> ByteString
zwp' (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k ByteString
iv) ByteString
b
            ([ByteString]
cs,ByteString
ivFinal) = ByteString -> [ByteString] -> ([ByteString], ByteString)
go ByteString
c [ByteString]
bs
        in (ByteString
cByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
cs, ByteString
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 :: forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCfb k
k (IV ByteString
v) ByteString
msg = 
        let blks :: [ByteString]
blks = k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor k
k ByteString
msg
            ([ByteString]
ps, ByteString
ivF) = ByteString -> [ByteString] -> ([ByteString], ByteString)
go ByteString
v [ByteString]
blks
        in ([ByteString] -> ByteString
L.fromChunks [ByteString]
ps, ByteString -> IV k
forall k. ByteString -> IV k
IV ByteString
ivF)
  where
  go :: ByteString -> [ByteString] -> ([ByteString], ByteString)
go ByteString
iv [] = ([], ByteString
iv)
  go ByteString
iv (ByteString
b:[ByteString]
bs) =
        let p :: ByteString
p = ByteString -> ByteString -> ByteString
zwp' (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k ByteString
iv) ByteString
b
            ([ByteString]
ps, ByteString
ivF) = ByteString -> [ByteString] -> ([ByteString], ByteString)
go ByteString
b [ByteString]
bs
        in (ByteString
pByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
ps, ByteString
ivF)
{-# INLINEABLE modeUnCfb #-}

-- |Obtain an `IV` using the provided CryptoRandomGenerator.
getIV :: (BlockCipher k, CryptoRandomGen g) => g -> Either GenError (IV k, g)
getIV :: forall k g.
(BlockCipher k, CryptoRandomGen g) =>
g -> Either GenError (IV k, g)
getIV g
g =
        let bytes :: Int
bytes = IV k -> Int
forall k. BlockCipher k => IV k -> Int
ivBlockSizeBytes IV k
iv
            gen :: Either GenError (ByteString, g)
gen = Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
bytes g
g
            fromRight :: Either a b -> b
fromRight (Right b
x) = b
x
            iv :: IV k
iv  = ByteString -> IV k
forall k. ByteString -> IV k
IV ((ByteString, g) -> ByteString
forall a b. (a, b) -> a
fst  ((ByteString, g) -> ByteString)
-> (Either GenError (ByteString, g) -> (ByteString, g))
-> Either GenError (ByteString, g)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either GenError (ByteString, g) -> (ByteString, g)
forall {a} {b}. Either a b -> b
fromRight (Either GenError (ByteString, g) -> ByteString)
-> Either GenError (ByteString, g) -> ByteString
forall a b. (a -> b) -> a -> b
$ Either GenError (ByteString, g)
gen)
        in case Either GenError (ByteString, g)
gen of
                Left GenError
err -> GenError -> Either GenError (IV k, g)
forall a b. a -> Either a b
Left GenError
err
                Right (ByteString
bs,g
g')
                        | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bytes  -> (IV k, g) -> Either GenError (IV k, g)
forall a b. b -> Either a b
Right (IV k
iv, g
g')
                        | Bool
otherwise             -> GenError -> Either GenError (IV k, g)
forall a b. a -> Either a b
Left (String -> GenError
GenErrorOther String
"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 :: forall k. BlockCipher k => IO (IV k)
getIVIO = do
        let p :: Proxy t
p = Proxy t
forall {k} (t :: k). Proxy t
Proxy
            getTypedIV :: BlockCipher k => Proxy k -> IO (IV k)
            getTypedIV :: forall k. BlockCipher k => Proxy k -> IO (IV k)
getTypedIV Proxy k
pr = (ByteString -> IV k) -> IO ByteString -> IO (IV k)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> IV k
forall k. ByteString -> IV k
IV (Int -> IO ByteString
getEntropy (Tagged k Int -> Proxy k -> Int
forall {k} (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSize Proxy k
pr Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8))
        IV k
iv <- Proxy k -> IO (IV k)
forall k. BlockCipher k => Proxy k -> IO (IV k)
getTypedIV Proxy k
forall {t}. Proxy t
p
        IV k -> IO (IV k)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IV k
iv IV k -> Proxy (IV k) -> IV k
forall a (proxy :: * -> *). a -> proxy a -> a
`asProxyTypeOf` Proxy k -> Proxy (IV k)
forall k. Proxy k -> Proxy (IV k)
ivProxy Proxy k
forall {t}. Proxy t
p)
{-# INLINEABLE getIVIO #-}

ivProxy :: Proxy k -> Proxy (IV k)
ivProxy :: forall k. Proxy k -> Proxy (IV k)
ivProxy = Proxy (IV k) -> Proxy k -> Proxy (IV k)
forall a b. a -> b -> a
const Proxy (IV k)
forall {k} (t :: k). Proxy t
Proxy

deIVProxy :: Proxy (IV k) -> Proxy k
deIVProxy :: forall k. Proxy (IV k) -> Proxy k
deIVProxy = Proxy k -> Proxy (IV k) -> Proxy k
forall a b. a -> b -> a
const Proxy k
forall {k} (t :: k). Proxy t
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 :: forall k. BlockCipher k => k -> ByteString -> ByteString
modeEcb k
k ByteString
msg =
        let chunks :: [ByteString]
chunks = k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor k
k ByteString
msg
        in [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k) [ByteString]
chunks
{-# INLINEABLE modeEcb #-}

-- |ECB decrypt, complementary to `ecb`.
modeUnEcb :: BlockCipher k => k -> L.ByteString -> L.ByteString
modeUnEcb :: forall k. BlockCipher k => k -> ByteString -> ByteString
modeUnEcb k
k ByteString
msg =
        let chunks :: [ByteString]
chunks = k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor k
k ByteString
msg
        in [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
decryptBlock k
k) [ByteString]
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 :: forall k.
BlockCipher k =>
k -> k -> [ByteString] -> ByteString -> Maybe ByteString
modeSiv k
k1 k
k2 [ByteString]
xs ByteString
m
    | [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
bSizeb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = Maybe ByteString
forall a. Maybe a
Nothing
    | Bool
otherwise = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just
                (ByteString -> Maybe ByteString)
-> (ByteString -> ByteString) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
L.append ByteString
iv
                (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, IV k) -> ByteString
forall a b. (a, b) -> a
fst
                ((ByteString, IV k) -> ByteString)
-> (ByteString -> (ByteString, IV k)) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
ctrLazy k
k2 (ByteString -> IV k
forall k. ByteString -> IV k
IV (ByteString -> IV k)
-> (ByteString -> ByteString) -> ByteString -> IV k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
sivMask (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> IV k) -> ByteString -> IV k
forall a b. (a -> b) -> a -> b
$ ByteString
iv)
                (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
m
  where
       bSize :: Integer
bSize = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k1
       bSizeb :: Int
bSizeb = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSize Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k1
       iv :: ByteString
iv = k -> [ByteString] -> ByteString
forall k. BlockCipher k => k -> [ByteString] -> ByteString
cMacStar k
k1 ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
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 :: forall k.
BlockCipher k =>
k -> k -> [ByteString] -> ByteString -> Maybe ByteString
modeUnSiv k
k1 k
k2 [ByteString]
xs ByteString
c | [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
bSizeb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = Maybe ByteString
forall a. Maybe a
Nothing
                 | ByteString -> Int64
L.length ByteString
c Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bSize = Maybe ByteString
forall a. Maybe a
Nothing
                 | ByteString
iv ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= (k -> [ByteString] -> ByteString
forall k. BlockCipher k => k -> [ByteString] -> ByteString
cMacStar k
k1 ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
dm]) = Maybe ByteString
forall a. Maybe a
Nothing
                 | Bool
otherwise = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
dm
  where
       bSize :: Integer
bSize = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k1
       bSizeb :: Int
bSizeb = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSize Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k1
       (ByteString
iv,ByteString
m) = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bSize) ByteString
c
       dm :: ByteString
dm = (ByteString, IV k) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, IV k) -> ByteString)
-> (ByteString, IV k) -> ByteString
forall a b. (a -> b) -> a -> b
$ (IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
(IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCtr IV k -> IV k
forall k. BlockCipher k => IV k -> IV k
incIV k
k2 (ByteString -> IV k
forall k. ByteString -> IV k
IV (ByteString -> IV k) -> ByteString -> IV k
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
sivMask (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks ByteString
iv) ByteString
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' :: forall k.
BlockCipher k =>
k -> k -> [ByteString] -> ByteString -> Maybe ByteString
modeSiv' k
k1 k
k2 [ByteString]
xs ByteString
m | [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
bSizeb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = Maybe ByteString
forall a. Maybe a
Nothing
                | Bool
otherwise = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
B.append ByteString
iv (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString, IV k) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, IV k) -> ByteString)
-> (ByteString, IV k) -> ByteString
forall a b. (a -> b) -> a -> b
$ k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
Crypto.Classes.ctr k
k2 (ByteString -> IV k
forall k. ByteString -> IV k
IV (ByteString -> IV k) -> ByteString -> IV k
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
sivMask ByteString
iv) ByteString
m
  where
       bSize :: Integer
bSize = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k1
       bSizeb :: Int
bSizeb = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSize Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k1
       iv :: ByteString
iv = k -> [ByteString] -> ByteString
forall k. BlockCipher k => k -> [ByteString] -> ByteString
cMacStar' k
k1 ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
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' :: forall k.
BlockCipher k =>
k -> k -> [ByteString] -> ByteString -> Maybe ByteString
modeUnSiv' k
k1 k
k2 [ByteString]
xs ByteString
c | [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
bSizeb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = Maybe ByteString
forall a. Maybe a
Nothing
                  | ByteString -> Int
B.length ByteString
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bSize = Maybe ByteString
forall a. Maybe a
Nothing
                  | ByteString
iv ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= (k -> [ByteString] -> ByteString
forall k. BlockCipher k => k -> [ByteString] -> ByteString
cMacStar' k
k1 ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
dm]) = Maybe ByteString
forall a. Maybe a
Nothing
                  | Bool
otherwise = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
dm
  where
       bSize :: Int
bSize = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k1
       bSizeb :: Int
bSizeb = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSize Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k1
       (ByteString
iv,ByteString
m) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
bSize ByteString
c
       dm :: ByteString
dm = (ByteString, IV k) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, IV k) -> ByteString)
-> (ByteString, IV k) -> ByteString
forall a b. (a -> b) -> a -> b
$ k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
Crypto.Classes.unCtr k
k2 (ByteString -> IV k
forall k. ByteString -> IV k
IV (ByteString -> IV k) -> ByteString -> IV k
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
sivMask ByteString
iv) ByteString
m


modeCbc :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)
modeCbc :: forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeCbc k
k (IV ByteString
v) ByteString
plaintext =
        let blks :: [ByteString]
blks = k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor k
k ByteString
plaintext
            ([ByteString]
cts, ByteString
iv) = [ByteString] -> ByteString -> ([ByteString], ByteString)
go [ByteString]
blks ByteString
v
        in ([ByteString] -> ByteString
L.fromChunks [ByteString]
cts, ByteString -> IV k
forall k. ByteString -> IV k
IV ByteString
iv)
  where
  go :: [ByteString] -> ByteString -> ([ByteString], ByteString)
go [] ByteString
iv = ([], ByteString
iv)
  go (ByteString
b:[ByteString]
bs) ByteString
iv =
        let c :: ByteString
c = k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k (ByteString -> ByteString -> ByteString
zwp' ByteString
iv ByteString
b)
            ([ByteString]
cs, ByteString
ivFinal) = [ByteString] -> ByteString -> ([ByteString], ByteString)
go [ByteString]
bs ByteString
c
        in (ByteString
cByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
cs, ByteString
ivFinal)
{-# INLINEABLE modeCbc #-}

modeUnCbc :: BlockCipher k => k -> IV k -> L.ByteString -> (L.ByteString, IV k)
modeUnCbc :: forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCbc k
k (IV ByteString
v) ByteString
ciphertext =
        let blks :: [ByteString]
blks = k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor k
k ByteString
ciphertext
            ([ByteString]
pts, ByteString
iv) = [ByteString] -> ByteString -> ([ByteString], ByteString)
go [ByteString]
blks ByteString
v
        in ([ByteString] -> ByteString
L.fromChunks [ByteString]
pts, ByteString -> IV k
forall k. ByteString -> IV k
IV ByteString
iv)
  where
  go :: [ByteString] -> ByteString -> ([ByteString], ByteString)
go [] ByteString
iv = ([], ByteString
iv)
  go (ByteString
c:[ByteString]
cs) ByteString
iv =
        let p :: ByteString
p = ByteString -> ByteString -> ByteString
zwp' (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
decryptBlock k
k ByteString
c) ByteString
iv
            ([ByteString]
ps, ByteString
ivFinal) = [ByteString] -> ByteString -> ([ByteString], ByteString)
go [ByteString]
cs ByteString
c
        in (ByteString
pByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
ps, ByteString
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 :: forall k.
BlockCipher k =>
(IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
modeCtr = (IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
(IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCtr

-- |Counter  mode for lazy bytestrings
modeUnCtr :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> L.ByteString -> (L.ByteString, IV k)
modeUnCtr :: forall k.
BlockCipher k =>
(IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCtr IV k -> IV k
f k
k (IV ByteString
iv) ByteString
msg =
       let ivStr :: [IV k]
ivStr = (IV k -> IV k) -> IV k -> [IV k]
forall a. (a -> a) -> a -> [a]
iterate IV k -> IV k
f (IV k -> [IV k]) -> IV k -> [IV k]
forall a b. (a -> b) -> a -> b
$ ByteString -> IV k
forall k. ByteString -> IV k
IV ByteString
iv
           ivLen :: Int64
ivLen = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
iv
           newIV :: IV k
newIV = [IV k] -> IV k
forall a. HasCallStack => [a] -> a
head ([IV k] -> IV k) -> [IV k] -> IV k
forall a b. (a -> b) -> a -> b
$ Int64 -> [IV k] -> [IV k]
forall i a. Integral i => i -> [a] -> [a]
genericDrop ((Int64
ivLen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
L.length ByteString
msg) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
ivLen) [IV k]
ivStr
       in (ByteString -> ByteString -> ByteString
zwp ([ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ (IV k -> ByteString) -> [IV k] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map IV k -> ByteString
forall k. IV k -> ByteString
initializationVector [IV k]
ivStr) ByteString
msg, IV k
newIV)


-- |The number of bytes in a block cipher block
blockSizeBytes :: (BlockCipher k) => Tagged k ByteLength
blockSizeBytes :: forall k. BlockCipher k => Tagged k Int
blockSizeBytes = (Int -> Int) -> Tagged k Int -> Tagged k Int
forall a b. (a -> b) -> Tagged k a -> Tagged k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSize

-- |The number of bytes in a block cipher key (assuming it is an even
-- multiple of 8 bits)
keyLengthBytes :: (BlockCipher k) => Tagged k ByteLength
keyLengthBytes :: forall k. BlockCipher k => Tagged k Int
keyLengthBytes = (Int -> Int) -> Tagged k Int -> Tagged k Int
forall a b. (a -> b) -> Tagged k a -> Tagged k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) Tagged k Int
forall k. BlockCipher k => Tagged k Int
keyLength

-- |Build a symmetric key using the system entropy (see 'System.Entropy')
buildKeyIO :: (BlockCipher k) => IO k
buildKeyIO :: forall k. BlockCipher k => IO k
buildKeyIO = (Int -> IO ByteString) -> (String -> IO k) -> IO k
forall k (m :: * -> *).
(BlockCipher k, Monad m) =>
(Int -> m ByteString) -> (String -> m k) -> m k
buildKeyM Int -> IO ByteString
getEntropy String -> IO k
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

-- |Build a symmetric key using a given 'Crypto.Random.CryptoRandomGen'
buildKeyGen :: (BlockCipher k, CryptoRandomGen g) => g -> Either GenError (k, g)
buildKeyGen :: forall k g.
(BlockCipher k, CryptoRandomGen g) =>
g -> Either GenError (k, g)
buildKeyGen = StateT g (Either GenError) k -> g -> Either GenError (k, g)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((Int -> StateT g (Either GenError) ByteString)
-> (String -> StateT g (Either GenError) k)
-> StateT g (Either GenError) k
forall k (m :: * -> *).
(BlockCipher k, Monad m) =>
(Int -> m ByteString) -> (String -> m k) -> m k
buildKeyM ((g -> Either GenError (ByteString, g))
-> StateT g (Either GenError) ByteString
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((g -> Either GenError (ByteString, g))
 -> StateT g (Either GenError) ByteString)
-> (Int -> g -> Either GenError (ByteString, g))
-> Int
-> StateT g (Either GenError) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes) (Either GenError k -> StateT g (Either GenError) k
forall (m :: * -> *) a. Monad m => m a -> StateT g m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either GenError k -> StateT g (Either GenError) k)
-> (String -> Either GenError k)
-> String
-> StateT g (Either GenError) k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenError -> Either GenError k
forall a b. a -> Either a b
Left (GenError -> Either GenError k)
-> (String -> GenError) -> String -> Either GenError k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GenError
GenErrorOther))

buildKeyM :: (BlockCipher k, Monad m) => (Int -> m B.ByteString) -> (String -> m k) -> m k
buildKeyM :: forall k (m :: * -> *).
(BlockCipher k, Monad m) =>
(Int -> m ByteString) -> (String -> m k) -> m k
buildKeyM Int -> m ByteString
getMore String -> m k
err = Int -> m k
forall {t}. (Eq t, Num t) => t -> m k
go (Int
0::Int)
  where
  go :: t -> m k
go t
1000 = String -> m k
err String
"Tried 1000 times to generate a key from the system entropy.\
                \  No keys were returned! Perhaps the system entropy is broken\
                \ or perhaps the BlockCipher instance being used has a non-flat\
                \ keyspace."
  go t
i = do
    let bs :: Tagged k Int
bs = Tagged k Int
forall k. BlockCipher k => Tagged k Int
keyLength
    ByteString
kd <- Int -> m ByteString
getMore ((Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tagged k Int -> Int
forall {k} (s :: k) b. Tagged s b -> b
untag Tagged k Int
bs) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)
    case ByteString -> Maybe k
forall k. BlockCipher k => ByteString -> Maybe k
buildKey ByteString
kd of
        Maybe k
Nothing -> t -> m k
go (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1)
        Just k
k  -> k -> m k
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (k -> m k) -> k -> m k
forall a b. (a -> b) -> a -> b
$ k
k k -> Tagged k Int -> k
forall {k} s (tagged :: * -> k -> *) (b :: k). s -> tagged s b -> s
`asTaggedTypeOf` Tagged k Int
bs

-- |Asymetric ciphers (common ones being RSA or EC based)
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      :: (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 :: forall p v. AsymCipher p v => Int -> IO (Either GenError (p, v))
buildKeyPairIO Int
bl = do
        SystemRandom
g <- IO SystemRandom
forall g. CryptoRandomGen g => IO g
newGenIO :: IO SystemRandom
        case SystemRandom -> Int -> Either GenError ((p, v), SystemRandom)
forall g.
CryptoRandomGen g =>
g -> Int -> Either GenError ((p, v), g)
forall p v g.
(AsymCipher p v, CryptoRandomGen g) =>
g -> Int -> Either GenError ((p, v), g)
buildKeyPair SystemRandom
g Int
bl of
                Left GenError
err -> Either GenError (p, v) -> IO (Either GenError (p, v))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenError -> Either GenError (p, v)
forall a b. a -> Either a b
Left GenError
err)
                Right ((p, v)
k,SystemRandom
_) -> Either GenError (p, v) -> IO (Either GenError (p, v))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((p, v) -> Either GenError (p, v)
forall a b. b -> Either a b
Right (p, v)
k)

-- |Flipped 'buildKeyPair' for ease of use with state monads.
buildKeyPairGen :: (CryptoRandomGen g, AsymCipher p v) => BitLength -> g -> Either GenError ((p,v),g)
buildKeyPairGen :: forall g p v.
(CryptoRandomGen g, AsymCipher p v) =>
Int -> g -> Either GenError ((p, v), g)
buildKeyPairGen = (g -> Int -> Either GenError ((p, v), g))
-> Int -> g -> Either GenError ((p, v), g)
forall a b c. (a -> b -> c) -> b -> a -> c
flip g -> Int -> Either GenError ((p, v), g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either GenError ((p, v), g)
forall p v g.
(AsymCipher p v, CryptoRandomGen g) =>
g -> Int -> Either GenError ((p, v), g)
buildKeyPair

-- | A stream cipher class.  Instance are expected to work on messages as small as one byte
-- The length of the resulting cipher text should be equal
-- to the length of the input message.
class (Serialize k) => StreamCipher k iv | k -> iv where
  buildStreamKey        :: B.ByteString -> Maybe k
  encryptStream         :: k -> iv -> B.ByteString -> (B.ByteString, iv)
  decryptStream         :: k -> iv -> B.ByteString -> (B.ByteString, iv)
  streamKeyLength       :: Tagged k BitLength

-- |Build a stream key using the system random generator
buildStreamKeyIO :: StreamCipher k iv => IO k
buildStreamKeyIO :: forall k iv. StreamCipher k iv => IO k
buildStreamKeyIO = (Int -> IO ByteString) -> (String -> IO k) -> IO k
forall (m :: * -> *) k iv.
(Monad m, StreamCipher k iv) =>
(Int -> m ByteString) -> (String -> m k) -> m k
buildStreamKeyM Int -> IO ByteString
getEntropy String -> IO k
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

-- |Build a stream key using the provided random generator
buildStreamKeyGen :: (StreamCipher k iv, CryptoRandomGen g) => g -> Either GenError (k, g)
buildStreamKeyGen :: forall k iv g.
(StreamCipher k iv, CryptoRandomGen g) =>
g -> Either GenError (k, g)
buildStreamKeyGen = StateT g (Either GenError) k -> g -> Either GenError (k, g)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((Int -> StateT g (Either GenError) ByteString)
-> (String -> StateT g (Either GenError) k)
-> StateT g (Either GenError) k
forall (m :: * -> *) k iv.
(Monad m, StreamCipher k iv) =>
(Int -> m ByteString) -> (String -> m k) -> m k
buildStreamKeyM ((g -> Either GenError (ByteString, g))
-> StateT g (Either GenError) ByteString
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((g -> Either GenError (ByteString, g))
 -> StateT g (Either GenError) ByteString)
-> (Int -> g -> Either GenError (ByteString, g))
-> Int
-> StateT g (Either GenError) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes) (Either GenError k -> StateT g (Either GenError) k
forall (m :: * -> *) a. Monad m => m a -> StateT g m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either GenError k -> StateT g (Either GenError) k)
-> (String -> Either GenError k)
-> String
-> StateT g (Either GenError) k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenError -> Either GenError k
forall a b. a -> Either a b
Left (GenError -> Either GenError k)
-> (String -> GenError) -> String -> Either GenError k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GenError
GenErrorOther))

buildStreamKeyM :: (Monad m, StreamCipher k iv) => (Int -> m B.ByteString) -> (String -> m k) -> m k
buildStreamKeyM :: forall (m :: * -> *) k iv.
(Monad m, StreamCipher k iv) =>
(Int -> m ByteString) -> (String -> m k) -> m k
buildStreamKeyM Int -> m ByteString
getMore String -> m k
err = Int -> m k
forall {t}. (Num t, Eq t) => t -> m k
go (Int
0::Int)
  where
  go :: t -> m k
go t
1000 = String -> m k
err String
"Tried 1000 times to generate a stream key from the system entropy.\
                \  No keys were returned! Perhaps the system entropy is broken\
                \ or perhaps the BlockCipher instance being used has a non-flat\
                \ keyspace."
  go t
i = do
    let k :: Tagged k Int
k = Tagged k Int
forall k iv. StreamCipher k iv => Tagged k Int
streamKeyLength
    ByteString
kd <- Int -> m ByteString
getMore ((Tagged k Int -> Int
forall {k} (s :: k) b. Tagged s b -> b
untag Tagged k Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)
    case ByteString -> Maybe k
forall k iv. StreamCipher k iv => ByteString -> Maybe k
buildStreamKey ByteString
kd of
        Maybe k
Nothing -> t -> m k
go (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1)
        Just k
k' -> k -> m k
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (k -> m k) -> k -> m k
forall a b. (a -> b) -> a -> b
$ k
k' k -> Tagged k Int -> k
forall {k} s (tagged :: * -> k -> *) (b :: k). s -> tagged s b -> s
`asTaggedTypeOf` Tagged k Int
k

-- | A class for signing operations which inherently can not be as generic
-- as asymetric ciphers (ex: DSA).
class (Serialize p, Serialize v) => Signing p v | p -> v, v -> p  where
  sign   :: CryptoRandomGen g => g -> v -> L.ByteString -> Either GenError (B.ByteString, g)
  verify :: p -> L.ByteString -> B.ByteString -> Bool
  buildSigningPair :: CryptoRandomGen g => g -> BitLength -> Either GenError ((p, v), g)
  signingKeyLength :: v -> BitLength
  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 :: forall p v. Signing p v => Int -> IO (Either GenError (p, v))
buildSigningKeyPairIO Int
bl = do
        SystemRandom
g <- IO SystemRandom
forall g. CryptoRandomGen g => IO g
newGenIO :: IO SystemRandom
        case SystemRandom -> Int -> Either GenError ((p, v), SystemRandom)
forall g.
CryptoRandomGen g =>
g -> Int -> Either GenError ((p, v), g)
forall p v g.
(Signing p v, CryptoRandomGen g) =>
g -> Int -> Either GenError ((p, v), g)
buildSigningPair SystemRandom
g Int
bl of
                Left GenError
err -> Either GenError (p, v) -> IO (Either GenError (p, v))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either GenError (p, v) -> IO (Either GenError (p, v)))
-> Either GenError (p, v) -> IO (Either GenError (p, v))
forall a b. (a -> b) -> a -> b
$ GenError -> Either GenError (p, v)
forall a b. a -> Either a b
Left GenError
err
                Right ((p, v)
k,SystemRandom
_) -> Either GenError (p, v) -> IO (Either GenError (p, v))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either GenError (p, v) -> IO (Either GenError (p, v)))
-> Either GenError (p, v) -> IO (Either GenError (p, v))
forall a b. (a -> b) -> a -> b
$ (p, v) -> Either GenError (p, v)
forall a b. b -> Either a b
Right (p, v)
k

-- |Flipped 'buildSigningPair' for ease of use with state monads.
buildSigningKeyPairGen :: (Signing p v, CryptoRandomGen g) => BitLength -> g -> Either GenError ((p, v), g)
buildSigningKeyPairGen :: forall p v g.
(Signing p v, CryptoRandomGen g) =>
Int -> g -> Either GenError ((p, v), g)
buildSigningKeyPairGen = (g -> Int -> Either GenError ((p, v), g))
-> Int -> g -> Either GenError ((p, v), g)
forall a b c. (a -> b -> c) -> b -> a -> c
flip g -> Int -> Either GenError ((p, v), g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either GenError ((p, v), g)
forall p v g.
(Signing p v, CryptoRandomGen g) =>
g -> Int -> Either GenError ((p, v), g)
buildSigningPair

-- | Like `ecb` but for strict bytestrings
modeEcb' :: BlockCipher k => k -> B.ByteString -> B.ByteString
modeEcb' :: forall k. BlockCipher k => k -> ByteString -> ByteString
modeEcb' k
k ByteString
msg =
        let chunks :: [ByteString]
chunks = k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor' k
k ByteString
msg
        in [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k) [ByteString]
chunks
{-# INLINE modeEcb' #-}

-- |Decryption complement to `ecb'`
modeUnEcb' :: BlockCipher k => k -> B.ByteString -> B.ByteString
modeUnEcb' :: forall k. BlockCipher k => k -> ByteString -> ByteString
modeUnEcb' k
k ByteString
ct =
        let chunks :: [ByteString]
chunks = k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor' k
k ByteString
ct
        in [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
decryptBlock k
k) [ByteString]
chunks
{-# INLINE modeUnEcb' #-}

-- |Cipher block chaining encryption mode on strict bytestrings
modeCbc' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)
modeCbc' :: forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeCbc' k
k (IV ByteString
v) ByteString
plaintext =
        let blks :: [ByteString]
blks = k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor' k
k ByteString
plaintext
            ([ByteString]
cts, ByteString
iv) = [ByteString] -> ByteString -> ([ByteString], ByteString)
go [ByteString]
blks ByteString
v
        in ([ByteString] -> ByteString
B.concat [ByteString]
cts, ByteString -> IV k
forall k. ByteString -> IV k
IV ByteString
iv)
  where
  go :: [ByteString] -> ByteString -> ([ByteString], ByteString)
go [] ByteString
iv = ([], ByteString
iv)
  go (ByteString
b:[ByteString]
bs) ByteString
iv =
        let c :: ByteString
c = k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k (ByteString -> ByteString -> ByteString
zwp' ByteString
iv ByteString
b)
            ([ByteString]
cs, ByteString
ivFinal) = [ByteString] -> ByteString -> ([ByteString], ByteString)
go [ByteString]
bs ByteString
c
        in (ByteString
cByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
cs, ByteString
ivFinal)
{-# INLINEABLE modeCbc' #-}

-- |Cipher block chaining decryption for strict bytestrings
modeUnCbc' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)
modeUnCbc' :: forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCbc' k
k (IV ByteString
v) ByteString
ciphertext =
        let blks :: [ByteString]
blks = k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor' k
k ByteString
ciphertext
            ([ByteString]
pts, ByteString
iv) = [ByteString] -> ByteString -> ([ByteString], ByteString)
go [ByteString]
blks ByteString
v
        in ([ByteString] -> ByteString
B.concat [ByteString]
pts, ByteString -> IV k
forall k. ByteString -> IV k
IV ByteString
iv)
  where
  go :: [ByteString] -> ByteString -> ([ByteString], ByteString)
go [] ByteString
iv = ([], ByteString
iv)
  go (ByteString
c:[ByteString]
cs) ByteString
iv =
        let p :: ByteString
p = ByteString -> ByteString -> ByteString
zwp' (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
decryptBlock k
k ByteString
c) ByteString
iv
            ([ByteString]
ps, ByteString
ivFinal) = [ByteString] -> ByteString -> ([ByteString], ByteString)
go [ByteString]
cs ByteString
c
        in (ByteString
pByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
ps, ByteString
ivFinal)
{-# INLINEABLE modeUnCbc' #-}

-- |Output feedback mode for strict bytestrings
modeOfb' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)
modeOfb' :: forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeOfb' = k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnOfb'
{-# INLINEABLE modeOfb' #-}

-- |Output feedback mode for strict bytestrings
modeUnOfb' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)
modeUnOfb' :: forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnOfb' k
k (IV ByteString
iv) ByteString
msg =
        let ivStr :: [ByteString]
ivStr = Int -> [ByteString] -> [ByteString]
collect (ByteString -> Int
B.length ByteString
msg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ivLen) (Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
1 ((ByteString -> ByteString) -> ByteString -> [ByteString]
forall a. (a -> a) -> a -> [a]
iterate (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k) ByteString
iv))
            ivLen :: Int
ivLen = ByteString -> Int
B.length ByteString
iv
            mLen :: Int64
mLen = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
msg)
            newIV :: IV k
newIV = ByteString -> IV k
forall k. ByteString -> IV k
IV (ByteString -> IV k)
-> ([ByteString] -> ByteString) -> [ByteString] -> IV k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString])
-> ([ByteString] -> ByteString) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
L.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ivLen) (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
L.drop Int64
mLen (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
L.fromChunks ([ByteString] -> IV k) -> [ByteString] -> IV k
forall a b. (a -> b) -> a -> b
$ [ByteString]
ivStr
        in (ByteString -> ByteString -> ByteString
zwp' ([ByteString] -> ByteString
B.concat [ByteString]
ivStr) ByteString
msg, IV k
forall {k}. IV k
newIV)
{-# INLINEABLE modeUnOfb' #-}

-- |Counter mode for strict bytestrings
modeCtr' :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> B.ByteString -> (B.ByteString, IV k)
modeCtr' :: forall k.
BlockCipher k =>
(IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
modeCtr' = (IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
(IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCtr'
{-# INLINEABLE modeCtr' #-}

-- |Counter mode for strict bytestrings
modeUnCtr' :: BlockCipher k => (IV k -> IV k) -> k -> IV k -> B.ByteString -> (B.ByteString, IV k)
modeUnCtr' :: forall k.
BlockCipher k =>
(IV k -> IV k) -> k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCtr' IV k -> IV k
f k
k IV k
iv ByteString
msg =
       let fa :: (ByteString, IV k) -> Word8 -> ((ByteString, IV k), Word8)
fa (ByteString
st,IV ByteString
iv) Word8
c 
              | ByteString -> Bool
B.null ByteString
st = (ByteString, IV k) -> Word8 -> ((ByteString, IV k), Word8)
fa (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k ByteString
iv, IV k -> IV k
f (ByteString -> IV k
forall k. ByteString -> IV k
IV ByteString
iv)) Word8
c
              | Bool
otherwise = let Just (Word8
s,ByteString
nst) = ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
st in ((ByteString
nst,ByteString -> IV k
forall k. ByteString -> IV k
IV ByteString
iv),Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
c Word8
s)
           ((ByteString
_,IV k
newIV),ByteString
res) = ((ByteString, IV k) -> Word8 -> ((ByteString, IV k), Word8))
-> (ByteString, IV k)
-> ByteString
-> ((ByteString, IV k), ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
B.mapAccumL (ByteString, IV k) -> Word8 -> ((ByteString, IV k), Word8)
forall {k}.
(ByteString, IV k) -> Word8 -> ((ByteString, IV k), Word8)
fa (ByteString
B.empty,IV k
iv) ByteString
msg 
       in (ByteString
res,IV k
newIV)
{-# INLINEABLE modeUnCtr' #-}

-- |Ciphertext feed-back encryption mode for strict bytestrings (with
-- s == blockSize)
modeCfb' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)
modeCfb' :: forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeCfb' k
k (IV ByteString
v) ByteString
msg =
        let blks :: [ByteString]
blks = k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor' k
k ByteString
msg
            ([ByteString]
cs,ByteString
ivF) = ByteString -> [ByteString] -> ([ByteString], ByteString)
go ByteString
v [ByteString]
blks
        in ([ByteString] -> ByteString
B.concat [ByteString]
cs, ByteString -> IV k
forall k. ByteString -> IV k
IV ByteString
ivF)
  where
  go :: ByteString -> [ByteString] -> ([ByteString], ByteString)
go ByteString
iv [] = ([],ByteString
iv)
  go ByteString
iv (ByteString
b:[ByteString]
bs) =
        let c :: ByteString
c = ByteString -> ByteString -> ByteString
zwp' (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k ByteString
iv) ByteString
b
            ([ByteString]
cs,ByteString
ivFinal) = ByteString -> [ByteString] -> ([ByteString], ByteString)
go ByteString
c [ByteString]
bs
        in (ByteString
cByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
cs, ByteString
ivFinal)
{-# INLINEABLE modeCfb' #-}

-- |Ciphertext feed-back decryption mode for strict bytestrings (with s == blockSize)
modeUnCfb' :: BlockCipher k => k -> IV k -> B.ByteString -> (B.ByteString, IV k)
modeUnCfb' :: forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
modeUnCfb' k
k (IV ByteString
v) ByteString
msg =
        let blks :: [ByteString]
blks = k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor' k
k ByteString
msg
            ([ByteString]
ps, ByteString
ivF) = ByteString -> [ByteString] -> ([ByteString], ByteString)
go ByteString
v [ByteString]
blks
        in ([ByteString] -> ByteString
B.concat [ByteString]
ps, ByteString -> IV k
forall k. ByteString -> IV k
IV ByteString
ivF)
  where
  go :: ByteString -> [ByteString] -> ([ByteString], ByteString)
go ByteString
iv [] = ([], ByteString
iv)
  go ByteString
iv (ByteString
b:[ByteString]
bs) =
        let p :: ByteString
p = ByteString -> ByteString -> ByteString
zwp' (k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k ByteString
iv) ByteString
b
            ([ByteString]
ps, ByteString
ivF) = ByteString -> [ByteString] -> ([ByteString], ByteString)
go ByteString
b [ByteString]
bs
        in (ByteString
pByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
ps, ByteString
ivF)
{-# INLINEABLE modeUnCfb' #-}

toChunks :: Int -> B.ByteString -> [B.ByteString]
toChunks :: Int -> ByteString -> [ByteString]
toChunks Int
n ByteString
val = ByteString -> [ByteString]
go ByteString
val
  where
  go :: ByteString -> [ByteString]
go ByteString
b
    | ByteString -> Int
B.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = []
    | Bool
otherwise       = let (ByteString
h,ByteString
t) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n ByteString
b
                        in ByteString
h ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
go ByteString
t

-- |Increase an `IV` by one.  This is way faster than decoding,
-- increasing, encoding
incIV :: BlockCipher k => IV k -> IV k
incIV :: forall k. BlockCipher k => IV k -> IV k
incIV (IV ByteString
b) = ByteString -> IV k
forall k. ByteString -> IV k
IV (ByteString -> IV k) -> ByteString -> IV k
forall a b. (a -> b) -> a -> b
$ (Word16, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Word16, ByteString) -> ByteString)
-> (Word16, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word16 -> Word8 -> (Word16, Word8))
-> Word16 -> ByteString -> (Word16, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
B.mapAccumR (Word16 -> Word8 -> (Word16, Word8)
incw) Word16
1 ByteString
b
  where
       incw :: Word16 -> Word8 -> (Word16, Word8)
       incw :: Word16 -> Word8 -> (Word16, Word8)
incw Word16
i Word8
w = let nw :: Word16
nw=Word16
iWord16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+(Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) in (Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
nw Int
8, Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
nw)

-- |Obtain an `IV` made only of zeroes
zeroIV :: (BlockCipher k) => IV k
zeroIV :: forall k. BlockCipher k => IV k
zeroIV = IV k
iv
  where bytes :: Int
bytes = IV k -> Int
forall k. BlockCipher k => IV k -> Int
ivBlockSizeBytes IV k
iv
        iv :: IV k
iv  = ByteString -> IV k
forall k. ByteString -> IV k
IV (ByteString -> IV k) -> ByteString -> IV k
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
B.replicate  Int
bytes Word8
0

zeroIVcwc :: BlockCipher k => IV k
zeroIVcwc :: forall k. BlockCipher k => IV k
zeroIVcwc = IV k
iv
  where bytes :: Int
bytes = IV k -> Int
forall k. BlockCipher k => IV k -> Int
ivBlockSizeBytes IV k
iv Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5  -- a constant of cwc (4 bytes for ctr mode, 1 for a sort of header on the iv)
        iv :: IV k
iv    = ByteString -> IV k
forall k. ByteString -> IV k
IV (ByteString -> IV k) -> ByteString -> IV k
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
B.replicate Int
bytes Word8
0

-- Break a bytestring into block size chunks.
chunkFor :: (BlockCipher k) => k -> L.ByteString -> [B.ByteString]
chunkFor :: forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor k
k = ByteString -> [ByteString]
go
  where
  blkSz :: Int
blkSz = (Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSize Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
  blkSzI :: Int64
blkSzI = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
blkSz
  go :: ByteString -> [ByteString]
go ByteString
bs | ByteString -> Int64
L.length ByteString
bs Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
blkSzI = []
        | Bool
otherwise            = let (ByteString
blk,ByteString
rest) = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt Int64
blkSzI ByteString
bs in [ByteString] -> ByteString
B.concat (ByteString -> [ByteString]
L.toChunks ByteString
blk) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
go ByteString
rest
{-# INLINE chunkFor #-}

-- Break a bytestring into block size chunks.
chunkFor' :: (BlockCipher k) => k -> B.ByteString -> [B.ByteString]
chunkFor' :: forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor' k
k = ByteString -> [ByteString]
go
  where
  blkSz :: Int
blkSz = (Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSize Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
  go :: ByteString -> [ByteString]
go ByteString
bs | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
blkSz = []
        | Bool
otherwise           = let (ByteString
blk,ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
blkSz ByteString
bs in ByteString
blk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
go ByteString
rest
{-# INLINE chunkFor' #-}

-- |Create the mask for SIV based ciphers
sivMask :: B.ByteString -> B.ByteString
sivMask :: ByteString -> ByteString
sivMask ByteString
b = (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Int, ByteString) -> ByteString)
-> (Int, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int -> Word8 -> (Int, Word8))
-> Int -> ByteString -> (Int, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
B.mapAccumR (Int -> Word8 -> (Int, Word8)
go) Int
0 ByteString
b
  where
       go :: Int -> Word8 -> (Int,Word8)
       go :: Int -> Word8 -> (Int, Word8)
go Int
24 Word8
w = (Int
32,Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit Word8
w Int
7)
       go Int
56 Word8
w = (Int
64,Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit Word8
w Int
7)
       go Int
n Word8
w = (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8,Word8
w)

ivBlockSizeBytes :: BlockCipher k => IV k -> Int
ivBlockSizeBytes :: forall k. BlockCipher k => IV k -> Int
ivBlockSizeBytes IV k
iv =
        let p :: Proxy k
p = Proxy (IV k) -> Proxy k
forall k. Proxy (IV k) -> Proxy k
deIVProxy (IV k -> Proxy (IV k)
forall a. a -> Proxy a
proxyOf IV k
iv)
        in Tagged k Int -> Proxy k -> Int
forall {k} (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSize Proxy k
p Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
 where
  proxyOf :: a -> Proxy a
  proxyOf :: forall a. a -> Proxy a
proxyOf = Proxy a -> a -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall {k} (t :: k). Proxy t
Proxy
{-# INLINEABLE ivBlockSizeBytes #-}

instance (BlockCipher k) => Serialize (IV k) where
        get :: Get (IV k)
get = do
                let p :: Proxy t
p = Proxy t
forall {k} (t :: k). Proxy t
Proxy
                    doGet :: BlockCipher k => Proxy k -> Get (IV k)
                    doGet :: forall k. BlockCipher k => Proxy k -> Get (IV k)
doGet Proxy k
pr = (ByteString -> IV k) -> Get ByteString -> Get (IV k)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> IV k
forall k. ByteString -> IV k
IV (Int -> Get ByteString
SG.getByteString (Tagged k Int -> Proxy k -> Int
forall {k} (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Proxy k
pr))
                IV k
iv <- Proxy k -> Get (IV k)
forall k. BlockCipher k => Proxy k -> Get (IV k)
doGet Proxy k
forall {t}. Proxy t
p
                IV k -> Get (IV k)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (IV k
iv IV k -> Proxy (IV k) -> IV k
forall a (proxy :: * -> *). a -> proxy a -> a
`asProxyTypeOf` Proxy k -> Proxy (IV k)
forall k. Proxy k -> Proxy (IV k)
ivProxy Proxy k
forall {t}. Proxy t
p)
        put :: Putter (IV k)
put (IV ByteString
iv) = Putter ByteString
SP.putByteString ByteString
iv