{-# 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 (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 -> ByteLength -> ([ByteString], ByteString)
makeBlocks ByteString
msg ByteLength
blockLen
    blockLen :: ByteLength
blockLen = (Tagged d ByteLength
forall ctx d. Hash ctx d => Tagged d ByteLength
blockLength Tagged d ByteLength -> d -> ByteLength
forall a b. Tagged a b -> a -> b
.::. d
res) ByteLength -> ByteLength -> ByteLength
forall a. Integral a => a -> a -> a
`div` ByteLength
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) = ByteLength -> ByteString -> (ByteString, ByteString)
B.splitAt ByteLength
remlen ByteString
msg
    remlen :: ByteLength
remlen = ByteString -> ByteLength
B.length ByteString
msg ByteLength -> ByteLength -> ByteLength
forall a. Num a => a -> a -> a
- (ByteString -> ByteLength
B.length ByteString
msg ByteLength -> ByteLength -> ByteLength
forall a. Integral a => a -> a -> a
`rem` ByteLength
bLen)
    bLen :: ByteLength
bLen = Tagged d ByteLength
forall ctx d. Hash ctx d => Tagged d ByteLength
blockLength Tagged d ByteLength -> d -> ByteLength
forall a b. Tagged a b -> a -> b
`for` d
res ByteLength -> ByteLength -> ByteLength
forall a. Integral a => a -> a -> a
`div` ByteLength
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 :: 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' :: 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 -> ByteLength -> ([ByteString], ByteString)
makeBlocks ByteString
msg ByteLength
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 -> ByteLength
B.length ByteString
x ByteLength -> ByteLength -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteLength
len =
        let l :: ByteLength
l = ByteString -> ByteLength
B.length ByteString
x ByteLength -> ByteLength -> ByteLength
forall a. Num a => a -> a -> a
- ByteString -> ByteLength
B.length ByteString
x ByteLength -> ByteLength -> ByteLength
forall a. Integral a => a -> a -> a
`rem` ByteLength
len
            (ByteString
top,ByteString
end) = ByteLength -> ByteString -> (ByteString, ByteString)
B.splitAt ByteLength
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 :: 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 :: k -> IV k -> ByteString -> (ByteString, IV k)
modeUnOfb k
k (IV ByteString
iv) ByteString
msg =
        let ivStr :: [ByteString]
ivStr = ByteLength -> [ByteString] -> [ByteString]
forall a. ByteLength -> [a] -> [a]
drop ByteLength
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 = ByteLength -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> ByteLength
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 :: 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 :: 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 :: g -> Either GenError (IV k, g)
getIV g
g =
        let bytes :: ByteLength
bytes = IV k -> ByteLength
forall k. BlockCipher k => IV k -> ByteLength
ivBlockSizeBytes IV k
iv
            gen :: Either GenError (ByteString, g)
