-- |
-- 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 #-}
{-# LANGUAGE Rank2Types #-}
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
    --, cfb8Encrypt
    --, cfb8Decrypt
    ) where

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

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

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 = forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray byteArray
z Ptr p -> IO a
f
    length :: IV c -> Int
length (IV byteArray
z) = 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) = 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 = 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 = 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 = 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 = 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 = 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
_ = 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 = 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 = 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 = forall c. BlockCipher c => c -> Maybe (IV c)
toIV 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
          | forall ba. ByteArrayAccess ba => ba -> Int
B.length b
b forall a. Eq a => a -> a -> Bool
== Int
sz = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert b
b :: Bytes)
          | Bool
otherwise        = forall a. Maybe a
Nothing
          where sz :: Int
sz = 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 = forall c. BlockCipher c => c -> IV c
toIV forall a. HasCallStack => a
undefined
  where toIV :: BlockCipher c => c -> IV c
        toIV :: forall c. BlockCipher c => c -> IV c
toIV c
cipher = forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV (forall ba. ByteArray ba => Int -> ba
B.zero (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 = forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV forall a b. (a -> b) -> a -> b
$ 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 = forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze bs
bs forall a b. (a -> b) -> a -> b
$ Int -> Int -> Ptr Word8 -> IO ()
loop Int
i (forall ba. ByteArrayAccess ba => ba -> Int
B.length bs
bs 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 forall a. Ord a => a -> a -> Bool
< Int
0   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bool
otherwise = do
                Word8
v <- forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ofs) :: IO Word8
                let accv :: Int
accv    = Int
acc forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v
                    (Int
hi,Int
lo) = Int
accv forall a. Integral a => a -> a -> (a, a)
`divMod` Int
256
                forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ofs) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lo :: Word8)
                Int -> Int -> Ptr Word8 -> IO ()
