{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      : Crypto.Cipher.Types.Block
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : Stable
-- Portability : Excellent
--
-- Block cipher basic types
module Crypto.Cipher.Types.Block (
    -- * BlockCipher
    BlockCipher (..),
    BlockCipher128 (..),

    -- * Initialization vector (IV)
    IV (..),
    makeIV,
    nullIV,
    ivAdd,

    -- * XTS
    XTS,

    -- * AEAD
    AEAD (..),
    -- , AEADState(..)
    AEADModeImpl (..),
    aeadAppendHeader,
    aeadEncrypt,
    aeadDecrypt,
    aeadFinalize,

    -- * CFB 8 bits
) where

-- , cfb8Encrypt
-- , cfb8Decrypt

import Crypto.Cipher.Types.AEAD
import Crypto.Cipher.Types.Base
import Crypto.Cipher.Types.GF
import Crypto.Error
import Data.Word

import Crypto.Internal.ByteArray (
    ByteArray,
    ByteArrayAccess,
    Bytes,
    withByteArray,
 )
import qualified Crypto.Internal.ByteArray as B
import Data.ByteString (ByteString)
import qualified Data.ByteString as S

import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr
import Foreign.Storable

-- | an IV parametrized by the cipher
data IV c = forall byteArray. ByteArray byteArray => IV !byteArray

instance BlockCipher c => ByteArrayAccess (IV c) where
    withByteArray :: forall p a. IV c -> (Ptr p -> IO a) -> IO a
withByteArray (IV byteArray
z) Ptr p -> IO a
f = byteArray -> (Ptr p -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. byteArray -> (Ptr p -> IO a) -> IO a
withByteArray byteArray
z Ptr p -> IO a
f
    length :: IV c -> Int
length (IV byteArray
z) = byteArray -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length byteArray
z
instance Eq (IV c) where
    (IV byteArray
a) == :: IV c -> IV c -> Bool
== (IV byteArray
b) = byteArray -> byteArray -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
B.eq byteArray
a byteArray
b

-- | XTS callback
type XTS ba cipher =
    (cipher, cipher)
    -> IV cipher
    -- ^ Usually represent the Data Unit (e.g. disk sector)
    -> DataUnitOffset
    -- ^ Offset in the data unit in number of blocks
    -> ba
    -- ^ Data
    -> ba
    -- ^ 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 :: ByteArray ba => cipher -> ba -> ba

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

    -- | encrypt using the CBC mode.
    --
    -- input need to be a multiple of the blocksize
    cbcEncrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba
    cbcEncrypt = cipher -> IV cipher -> ba -> ba
forall ba cipher.
(ByteArray ba, BlockCipher cipher) =>
cipher -> IV cipher -> ba -> ba
cbcEncryptGeneric

    -- | decrypt using the CBC mode.
    --
    -- input need to be a multiple of the blocksize
    cbcDecrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba
    cbcDecrypt = cipher -> IV cipher -> ba -> ba
forall ba cipher.
(ByteArray ba, BlockCipher cipher) =>
cipher -> IV cipher -> ba -> ba
cbcDecryptGeneric

    -- | encrypt using the CFB mode.
    --
    -- input need to be a multiple of the blocksize
    cfbEncrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba
    cfbEncrypt = cipher -> IV cipher -> ba -> ba
forall ba cipher.
(ByteArray ba, BlockCipher cipher) =>
cipher -> IV cipher -> ba -> ba
cfbEncryptGeneric

    -- | decrypt using the CFB mode.
    --
    -- input need to be a multiple of the blocksize
    cfbDecrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba
    cfbDecrypt = cipher -> IV cipher -> ba -> ba
forall ba cipher.
(ByteArray ba, BlockCipher cipher) =>
cipher -> IV cipher -> ba -> ba
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 :: ByteArray ba => cipher -> IV cipher -> ba -> ba
    ctrCombine = cipher -> IV cipher -> ba -> ba
forall ba cipher.
(ByteArray ba, BlockCipher cipher) =>
cipher -> IV cipher -> ba -> ba
ctrCombineGeneric

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

-- | class of block cipher with a 128 bits block size
class BlockCipher cipher => BlockCipher128 cipher where
    -- | 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
        :: ByteArray ba
        => (cipher, cipher)
        -> IV cipher
        -- ^ Usually represent the Data Unit (e.g. disk sector)
        -> DataUnitOffset
        -- ^ Offset in the data unit in number of blocks
        -> ba
        -- ^ Plaintext
        -> ba
        -- ^ Ciphertext
    xtsEncrypt = XTS ba cipher
forall ba cipher.
(ByteArray ba, BlockCipher128 cipher) =>
XTS ba 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
        :: ByteArray ba
        => (cipher, cipher)
        -> IV cipher
        -- ^ Usually represent the Data Unit (e.g. disk sector)
        -> DataUnitOffset
        -- ^ Offset in the data unit in number of blocks
        -> ba
        -- ^ Ciphertext
        -> ba
        -- ^ Plaintext
    xtsDecrypt = XTS ba cipher
forall ba cipher.
(ByteArray ba, BlockCipher128 cipher) =>
XTS ba cipher
xtsDecryptGeneric

-- | Create an IV for a specified block cipher
makeIV :: (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV :: forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV 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 :: forall c. BlockCipher c => c -> Maybe (IV c)
toIV c
cipher
        | b -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length 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 (IV c -> Maybe (IV c)) -> IV c -> Maybe (IV c)
forall a b. (a -> b) -> a -> b
$ Bytes -> IV c
forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV (b -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert b
b :: Bytes)
        | 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 :: forall c. BlockCipher c => 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 :: forall c. BlockCipher c => c -> IV c
toIV c
cipher = Bytes -> IV c
forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV (Int -> Bytes
forall ba. ByteArray ba => Int -> ba
B.zero (c -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize c
cipher) :: Bytes)

-- | Increment an IV by a number.
--
-- Assume the IV is in Big Endian format.
ivAdd :: IV c -> Int -> IV c
ivAdd :: forall c. IV c -> Int -> IV c
ivAdd (IV byteArray
b) Int
i = byteArray -> IV c
forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV (byteArray -> IV c) -> byteArray -> IV c
forall a b. (a -> b) -> a -> b
$ byteArray -> byteArray
forall bs. ByteArray bs => bs -> bs
copy byteArray
b
  where
    copy :: ByteArray bs => bs -> bs
    copy :: forall bs. ByteArray bs => bs -> bs
copy bs
bs = bs -> (Ptr Word8 -> IO ()) -> bs
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze bs
bs ((Ptr Word8 -> IO ()) -> bs) -> (Ptr Word8 -> IO ()) -> bs
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Ptr Word8 -> IO ()
loop Int
i (bs -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bs
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

    loop :: Int -> Int -> Ptr Word8 -> IO ()
    loop :: Int -> Int -> Ptr Word8 -> IO ()
loop Int
acc Int
ofs Ptr Word8
p
        | Int
ofs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
            Word8
v <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ofs) :: IO Word8
            let accv :: Int
accv = Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v
                (Int
hi, Int
lo) = Int
accv Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
256
            Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ofs) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lo :: Word8)
            Int -> Int -> Ptr Word8 -> IO ()
loop Int
hi (Int
ofs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Ptr Word8
p

cbcEncryptGeneric
    :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
cbcEncryptGeneric :: forall ba cipher.
(ByteArray ba, BlockCipher cipher) =>
cipher -> IV cipher -> ba -> ba
cbcEncryptGeneric cipher
cipher IV cipher
ivini ba
input =
    [ba] -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat ([ba] -> ba) -> [ba] -> ba
forall a b. (a -> b) -> a -> b
$ IV cipher -> [ByteString] -> [ba]
forall {c} {a}.
(BlockCipher c, ByteArrayAccess a) =>
IV c -> [a] -> [ba]
doEnc IV cipher
ivini ([ByteString] -> [ba]) -> [ByteString] -> [ba]
forall a b. (a -> b) -> a -> b
$ Int -> ba -> [ByteString]
forall ba. ByteArray ba => Int -> ba -> [ByteString]
slices (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ba
input
  where
    -- the blocks of the message as shared slices rather than copies: each
    -- block already costs an exclusive or and a call into the cipher, both of
    -- which allocate, and the chain makes it one block at a time
    doEnc :: IV c -> [a] -> [ba]
doEnc IV c
_ [] = []
    doEnc IV c
iv (a
i : [a]
is) =
        let o :: ba
o = cipher -> ba -> ba
forall ba. ByteArray ba => cipher -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt cipher
cipher (IV c -> a -> ba
forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.bxor IV c
iv a
i) ba -> ba -> ba
forall a. a -> a -> a
`asTypeOf` ba
input
         in ba
o ba -> [ba] -> [ba]
forall a. a -> [a] -> [a]
: IV c -> [a] -> [ba]
doEnc (ba -> IV c
forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV ba
o) [a]
is

-- | How many blocks to hand the cipher at a time in the modes whose blocks do
-- not depend on one another.  Enough that the cost of a call disappears, few
-- enough that what it copies stays in cache.
blocksPerCall :: Int
blocksPerCall :: Int
blocksPerCall = Int
2048

-- | The input in slices of that many blocks.  A ByteString shares where
-- 'B.splitAt' copies the rest of the message, once per slice.
slices :: ByteArray ba => Int -> ba -> [ByteString]
slices :: forall ba. ByteArray ba => Int -> ba -> [ByteString]
slices Int
bytes ba
input = ByteString -> [ByteString]
go (ba -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
input)
  where
    go :: ByteString -> [ByteString]
go ByteString
bs
        | ByteString -> Bool
S.null ByteString
bs = []
        | Bool
otherwise = let (ByteString
hd, ByteString
tl) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
bytes ByteString
bs in ByteString
hd ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
go ByteString
tl

-- | The previous ciphertext block of every block in a slice: the incoming IV,
-- and then the slice itself one block short.
shiftedBy :: BlockCipher cipher => Int -> IV cipher -> ByteString -> ByteString
shiftedBy :: forall cipher.
BlockCipher cipher =>
Int -> IV cipher -> ByteString -> ByteString
shiftedBy Int
bsz IV cipher
iv ByteString
c = ByteString -> ByteString -> ByteString
S.append (IV cipher -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert IV cipher
iv) (Int -> ByteString -> ByteString
S.take (ByteString -> Int
S.length ByteString
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bsz) ByteString
c)

-- | The last whole block of a slice, which is where the next one carries on
-- from.
lastBlockOf :: Int -> ByteString -> IV cipher
lastBlockOf :: forall cipher. Int -> ByteString -> IV cipher
lastBlockOf Int
bsz ByteString
c = Bytes -> IV cipher
forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV (ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Int -> ByteString -> ByteString
S.drop (ByteString -> Int
S.length ByteString
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bsz) ByteString
c) :: Bytes)

-- | Decryption does not chain: @P_i@ is @D(C_i)@ exclusive-ored with
-- @C_(i-1)@, so a whole slice is decrypted in one call and exclusive-ored with
-- the ciphertext moved along by a block.
cbcDecryptGeneric
    :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
cbcDecryptGeneric :: forall ba cipher.
(ByteArray ba, BlockCipher cipher) =>
cipher -> IV cipher -> ba -> ba
cbcDecryptGeneric cipher
cipher IV cipher
ivini ba
input =
    [ba] -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat ([ba] -> ba) -> [ba] -> ba
forall a b. (a -> b) -> a -> b
$ IV cipher -> [ByteString] -> [ba]
forall {cipher}.
BlockCipher cipher =>
IV cipher -> [ByteString] -> [ba]
doDec IV cipher
ivini ([ByteString] -> [ba]) -> [ByteString] -> [ba]
forall a b. (a -> b) -> a -> b
$ Int -> ba -> [ByteString]
forall ba. ByteArray ba => Int -> ba -> [ByteString]
slices (Int
blocksPerCall Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bsz) ba
input
  where
    bsz :: Int
bsz = cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher
    conv :: bin -> ba
conv bin
x = bin -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert bin
x ba -> ba -> ba
forall a. a -> a -> a
`asTypeOf` ba
input
    xorB :: a -> b -> ba
xorB a
a b
b = a -> b -> ba
forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.bxor a
a b
b ba -> ba -> ba
forall a. a -> a -> a
`asTypeOf` ba
input
    doDec :: IV cipher -> [ByteString] -> [ba]
doDec IV cipher
_ [] = []
    doDec IV cipher
iv (ByteString
c : [ByteString]
cs) =
        ba -> ba -> ba
forall {a} {b}.
(ByteArrayAccess a, ByteArrayAccess b) =>
a -> b -> ba
xorB (cipher -> ba -> ba
forall ba. ByteArray ba => cipher -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbDecrypt cipher
cipher (ByteString -> ba
forall {bin}. ByteArrayAccess bin => bin -> ba
conv ByteString
c)) (ByteString -> ba
forall {bin}. ByteArrayAccess bin => bin -> ba
conv (Int -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
Int -> IV cipher -> ByteString -> ByteString
shiftedBy Int
bsz IV cipher
iv ByteString
c))
            ba -> [ba] -> [ba]
forall a. a -> [a] -> [a]
: IV cipher -> [ByteString] -> [ba]
doDec (Int -> ByteString -> IV cipher
forall cipher. Int -> ByteString -> IV cipher
lastBlockOf Int
bsz ByteString
c) [ByteString]
cs

cfbEncryptGeneric
    :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
cfbEncryptGeneric :: forall ba cipher.
(ByteArray ba, BlockCipher cipher) =>
cipher -> IV cipher -> ba -> ba
cfbEncryptGeneric cipher
cipher IV cipher
ivini ba
input =
    [ba] -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat ([ba] -> ba) -> [ba] -> ba
forall a b. (a -> b) -> a -> b
$ IV cipher -> [ByteString] -> [ba]
forall {a} {c}. ByteArrayAccess a => IV c -> [a] -> [ba]
doEnc IV cipher
ivini ([ByteString] -> [ba]) -> [ByteString] -> [ba]
forall a b. (a -> b) -> a -> b
$ Int -> ba -> [ByteString]
forall ba. ByteArray ba => Int -> ba -> [ByteString]
slices (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ba
input
  where
    doEnc :: IV c -> [a] -> [ba]
doEnc IV c
_ [] = []
    doEnc (IV byteArray
iv) (a
i : [a]
is) =
        let o :: ba
o = a -> byteArray -> ba
forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.bxor a
i (cipher -> byteArray -> byteArray
forall ba. ByteArray ba => cipher -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt cipher
cipher byteArray
iv) ba -> ba -> ba
forall a. a -> a -> a
`asTypeOf` ba
input
         in ba
o ba -> [ba] -> [ba]
forall a. a -> [a] -> [a]
: IV c -> [a] -> [ba]
doEnc (ba -> IV c
forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV ba
o) [a]
is

-- | Nor does this one: @P_i@ is @C_i@ exclusive-ored with @E(C_(i-1))@, and
-- what gets encrypted is again the ciphertext moved along by a block.
cfbDecryptGeneric
    :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
cfbDecryptGeneric :: forall ba cipher.
(ByteArray ba, BlockCipher cipher) =>
cipher -> IV cipher -> ba -> ba
cfbDecryptGeneric cipher
cipher IV cipher
ivini ba
input =
    [ba] -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat ([ba] -> ba) -> [ba] -> ba
forall a b. (a -> b) -> a -> b
$ IV cipher -> [ByteString] -> [ba]
forall {cipher}.
BlockCipher cipher =>
IV cipher -> [ByteString] -> [ba]
doDec IV cipher
ivini ([ByteString] -> [ba]) -> [ByteString] -> [ba]
forall a b. (a -> b) -> a -> b
$ Int -> ba -> [ByteString]
forall ba. ByteArray ba => Int -> ba -> [ByteString]
slices (Int
blocksPerCall Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bsz) ba
input
  where
    bsz :: Int
bsz = cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher
    conv :: bin -> ba
conv bin
x = bin -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert bin
x ba -> ba -> ba
forall a. a -> a -> a
`asTypeOf` ba
input
    xorB :: a -> b -> ba
xorB a
a b
b = a -> b -> ba
forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.bxor a
a b
b ba -> ba -> ba
forall a. a -> a -> a
`asTypeOf` ba
input
    doDec :: IV cipher -> [ByteString] -> [ba]
doDec IV cipher
_ [] = []
    doDec IV cipher
iv (ByteString
c : [ByteString]
cs) =
        ba -> ba -> ba
forall {a} {b}.
(ByteArrayAccess a, ByteArrayAccess b) =>
a -> b -> ba
xorB (ByteString -> ba
forall {bin}. ByteArrayAccess bin => bin -> ba
conv ByteString
c) (cipher -> ba -> ba
forall ba. ByteArray ba => cipher -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt cipher
cipher (ByteString -> ba
forall {bin}. ByteArrayAccess bin => bin -> ba
conv (Int -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
Int -> IV cipher -> ByteString -> ByteString
shiftedBy Int
bsz IV cipher
iv ByteString
c)))
            ba -> [ba] -> [ba]
forall a. a -> [a] -> [a]
: IV cipher -> [ByteString] -> [ba]
doDec (Int -> ByteString -> IV cipher
forall cipher. Int -> ByteString -> IV cipher
lastBlockOf Int
bsz ByteString
c) [ByteString]
cs

-- | The counters do not depend on the message at all, so a slice of them is
-- built and encrypted in one call.
ctrCombineGeneric
    :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
ctrCombineGeneric :: forall ba cipher.
(ByteArray ba, BlockCipher cipher) =>
cipher -> IV cipher -> ba -> ba
ctrCombineGeneric cipher
cipher IV cipher
ivini ba
input =
    [ba] -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat ([ba] -> ba) -> [ba] -> ba
forall a b. (a -> b) -> a -> b
$ IV cipher -> [ByteString] -> [ba]
forall {c}. BlockCipher c => IV c -> [ByteString] -> [ba]
doCnt IV cipher
ivini ([ByteString] -> [ba]) -> [ByteString] -> [ba]
forall a b. (a -> b) -> a -> b
$ Int -> ba -> [ByteString]
forall ba. ByteArray ba => Int -> ba -> [ByteString]
slices (Int
blocksPerCall Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bsz) ba
input
  where
    bsz :: Int
bsz = cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher
    conv :: bin -> ba
conv bin
x = bin -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert bin
x ba -> ba -> ba
forall a. a -> a -> a
`asTypeOf` ba
input
    xorB :: a -> b -> ba
xorB a
a b
b = a -> b -> ba
forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.bxor a
a b
b ba -> ba -> ba
forall a. a -> a -> a
`asTypeOf` ba
input
    doCnt :: IV c -> [ByteString] -> [ba]
doCnt IV c
_ [] = []
    doCnt IV c
iv (ByteString
m : [ByteString]
ms) =
        ba -> ba -> ba
forall {a} {b}.
(ByteArrayAccess a, ByteArrayAccess b) =>
a -> b -> ba
xorB (ByteString -> ba
forall {bin}. ByteArrayAccess bin => bin -> ba
conv ByteString
m) (cipher -> ba -> ba
forall ba. ByteArray ba => cipher -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt cipher
cipher (IV c -> Int -> ba
forall ba cipher.
(ByteArray ba, BlockCipher cipher) =>
IV cipher -> Int -> ba
counters IV c
iv Int
n ba -> ba -> ba
forall a. a -> a -> a
`asTypeOf` ba
input))
            ba -> [ba] -> [ba]
forall a. a -> [a] -> [a]
: IV c -> [ByteString] -> [ba]
doCnt (IV c -> Int -> IV c
forall c. IV c -> Int -> IV c
ivAdd IV c
iv Int
n) [ByteString]
ms
      where
        n :: Int
n = (ByteString -> Int
S.length ByteString
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bsz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
bsz

-- | The counters for a slice: the given one, then each next as the one before
-- it plus one.
--
-- One buffer, filled in place.  Asking 'ivAdd' for each of them separately
-- allocated a block per block and walked the whole width of the counter from
-- the original every time, which cost more than the cipher did: counter mode
-- ran at a quarter of what the same cipher managed in ECB, and at an eighth
-- for Blowfish.
counters :: (ByteArray ba, BlockCipher cipher) => IV cipher -> Int -> ba
counters :: forall ba cipher.
(ByteArray ba, BlockCipher cipher) =>
IV cipher -> Int -> ba
counters IV cipher
iv Int
n = Int -> (Ptr Any -> IO ()) -> ba
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bsz) Ptr Any -> IO ()
forall {b}. Ptr b -> IO ()
fill
  where
    bsz :: Int
bsz = IV cipher -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length IV cipher
iv

    fill :: Ptr b -> IO ()
fill Ptr b
p = do
        IV cipher -> Ptr b -> IO ()
forall ba p. ByteArrayAccess ba => ba -> Ptr p -> IO ()
forall p. IV cipher -> Ptr p -> IO ()
B.copyByteArrayToPtr IV cipher
iv Ptr b
p
        let go :: Int -> Ptr b -> IO ()
go Int
k Ptr b
prev
                | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                | Bool
otherwise = do
                    let this :: Ptr b
this = Ptr b
prev Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bsz
                    Ptr b -> Ptr b -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr b
forall {b}. Ptr b
this Ptr b
prev Int
bsz
                    Ptr Any -> Int -> IO ()
forall {a}. Ptr a -> Int -> IO ()
increment Ptr Any
forall {b}. Ptr b
this (Int
bsz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                    Int -> Ptr b -> IO ()
go (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ptr b
forall {b}. Ptr b
this
        Int -> Ptr b -> IO ()
forall {b}. Int -> Ptr b -> IO ()
go Int
1 Ptr b
p

    increment :: Ptr a -> Int -> IO ()
increment Ptr a
p Int
ofs
        | Int
ofs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
            Word8
v <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr a
p Ptr a -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ofs) :: IO Word8
            Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr a
p Ptr a -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ofs) (Word8
v Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1)
            if Word8
v Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff then Ptr a -> Int -> IO ()
increment Ptr a
p (Int
ofs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) else () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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

xtsGeneric
    :: (ByteArray ba, BlockCipher128 cipher)
    => (cipher -> ba -> ba)
    -> (cipher, cipher)
    -> IV cipher
    -> DataUnitOffset
    -> ba
    -> ba
xtsGeneric :: forall ba cipher.
(ByteArray ba, BlockCipher128 cipher) =>
(cipher -> ba -> ba)
-> (cipher, cipher) -> IV cipher -> DataUnitOffset -> ba -> ba
xtsGeneric cipher -> ba -> ba
f (cipher
cipher, cipher
tweakCipher) (IV byteArray
iv) DataUnitOffset
sPoint ba
input =
    [ba] -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat ([ba] -> ba) -> [ba] -> ba
forall a b. (a -> b) -> a -> b
$ byteArray -> [ByteString] -> [ba]
forall {t} {a}.
(ByteArray t, ByteArrayAccess a) =>
t -> [a] -> [ba]
doXts byteArray
iniTweak ([ByteString] -> [ba]) -> [ByteString] -> [ba]
forall a b. (a -> b) -> a -> b
$ Int -> ba -> [ByteString]
forall ba. ByteArray ba => Int -> ba -> [ByteString]
slices (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ba
input
  where
    encTweak :: byteArray
encTweak = cipher -> byteArray -> byteArray
forall ba. ByteArray ba => cipher -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt cipher
tweakCipher byteArray
iv
    iniTweak :: byteArray
iniTweak = (byteArray -> byteArray) -> byteArray -> [byteArray]
forall a. (a -> a) -> a -> [a]
iterate byteArray -> byteArray
forall bs. ByteArray bs => bs -> bs
xtsGFMul byteArray
encTweak [byteArray] -> Int -> byteArray
forall a. HasCallStack => [a] -> Int -> a
!! DataUnitOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral DataUnitOffset
sPoint
    doXts :: t -> [a] -> [ba]
doXts t
_ [] = []
    doXts t
tweak (a
i : [a]
is) =
        let o :: ba
o = ba -> t -> ba
forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.bxor (cipher -> ba -> ba
f cipher
cipher (a -> t -> ba
forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.bxor a
i t
tweak)) t
tweak ba -> ba -> ba
forall a. a -> a -> a
`asTypeOf` ba
input
         in ba
o ba -> [ba] -> [ba]
forall a. a -> [a] -> [a]
: t -> [a] -> [ba]
doXts (t -> t
forall bs. ByteArray bs => bs -> bs
xtsGFMul t
tweak) [a]
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 ctx origIv msg = B.unsafeCreate (B.length msg) $ \dst -> loop dst origIv msg
  where loop d iv@(IV i) m
            | B.null m  = return ()
            | otherwise = poke d out >> loop (d `plusPtr` 1) ni (B.drop 1 m)
          where m'  = if B.length m < blockSize ctx
                            then m `B.append` B.replicate (blockSize ctx - B.length m) 0
                            else B.take (blockSize ctx) m
                r   = cfbEncrypt ctx iv m'
                out = B.head r
                ni  = IV (B.drop 1 i `B.snoc` 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 ctx origIv msg = B.unsafeCreate (B.length msg) $ \dst -> loop dst origIv msg
  where loop d iv@(IV i) m
            | B.null m  = return ()
            | otherwise = poke d out >> loop (d `plusPtr` 1) ni (B.drop 1 m)
          where m'  = if B.length m < blockSize ctx
                            then m `B.append` B.replicate (blockSize ctx - B.length m) 0
                            else B.take (blockSize ctx) m
                r   = cfbDecrypt ctx iv m'
                out = B.head r
                ni  = IV (B.drop 1 i `B.snoc` B.head m')
-}