gen = ByteLength -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
ByteLength -> g -> Either GenError (ByteString, g)
genBytes ByteLength
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 -> ByteLength
B.length ByteString
bs ByteLength -> ByteLength -> Bool
forall a. Eq a => a -> a -> Bool
== ByteLength
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 :: 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 :: 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 (ByteLength -> IO ByteString
getEntropy (Tagged k ByteLength -> Proxy k -> ByteLength
forall k (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
blockSize Proxy k
pr ByteLength -> ByteLength -> ByteLength
forall a. Integral a => a -> a -> a
`div` ByteLength
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 (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 :: 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 :: 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 :: 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 :: 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 :: k -> k -> [ByteString] -> ByteString -> Maybe ByteString
modeSiv k
k1 k
k2 [ByteString]
xs ByteString
m
    | [ByteString] -> ByteLength
forall (t :: * -> *) a. Foldable t => t a -> ByteLength
length [ByteString]
xs ByteLength -> ByteLength -> Bool
forall a. Ord a => a -> a -> Bool
> ByteLength
bSizeb ByteLength -> ByteLength -> ByteLength
forall a. Num a => a -> a -> a
- ByteLength
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 = ByteLength -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteLength -> Integer) -> ByteLength -> Integer
forall a b. (a -> b) -> a -> b
$ Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
blockSizeBytes Tagged k ByteLength -> k -> ByteLength
forall a b. Tagged a b -> a -> b
`for` k
k1
       bSizeb :: ByteLength
bSizeb = ByteLength -> ByteLength
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteLength -> ByteLength) -> ByteLength -> ByteLength
forall a b. (a -> b) -> a -> b
$ Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
blockSize Tagged k ByteLength -> k -> ByteLength
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 :: k -> k -> [ByteString] -> ByteString -> Maybe ByteString
modeUnSiv k
k1 k
k2 [ByteString]
xs ByteString
c | [ByteString] -> ByteLength
forall (t :: * -> *) a. Foldable t => t a -> ByteLength
length [ByteString]
xs ByteLength -> ByteLength -> Bool
forall a. Ord a => a -> a -> Bool
> ByteLength
bSizeb ByteLength -> ByteLength -> ByteLength
forall a. Num a => a -> a -> a
- ByteLength
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 = ByteLength -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteLength -> Integer) -> ByteLength -> Integer
forall a b. (a -> b) -> a -> b
$ Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
blockSizeBytes Tagged k ByteLength -> k -> ByteLength
forall a b. Tagged a b -> a -> b
`for` k
k1
       bSizeb :: ByteLength
bSizeb = ByteLength -> ByteLength
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteLength -> ByteLength) -> ByteLength -> ByteLength
forall a b. (a -> b) -> a -> b
$ Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
blockSize Tagged k ByteLength -> k -> ByteLength
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' :: k -> k -> [ByteString] -> ByteString -> Maybe ByteString
modeSiv' k
k1 k
k2 [ByteString]
xs ByteString
m | [ByteString] -> ByteLength
forall (t :: * -> *) a. Foldable t => t a -> ByteLength
length [ByteString]
xs ByteLength -> ByteLength -> Bool
forall a. Ord a => a -> a -> Bool
> ByteLength
bSizeb ByteLength -> ByteLength -> ByteLength
forall a. Num a => a -> a -> a
- ByteLength
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 = ByteLength -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteLength -> Integer) -> ByteLength -> Integer
forall a b. (a -> b) -> a -> b
$ Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
blockSizeBytes Tagged k ByteLength -> k -> ByteLength
forall a b. Tagged a b -> a -> b
`for` k
k1
       bSizeb :: ByteLength
bSizeb = ByteLength -> ByteLength
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteLength -> ByteLength) -> ByteLength -> ByteLength
forall a b. (a -> b) -> a -> b
$ Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
blockSize Tagged k ByteLength -> k -> ByteLength
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' :: k -> k -> [ByteString] -> ByteString -> Maybe ByteString
modeUnSiv' k
k1 k
k2 [ByteString]
xs ByteString
c | [ByteString] -> ByteLength
forall (t :: * -> *) a. Foldable t => t a -> ByteLength
length [ByteString]
xs ByteLength -> ByteLength -> Bool
forall a. Ord a => a -> a -> Bool
> ByteLength
bSizeb ByteLength -> ByteLength -> ByteLength
forall a. Num a => a -> a -> a
- ByteLength
1 = Maybe ByteString
forall a. Maybe a
Nothing
                  | ByteString -> ByteLength
B.length ByteString
c ByteLength -> ByteLength -> Bool
forall a. Ord a => a -> a -> Bool
< ByteLength
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 :: ByteLength
bSize = ByteLength -> ByteLength
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteLength -> ByteLength) -> ByteLength -> ByteLength
forall a b. (a -> b) -> a -> b
$ Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
blockSizeBytes Tagged k ByteLength -> k -> ByteLength
forall a b. Tagged a b -> a -> b
`for` k
k1
       bSizeb :: ByteLength