loop Int
hi (Int
ofs 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 = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall {byteArray} {c} {a}.
(ByteArray byteArray, BlockCipher c, ByteArrayAccess a) =>
IV c -> [a] -> [byteArray]
doEnc IV cipher
ivini forall a b. (a -> b) -> a -> b
$ forall b. ByteArray b => Int -> b -> [b]
chunk (forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ba
input
  where doEnc :: IV c -> [a] -> [byteArray]
doEnc IV c
_  []     = []
        doEnc IV c
iv (a
i:[a]
is) =
            let o :: byteArray
o = forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt cipher
cipher forall a b. (a -> b) -> a -> b
$ forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.xor IV c
iv a
i
             in byteArray
o forall a. a -> [a] -> [a]
: IV c -> [a] -> [byteArray]
doEnc (forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV byteArray
o) [a]
is

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 = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall {byteArray} {a} {c}.
(ByteArray a, ByteArray byteArray, BlockCipher c) =>
IV c -> [byteArray] -> [a]
doDec IV cipher
ivini forall a b. (a -> b) -> a -> b
$ forall b. ByteArray b => Int -> b -> [b]
chunk (forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ba
input
  where
        doDec :: IV c -> [byteArray] -> [a]
doDec IV c
_  []     = []
        doDec IV c
iv (byteArray
i:[byteArray]
is) =
            let o :: a
o = forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.xor IV c
iv forall a b. (a -> b) -> a -> b
$ forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbDecrypt cipher
cipher byteArray
i
             in a
o forall a. a -> [a] -> [a]
: IV c -> [byteArray] -> [a]
doDec (forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV byteArray
i) [byteArray]
is

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 = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall {a} {a} {c}.
(ByteArray a, ByteArrayAccess a) =>
IV c -> [a] -> [a]
doEnc IV cipher
ivini forall a b. (a -> b) -> a -> b
$ forall b. ByteArray b => Int -> b -> [b]
chunk (forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ba
input
  where
        doEnc :: IV c -> [a] -> [a]
doEnc IV c
_  []     = []
        doEnc (IV byteArray
iv) (a
i:[a]
is) =
            let o :: a
o = forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.xor a
i forall a b. (a -> b) -> a -> b
$ forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt cipher
cipher byteArray
iv
             in a
o forall a. a -> [a] -> [a]
: IV c -> [a] -> [a]
doEnc (forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV a
o) [a]
is

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 = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall {a} {a} {c}.
(ByteArray a, ByteArray a) =>
IV c -> [a] -> [a]
doDec IV cipher
ivini forall a b. (a -> b) -> a -> b
$ forall b. ByteArray b => Int -> b -> [b]
chunk (forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ba
input
  where
        doDec :: IV c -> [a] -> [a]
doDec IV c
_  []     = []
        doDec (IV byteArray
iv) (a
i:[a]
is) =
            let o :: a
o = forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.xor a
i forall a b. (a -> b) -> a -> b
$ forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt cipher
cipher byteArray
iv
             in a
o forall a. a -> [a] -> [a]
: IV c -> [a] -> [a]
doDec (forall c byteArray. ByteArray byteArray => byteArray -> IV c
IV a
i) [a]
is

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 = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall {a} {a} {c}.
(ByteArray a, ByteArrayAccess a) =>
IV c -> [a] -> [a]
doCnt IV cipher
ivini forall a b. (a -> b) -> a -> b
$ forall b. ByteArray b => Int -> b -> [b]
chunk (forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ba
input
  where doCnt :: IV c -> [a] -> [a]
doCnt IV c
_  [] = []
        doCnt iv :: IV c
iv@(IV byteArray
ivd) (a
i:[a]
is) =
            let ivEnc :: byteArray
ivEnc = forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt cipher
cipher byteArray
ivd
             in forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.xor a
i byteArray
ivEnc forall a. a -> [a] -> [a]
: IV c -> [a] -> [a]
doCnt (forall c. IV c -> Int -> IV c
ivAdd IV c
iv Int
1) [a]
is

xtsEncryptGeneric :: (ByteArray ba, BlockCipher128 cipher) => XTS ba cipher
xtsEncryptGeneric :: forall ba cipher.
(ByteArray ba, BlockCipher128 cipher) =>
XTS ba cipher
xtsEncryptGeneric = forall ba cipher.
(ByteArray ba, BlockCipher128 cipher) =>
(cipher -> ba -> ba)
-> (cipher, cipher) -> IV cipher -> DataUnitOffset -> ba -> ba
xtsGeneric 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 = forall ba cipher.
(ByteArray ba, BlockCipher128 cipher) =>
(cipher -> ba -> ba)
-> (cipher, cipher) -> IV cipher -> DataUnitOffset -> ba -> ba
xtsGeneric 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 =
    forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall {t} {a} {a}.
(ByteArray t, ByteArray a, ByteArrayAccess a) =>
t -> [a] -> [a]
doXts byteArray
iniTweak forall a b. (a -> b) -> a -> b
$ forall b. ByteArray b => Int -> b -> [b]
chunk (forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ba
input
  where encTweak :: byteArray
encTweak = forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt cipher
tweakCipher byteArray
iv
        iniTweak :: byteArray
iniTweak = forall a. (a -> a) -> a -> [a]
iterate forall bs. ByteArray bs => bs -> bs
xtsGFMul byteArray
encTweak forall a. [a] -> Int -> a
!! forall a b. (Integral a, Num b) => a -> b
fromIntegral DataUnitOffset
sPoint
        doXts :: t -> [a] -> [a]
doXts t
_     []     = []
        doXts t
tweak (a
i:[a]
is) =
            let o :: a
o = forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.xor (cipher -> ba -> ba
f cipher
cipher forall a b. (a -> b) -> a -> b
$ forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.xor a
i t
tweak) t
tweak
             in a
o forall a. a -> [a] -> [a]
: t -> [a] -> [a]
doXts (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')
-}