-- |
-- Module      : Crypto.Cipher.Types.Block
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : Stable
-- Portability : Excellent
--
-- block cipher basic types
--
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ViewPatterns #-}
module Crypto.Cipher.Types.Block
    (
    -- * BlockCipher
      BlockCipher(..)
    -- * initialization vector (IV)
    , IV
    , makeIV
    , nullIV
    , ivAdd
    -- * XTS
    , XTS
    -- * AEAD
    , AEAD(..)
    , AEADState(..)
    , AEADModeImpl(..)
    -- * CFB 8 bits
    , cfb8Encrypt
    , cfb8Decrypt
    ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B (unsafeCreate)
import Data.Byteable
import Data.Word
import Data.Bits (shiftR, Bits)
import Crypto.Cipher.Types.Base
import Crypto.Cipher.Types.GF
import Crypto.Cipher.Types.Utils
import Foreign.Ptr
import Foreign.Storable

type XTS cipher = (cipher, cipher)
               -> IV cipher        -- ^ Usually represent the Data Unit (e.g. disk sector)
               -> DataUnitOffset   -- ^ Offset in the data unit in number of blocks
               -> ByteString       -- ^ Data
               -> ByteString       -- ^ Processed Data

-- | Symmetric block cipher class
class Cipher cipher => BlockCipher cipher where
    -- | Return the size of block required for this block cipher
    blockSize    :: cipher -> Int

    -- | Encrypt blocks
    --
    -- the input string need to be multiple of the block size
    ecbEncrypt :: cipher -> ByteString -> ByteString

    -- | Decrypt blocks
    --
    -- the input string need to be multiple of the block size
    ecbDecrypt :: cipher -> ByteString -> ByteString

    -- | encrypt using the CBC mode.
    --
    -- input need to be a multiple of the blocksize
    cbcEncrypt :: cipher -> IV cipher -> ByteString -> ByteString
    cbcEncrypt = cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cbcEncryptGeneric
    -- | decrypt using the CBC mode.
    --
    -- input need to be a multiple of the blocksize
    cbcDecrypt :: cipher -> IV cipher -> ByteString -> ByteString
    cbcDecrypt = cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cbcDecryptGeneric

    -- | encrypt using the CFB mode.
    --
    -- input need to be a multiple of the blocksize
    cfbEncrypt :: cipher -> IV cipher -> ByteString -> ByteString
    cfbEncrypt = cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfbEncryptGeneric
    -- | decrypt using the CFB mode.
    --
    -- input need to be a multiple of the blocksize
    cfbDecrypt :: cipher -> IV cipher -> ByteString -> ByteString
    cfbDecrypt = cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfbDecryptGeneric

    -- | combine using the CTR mode.
    --
    -- CTR mode produce a stream of randomized data that is combined
    -- (by XOR operation) with the input stream.
    --
    -- encryption and decryption are the same operation.
    --
    -- input can be of any size
    ctrCombine :: cipher -> IV cipher -> ByteString -> ByteString
    ctrCombine = cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
ctrCombineGeneric

    -- | encrypt using the XTS mode.
    --
    -- input need to be a multiple of the blocksize, and the cipher
    -- need to process 128 bits block only
    xtsEncrypt :: (cipher, cipher)
               -> IV cipher        -- ^ Usually represent the Data Unit (e.g. disk sector)
               -> DataUnitOffset   -- ^ Offset in the data unit in number of blocks
               -> ByteString       -- ^ Plaintext
               -> ByteString       -- ^ Ciphertext
    xtsEncrypt = (cipher, cipher)
-> IV cipher -> DataUnitOffset -> ByteString -> ByteString
forall cipher. BlockCipher cipher => XTS cipher
xtsEncryptGeneric

    -- | decrypt using the XTS mode.
    --
    -- input need to be a multiple of the blocksize, and the cipher
    -- need to process 128 bits block only
    xtsDecrypt :: (cipher, cipher)
               -> IV cipher        -- ^ Usually represent the Data Unit (e.g. disk sector)
               -> DataUnitOffset   -- ^ Offset in the data unit in number of blocks
               -> ByteString       -- ^ Ciphertext
               -> ByteString       -- ^ Plaintext
    xtsDecrypt = (cipher, cipher)
-> IV cipher -> DataUnitOffset -> ByteString -> ByteString
forall cipher. BlockCipher cipher => XTS cipher
xtsDecryptGeneric

    -- | Initialize a new AEAD State
    --
    -- When Nothing is returns, it means the mode is not handled.
    aeadInit :: Byteable iv => AEADMode -> cipher -> iv -> Maybe (AEAD cipher)
    aeadInit _ _ _ = Maybe (AEAD cipher)
forall a. Maybe a
Nothing

-- | Authenticated Encryption with Associated Data algorithms
data AEAD cipher = AEAD cipher (AEADState cipher)

-- | Wrapper for any AEADState
data AEADState cipher = forall st . AEADModeImpl cipher st => AEADState st

-- | Class of AEAD Mode implementation
class BlockCipher cipher => AEADModeImpl cipher state where
    aeadStateAppendHeader :: cipher -> state -> ByteString -> state
    aeadStateEncrypt      :: cipher -> state -> ByteString -> (ByteString, state)
    aeadStateDecrypt      :: cipher -> state -> ByteString -> (ByteString, state)
    aeadStateFinalize     :: cipher -> state -> Int -> AuthTag

-- | Create an IV for a specified block cipher
makeIV :: (Byteable b, BlockCipher c) => b -> Maybe (IV c)
makeIV :: b -> Maybe (IV c)
makeIV b :: b
b = c -> Maybe (IV c)
forall c. BlockCipher c => c -> Maybe (IV c)
toIV c
forall a. HasCallStack => a
undefined
  where toIV :: BlockCipher c => c -> Maybe (IV c)
        toIV :: c -> Maybe (IV c)
toIV cipher :: c
cipher
          | b -> Int
forall a. Byteable a => a -> Int
byteableLength b
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = IV c -> Maybe (IV c)
forall a. a -> Maybe a
Just (ByteString -> IV c
forall c. ByteString -> IV c
IV (ByteString -> IV c) -> ByteString -> IV c
forall a b. (a -> b) -> a -> b
$ b -> ByteString
forall a. Byteable a => a -> ByteString
toBytes b
b)
          | Bool
otherwise              = Maybe (IV c)
forall a. Maybe a
Nothing
          where sz :: Int
sz = c -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize c
cipher

-- | Create an IV that is effectively representing the number 0
nullIV :: BlockCipher c => IV c
nullIV :: IV c
nullIV = c -> IV c
forall c. BlockCipher c => c -> IV c
toIV c
forall a. HasCallStack => a
undefined
  where toIV :: BlockCipher c => c -> IV c
        toIV :: c -> IV c
toIV cipher :: c
cipher = ByteString -> IV c
forall c. ByteString -> IV c
IV (ByteString -> IV c) -> ByteString -> IV c
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
B.replicate (c -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize c
cipher) 0

-- | Increment an IV by a number.
--
-- Assume the IV is in Big Endian format.
ivAdd :: BlockCipher c => IV c -> Int -> IV c
ivAdd :: IV c -> Int -> IV c
ivAdd (IV b :: ByteString
b) i :: Int
i = ByteString -> IV c
forall c. ByteString -> IV c
IV (ByteString -> IV c) -> ByteString -> IV c
forall a b. (a -> b) -> a -> 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)
addCarry Int
i ByteString
b
  where addCarry :: Int -> Word8 -> (Int, Word8)
        addCarry :: Int -> Word8 -> (Int, Word8)