bSizeb = ByteLength -> ByteLength
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteLength -> ByteLength) -> ByteLength -> ByteLength
forall a b. (a -> b) -> a -> b
$ Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
blockSize Tagged k ByteLength -> k -> ByteLength
forall a b. Tagged a b -> a -> b
`for` k
k1
       (ByteString
iv,ByteString
m) = ByteLength -> ByteString -> (ByteString, ByteString)
B.splitAt ByteLength
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 :: 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 :: 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 :: (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 :: (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 = ByteLength -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteLength -> Int64) -> ByteLength -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteLength
B.length ByteString
iv
           newIV :: IV k
newIV = [IV k] -> IV k
forall a. [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 :: Tagged k ByteLength
blockSizeBytes = (ByteLength -> ByteLength)
-> Tagged k ByteLength -> Tagged k ByteLength
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteLength -> ByteLength -> ByteLength
forall a. Integral a => a -> a -> a
`div` ByteLength
8) Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
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 :: Tagged k ByteLength
keyLengthBytes = (ByteLength -> ByteLength)
-> Tagged k ByteLength -> Tagged k ByteLength
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteLength -> ByteLength -> ByteLength
forall a. Integral a => a -> a -> a
`div` ByteLength
8) Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
keyLength

-- |Build a symmetric key using the system entropy (see 'System.Entropy')
buildKeyIO :: (BlockCipher k) => IO k
buildKeyIO :: IO k
buildKeyIO = (ByteLength -> IO ByteString) -> (String -> IO k) -> IO k
forall k (m :: * -> *).
(BlockCipher k, Monad m) =>
(ByteLength -> m ByteString) -> (String -> m k) -> m k
buildKeyM ByteLength -> IO ByteString
getEntropy String -> IO k
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 :: 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 ((ByteLength -> StateT g (Either GenError) ByteString)
-> (String -> StateT g (Either GenError) k)
-> StateT g (Either GenError) k
forall k (m :: * -> *).
(BlockCipher k, Monad m) =>
(ByteLength -> 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)
-> (ByteLength -> g -> Either GenError (ByteString, g))
-> ByteLength
-> StateT g (Either GenError) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteLength -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
ByteLength -> g -> Either GenError (ByteString, g)
genBytes) (Either GenError k -> StateT g (Either GenError) k
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 :: (ByteLength -> m ByteString) -> (String -> m k) -> m k
buildKeyM ByteLength -> m ByteString
getMore String -> m k
err = ByteLength -> m k
forall t. (Eq t, Num t) => t -> m k
go (ByteLength
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 ByteLength
bs = Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
keyLength
    ByteString
kd <- ByteLength -> m ByteString
getMore ((ByteLength
7 ByteLength -> ByteLength -> ByteLength
forall a. Num a => a -> a -> a
+ Tagged k ByteLength -> ByteLength
forall k (s :: k) b. Tagged s b -> b
untag Tagged k ByteLength
bs) ByteLength -> ByteLength -> ByteLength
forall a. Integral a => a -> a -> a
`div` ByteLength
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 (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 ByteLength -> k
forall k s (tagged :: * -> k -> *) (b :: k). s -> tagged s b -> s
`asTaggedTypeOf` Tagged k ByteLength
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 :: ByteLength -> IO (Either GenError (p, v))
buildKeyPairIO ByteLength
bl = do
        SystemRandom
g <- IO SystemRandom
forall g. CryptoRandomGen g => IO g
newGenIO :: IO SystemRandom
        case SystemRandom
-> ByteLength -> Either GenError ((p, v), SystemRandom)
forall p v g.
(AsymCipher p v, CryptoRandomGen g) =>
g -> ByteLength -> Either GenError ((p, v), g)
buildKeyPair SystemRandom
g ByteLength
bl of
                Left GenError
err -> Either GenError (p, v) -> IO (Either GenError (p, v))
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 (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 :: ByteLength -> g -> Either GenError ((p, v), g)
buildKeyPairGen = (g -> ByteLength -> Either GenError ((p, v), g))
-> ByteLength -> g -> Either GenError ((p, v), g)
forall a b c. (a -> b -> c) -> b -> a -> c
flip g -> ByteLength -> Either GenError ((p, v), g)
forall p v g.
(AsymCipher p v, CryptoRandomGen g) =>
g -> ByteLength -> 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 :: IO k
buildStreamKeyIO = (ByteLength -> IO ByteString) -> (String -> IO k) -> IO k
forall (m :: * -> *) k iv.
(Monad m, StreamCipher k iv) =>
(ByteLength -> m ByteString) -> (String -> m k) -> m k
buildStreamKeyM ByteLength -> IO ByteString
getEntropy String -> IO k
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 :: 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 ((ByteLength -> 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) =>
(ByteLength -> 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)
-> (ByteLength -> g -> Either GenError (ByteString, g))
-> ByteLength
-> StateT g (Either GenError) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteLength -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
ByteLength -> g -> Either GenError (ByteString, g)
genBytes) (Either GenError k -> StateT g (Either GenError) k
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 :: (ByteLength -> m ByteString) -> (String -> m k) -> m k
buildStreamKeyM ByteLength -> m ByteString
getMore String -> m k
err = ByteLength -> m k
forall t iv iv.
(Eq t, Num t, StreamCipher k iv, StreamCipher k iv) =>
t -> m k
go (ByteLength
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 ByteLength
k = Tagged k ByteLength
forall k iv. StreamCipher k iv => Tagged k ByteLength
streamKeyLength
    ByteString
kd <- ByteLength -> m ByteString
getMore ((Tagged k ByteLength -> ByteLength
forall k (s :: k) b. Tagged s b -> b
untag Tagged k ByteLength
k ByteLength -> ByteLength -> ByteLength
forall a. Num a => a -> a -> a
+ ByteLength
7) ByteLength -> ByteLength -> ByteLength
forall a. Integral a => a -> a -> a
`div` ByteLength
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 (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 ByteLength -> k
forall k s (tagged :: * -> k -> *) (b :: k). s -> tagged s b -> s
`asTaggedTypeOf` Tagged k ByteLength
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 :: ByteLength -> IO (Either GenError (p, v))
buildSigningKeyPairIO ByteLength
bl = do
        SystemRandom
g <- IO SystemRandom
forall g. CryptoRandomGen g => IO g
newGenIO :: IO SystemRandom
        case SystemRandom
-> ByteLength -> Either GenError ((p, v), SystemRandom)
forall p v g.
(Signing p v, CryptoRandomGen g) =>
g -> ByteLength -> Either GenError ((p, v), g)
buildSigningPair SystemRandom
g ByteLength
bl of
                Left GenError
err -> Either GenError (p, v) -> IO (Either GenError (p, v))
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 (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 :: ByteLength -> g -> Either GenError ((p, v), g)
buildSigningKeyPairGen = (g -> ByteLength -> Either GenError ((p, v), g))
-> ByteLength -> g -> Either GenError ((p, v), g)
forall a b c. (a -> b -> c) -> b -> a -> c
flip g -> ByteLength -> Either GenError ((p, v), g)
forall p v g.
(Signing p v, CryptoRandomGen g) =>
g -> ByteLength -> Either GenError ((p, v), g)
buildSigningPair

-- | Like `ecb` but for strict bytestrings
modeEcb' :: BlockCipher k => k -> B.ByteString -> B.ByteString
modeEcb' :: 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' :: 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' :: 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' :: 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' :: 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' :: k -> IV k -> ByteString -> (ByteString, IV k)
modeUnOfb' k
k (IV ByteString
iv) ByteString
msg =
        let ivStr :: [ByteString]
ivStr = ByteLength -> [ByteString] -> [ByteString]
collect (ByteString -> ByteLength
B.length ByteString
msg ByteLength -> ByteLength -> ByteLength
forall a. Num a => a -> a -> a
+ ByteLength
ivLen) (ByteLength -> [ByteString] -> [ByteString]
forall a. ByteLength -> [a] -> [a]
drop ByteLength
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 :: ByteLength
ivLen = ByteString -> ByteLength
B.length ByteString
iv
            mLen :: Int64
mLen = ByteLength -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> ByteLength
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 (ByteLength -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteLength
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' :: (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' :: (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' :: 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' :: 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 :: ByteLength -> ByteString -> [ByteString]
toChunks ByteLength
n ByteString
val = ByteString -> [ByteString]
go ByteString
val
  where
  go :: ByteString -> [ByteString]
go ByteString
b
    | ByteString -> ByteLength
B.length ByteString
b ByteLength -> ByteLength -> Bool
forall a. Eq a => a -> a -> Bool
== ByteLength
0 = []
    | Bool
otherwise       = let (ByteString
h,ByteString
t) = ByteLength -> ByteString -> (ByteString, ByteString)
B.splitAt ByteLength
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 :: 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 -> ByteLength -> Word16
forall a. Bits a => a -> ByteLength -> a
shiftR Word16
nw ByteLength
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 :: IV k
zeroIV = IV k
iv
  where bytes :: ByteLength
bytes = IV k -> ByteLength
forall k. BlockCipher k => IV k -> ByteLength
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
$ ByteLength -> Word8 -> ByteString
B.replicate  ByteLength
bytes Word8
0

zeroIVcwc :: BlockCipher k => IV k
zeroIVcwc :: IV k
zeroIVcwc = IV k
iv
  where bytes :: ByteLength
bytes = IV k -> ByteLength
forall k. BlockCipher k => IV k -> ByteLength
ivBlockSizeBytes IV k
iv ByteLength -> ByteLength -> ByteLength
forall a. Num a => a -> a -> a
- ByteLength
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
$ ByteLength -> Word8 -> ByteString
B.replicate ByteLength
bytes Word8
0

-- Break a bytestring into block size chunks.
chunkFor :: (BlockCipher k) => k -> L.ByteString -> [B.ByteString]
chunkFor :: k -> ByteString -> [ByteString]
chunkFor k
k = ByteString -> [ByteString]
go
  where
  blkSz :: ByteLength
blkSz = (Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
blockSize Tagged k ByteLength -> k -> ByteLength
forall a b. Tagged a b -> a -> b
`for` k
k) ByteLength -> ByteLength -> ByteLength
forall a. Integral a => a -> a -> a
`div` ByteLength
8
  blkSzI :: Int64
blkSzI = ByteLength -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteLength
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' :: k -> ByteString -> [ByteString]
chunkFor' k
k = ByteString -> [ByteString]
go
  where
  blkSz :: ByteLength
blkSz = (Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
blockSize Tagged k ByteLength -> k -> ByteLength
forall a b. Tagged a b -> a -> b
`for` k
k) ByteLength -> ByteLength -> ByteLength
forall a. Integral a => a -> a -> a
`div` ByteLength
8
  go :: ByteString -> [ByteString]
go ByteString
bs | ByteString -> ByteLength
B.length ByteString
bs ByteLength -> ByteLength -> Bool
forall a. Ord a => a -> a -> Bool
< ByteLength
blkSz = []
        | Bool
otherwise           = let (ByteString
blk,ByteString
rest) = ByteLength -> ByteString -> (ByteString, ByteString)
B.splitAt ByteLength
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 = (ByteLength, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteLength, ByteString) -> ByteString)
-> (ByteLength, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteLength -> Word8 -> (ByteLength, Word8))
-> ByteLength -> ByteString -> (ByteLength, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
B.mapAccumR (ByteLength -> Word8 -> (ByteLength, Word8)
go) ByteLength
0 ByteString
b
  where
       go :: Int -> Word8 -> (Int,Word8)
       go :: ByteLength -> Word8 -> (ByteLength, Word8)
go ByteLength
24 Word8
w = (ByteLength
32,Word8 -> ByteLength -> Word8
forall a. Bits a => a -> ByteLength -> a
clearBit Word8
w ByteLength
7)
       go ByteLength
56 Word8
w = (ByteLength
64,Word8 -> ByteLength -> Word8
forall a. Bits a => a -> ByteLength -> a
clearBit Word8
w ByteLength
7)
       go ByteLength
n Word8
w = (ByteLength
nByteLength -> ByteLength -> ByteLength
forall a. Num a => a -> a -> a
+ByteLength
8,Word8
w)

ivBlockSizeBytes :: BlockCipher k => IV k -> Int
ivBlockSizeBytes :: IV k -> ByteLength
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 ByteLength -> Proxy k -> ByteLength
forall k (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
blockSize Proxy k
p ByteLength -> ByteLength -> ByteLength
forall a. Integral a => a -> a -> a
`div` ByteLength
8
 where
  proxyOf :: a -> Proxy a
  proxyOf :: 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 :: 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 (ByteLength -> Get ByteString
SG.getByteString (Tagged k ByteLength -> Proxy k -> ByteLength
forall k (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged k ByteLength
forall k. BlockCipher k => Tagged k ByteLength
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 (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