addCarry acc :: Int
acc w :: Word8
w
            | Int
acc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0  = (0, Word8
w)
            | Bool
otherwise = let (hi :: Int
hi,lo :: Int
lo) = Int
acc Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 256
                              nw :: Int
nw      = Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w)
                           in (Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
nw Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 8), Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nw)

cbcEncryptGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
cbcEncryptGeneric :: cipher -> IV cipher -> ByteString -> ByteString
cbcEncryptGeneric cipher :: cipher
cipher (IV ivini :: ByteString
ivini) input :: ByteString
input = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
doEnc ByteString
ivini ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
chunk (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
input
  where doEnc :: ByteString -> [ByteString] -> [ByteString]
doEnc _  []     = []
        doEnc iv :: ByteString
iv (i :: ByteString
i:is :: [ByteString]
is) =
            let o :: ByteString
o = cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt cipher
cipher (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
bxor ByteString
iv ByteString
i
             in ByteString
o ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
doEnc ByteString
o [ByteString]
is

cbcDecryptGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
cbcDecryptGeneric :: cipher -> IV cipher -> ByteString -> ByteString
cbcDecryptGeneric cipher :: cipher
cipher (IV ivini :: ByteString
ivini) input :: ByteString
input = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
doDec ByteString
ivini ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
chunk (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
input
  where doDec :: ByteString -> [ByteString] -> [ByteString]
doDec _  []     = []
        doDec iv :: ByteString
iv (i :: ByteString
i:is :: [ByteString]
is) =
            let o :: ByteString
o = ByteString -> ByteString -> ByteString
bxor ByteString
iv (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbDecrypt cipher
cipher ByteString
i
             in ByteString
o ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
doDec ByteString
i [ByteString]
is

cfbEncryptGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
cfbEncryptGeneric :: cipher -> IV cipher -> ByteString -> ByteString
cfbEncryptGeneric cipher :: cipher
cipher (IV ivini :: ByteString
ivini) input :: ByteString
input = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
doEnc ByteString
ivini ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
chunk (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
input
  where doEnc :: ByteString -> [ByteString] -> [ByteString]
doEnc _  []     = []
        doEnc iv :: ByteString
iv (i :: ByteString
i:is :: [ByteString]
is) =
            let o :: ByteString
o = ByteString -> ByteString -> ByteString
bxor ByteString
i (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt cipher
cipher ByteString
iv
             in ByteString
o ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
doEnc ByteString
o [ByteString]
is

cfbDecryptGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
cfbDecryptGeneric :: cipher -> IV cipher -> ByteString -> ByteString
cfbDecryptGeneric cipher :: cipher
cipher (IV ivini :: ByteString
ivini) input :: ByteString
input = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
doDec ByteString
ivini ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
chunk (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
input
  where doDec :: ByteString -> [ByteString] -> [ByteString]
doDec _  []     = []
        doDec iv :: ByteString
iv (i :: ByteString
i:is :: [ByteString]
is) =
            let o :: ByteString
o = ByteString -> ByteString -> ByteString
bxor ByteString
i (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt cipher
cipher ByteString
iv
             in ByteString
o ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
doDec ByteString
i [ByteString]
is

ctrCombineGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString
ctrCombineGeneric :: cipher -> IV cipher -> ByteString -> ByteString
ctrCombineGeneric cipher :: cipher
cipher ivini :: IV cipher
ivini input :: ByteString
input = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ IV cipher -> [ByteString] -> [ByteString]
forall c. BlockCipher c => IV c -> [ByteString] -> [ByteString]
doCnt IV cipher
ivini ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
chunk (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
input
  where doCnt :: IV c -> [ByteString] -> [ByteString]
doCnt _  [] = []
        doCnt iv :: IV c
iv (i :: ByteString
i:is :: [ByteString]
is) =
            let ivEnc :: ByteString
ivEnc = cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt cipher
cipher (IV c -> ByteString
forall a. Byteable a => a -> ByteString
toBytes IV c
iv)
             in ByteString -> ByteString -> ByteString
bxor ByteString
i ByteString
ivEnc ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: IV c -> [ByteString] -> [ByteString]
doCnt (IV c -> Int -> IV c
forall c. BlockCipher c => IV c -> Int -> IV c
ivAdd IV c
iv 1) [ByteString]
is

xtsEncryptGeneric :: BlockCipher cipher => XTS cipher
xtsEncryptGeneric :: XTS cipher
xtsEncryptGeneric = (cipher -> ByteString -> ByteString) -> XTS cipher
forall cipher.
BlockCipher cipher =>
(cipher -> ByteString -> ByteString)
-> (cipher, cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
xtsGeneric cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt

xtsDecryptGeneric :: BlockCipher cipher => XTS cipher
xtsDecryptGeneric :: XTS cipher
xtsDecryptGeneric = (cipher -> ByteString -> ByteString) -> XTS cipher
forall cipher.
BlockCipher cipher =>
(cipher -> ByteString -> ByteString)
-> (cipher, cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
xtsGeneric cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbDecrypt

xtsGeneric :: BlockCipher cipher
           => (cipher -> B.ByteString -> B.ByteString)
           -> (cipher, cipher)
           -> IV cipher
           -> DataUnitOffset
           -> ByteString
           -> ByteString
xtsGeneric :: (cipher -> ByteString -> ByteString)
-> (cipher, cipher)
-> IV cipher
-> DataUnitOffset
-> ByteString
-> ByteString
xtsGeneric f :: cipher -> ByteString -> ByteString
f (cipher :: cipher
cipher, tweakCipher :: cipher
tweakCipher) iv :: IV cipher
iv sPoint :: DataUnitOffset
sPoint input :: ByteString
input
    | cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 16 = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error "XTS mode is only available with cipher that have a block size of 128 bits"
    | Bool
otherwise = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
doXts ByteString
iniTweak ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
chunk (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
input
  where encTweak :: ByteString
encTweak = cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt cipher
tweakCipher (IV cipher -> ByteString
forall a. Byteable a => a -> ByteString
toBytes IV cipher
iv)
        iniTweak :: ByteString
iniTweak = (ByteString -> ByteString) -> ByteString -> [ByteString]
forall a. (a -> a) -> a -> [a]
iterate ByteString -> ByteString
xtsGFMul ByteString
encTweak [ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!! DataUnitOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral DataUnitOffset
sPoint
        doXts :: ByteString -> [ByteString] -> [ByteString]
doXts _     []     = []
        doXts tweak :: ByteString
tweak (i :: ByteString
i:is :: [ByteString]
is) =
            let o :: ByteString
o = ByteString -> ByteString -> ByteString
bxor (cipher -> ByteString -> ByteString
f cipher
cipher (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
bxor ByteString
i ByteString
tweak) ByteString
tweak
             in ByteString
o ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
doXts (ByteString -> ByteString
xtsGFMul ByteString
tweak) [ByteString]
is

-- | Encrypt using CFB mode in 8 bit output
--
-- Effectively turn a Block cipher in CFB mode into a Stream cipher
cfb8Encrypt :: BlockCipher a => a -> IV a -> B.ByteString -> B.ByteString
cfb8Encrypt :: a -> IV a -> ByteString -> ByteString
cfb8Encrypt ctx :: a
ctx origIv :: IV a
origIv msg :: ByteString
msg = Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate (ByteString -> Int
B.length ByteString
msg) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \dst :: Ptr Word8
dst -> Ptr Word8 -> IV a -> ByteString -> IO ()
loop Ptr Word8
dst IV a
origIv ByteString
msg
  where loop :: Ptr Word8 -> IV a -> ByteString -> IO ()
loop d :: Ptr Word8
d iv :: IV a
iv@(IV i :: ByteString
i) m :: ByteString
m
            | ByteString -> Bool
B.null ByteString
m  = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bool
otherwise = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
d Word8
out IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> IV a -> ByteString -> IO ()
loop (Ptr Word8
d Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) IV a
forall c. IV c
ni (Int -> ByteString -> ByteString
B.drop 1 ByteString
m)
          where m' :: ByteString
m'  = if ByteString -> Int
B.length ByteString
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
ctx
                            then ByteString
m ByteString -> ByteString -> ByteString
`B.append` Int -> Word8 -> ByteString
B.replicate (a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
ctx Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
m) 0
                            else Int -> ByteString -> ByteString
B.take (a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
ctx) ByteString
m
                r :: ByteString
r   = a -> IV a -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfbEncrypt a
ctx IV a
iv ByteString
m'
                out :: Word8
out = ByteString -> Word8
B.head ByteString
r
                ni :: IV c
ni  = ByteString -> IV c
forall c. ByteString -> IV c
IV (Int -> ByteString -> ByteString
B.drop 1 ByteString
i ByteString -> Word8 -> ByteString
`B.snoc` Word8
out)

-- | Decrypt using CFB mode in 8 bit output
--
-- Effectively turn a Block cipher in CFB mode into a Stream cipher
cfb8Decrypt :: BlockCipher a => a -> IV a -> B.ByteString -> B.ByteString
cfb8Decrypt :: a -> IV a -> ByteString -> ByteString
cfb8Decrypt ctx :: a
ctx origIv :: IV a
origIv msg :: ByteString
msg = Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate (ByteString -> Int
B.length ByteString
msg) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \dst :: Ptr Word8
dst -> Ptr Word8 -> IV a -> ByteString -> IO ()
loop Ptr Word8
dst IV a
origIv ByteString
msg
  where loop :: Ptr Word8 -> IV a -> ByteString -> IO ()
loop d :: Ptr Word8
d iv :: IV a
iv@(IV i :: ByteString
i) m :: ByteString
m
            | ByteString -> Bool
B.null ByteString
m  = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bool
otherwise = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
d Word8
out IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> IV a -> ByteString -> IO ()
loop (Ptr Word8
d Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) IV a
forall c. IV c
ni (Int -> ByteString -> ByteString
B.drop 1 ByteString
m)
          where m' :: ByteString
m'  = if ByteString -> Int
B.length ByteString
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
ctx
                            then ByteString
m ByteString -> ByteString -> ByteString
`B.append` Int -> Word8 -> ByteString
B.replicate (a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
ctx Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
m) 0
                            else Int -> ByteString -> ByteString
B.take (a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
ctx) ByteString
m
                r :: ByteString
r   = a -> IV a -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfbDecrypt a
ctx IV a
iv ByteString
m'
                out :: Word8
out = ByteString -> Word8
B.head ByteString
r
                ni :: IV c
ni  = ByteString -> IV c
forall c. ByteString -> IV c
IV (Int -> ByteString -> ByteString
B.drop 1 ByteString
i ByteString -> Word8 -> ByteString
`B.snoc` ByteString -> Word8
B.head ByteString
m')