{-|
Module      : Z.Crypto.Cipher
Description : Block Cipher and Cipher modes
Copyright   : Dong Han, 2021
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provides raw block cipher and various cipher mode.

Block ciphers are a n-bit permutation for some small n, typically 64 or 128 bits. They are a cryptographic primitive used to generate higher level operations such as authenticated encryption.

A block cipher by itself, is only able to securely encrypt a single data block. To be able to securely encrypt data of arbitrary length, a mode of operation applies the block cipher’s single block operation repeatedly to encrypt an entire message.

-}
module Z.Crypto.Cipher
  ( -- * Block Cipher
    BlockCipherType(..), KeySpec(..)
  , BlockCipher, blockCipherName, blockCipherKeySpec, blockCipherSize
  , newBlockCipher, setBlockCipherKey, clearBlockCipher
  , encryptBlocks, decryptBlocks
    -- * Cipher Mode
  , CipherMode(..), CipherDirection(..)
  , Cipher, cipherName, cipherKeySpec, cipherTagLength, defaultNonceLength
  , newCipher, setCipherKey, clearCipher, runCipher
    -- * Stream Cipher
  , StreamCipherType(..), StreamCipher, streamCipherName, streamCipherKeySpec, defaultIVLength
  , newStreamCipher, setStreamCipherKey, clearStreamCipher
  , setStreamCipherIV, seekStreamCipher, runStreamCipher, streamCipherKeyStream, streamCipherBIO, keyStreamSource
    -- * Internal helps
  , blockCipherTypeToCBytes
  , withBlockCipher
  , withCipher
  , withStreamCipher
    -- * re-export
  , HashType(..)
  , module Z.Crypto.SafeMem
  ) where

import           Control.Monad
import           GHC.Generics
import           Z.Botan.Exception
import           Z.Botan.FFI
import           Z.Crypto.Hash
import           Z.Crypto.SafeMem
import           Z.Data.CBytes       as CB
import           Z.Data.JSON         (JSON)
import qualified Z.Data.Text         as T
import qualified Z.Data.Vector.Base  as V
import qualified Z.Data.Vector.Extra as V
import           Z.Foreign
import           Z.IO.BIO

-- | Available Block Ciphers
--
-- Botan includes a number of block ciphers that are specific to particular countries, as well as a few that are included mostly due to their use in specific protocols such as PGP but not widely used elsewhere. If you are developing new code and have no particular opinion, use AES-256. If you desire an alternative to AES, consider Serpent, SHACAL2 or Threefish.
--
-- Warning: Avoid any 64-bit block cipher in new designs. There are combinatoric issues that affect any 64-bit cipher that render it insecure when large amounts of data are processed.
--
data BlockCipherType
      -- | AES
      --
      -- Comes in three variants, AES-128, AES-192, and AES-256.
      -- The standard 128-bit block cipher. Many modern platforms offer hardware acceleration.
      -- However, on platforms without hardware support, AES implementations typically are vulnerable
      -- to side channel attacks.
      -- For x86 systems with SSSE3 but without AES-NI, Botan has an implementation which avoids known side channels.
    = AES128
    | AES192
    | AES256
      -- | ARIA
      --
      -- South Korean cipher used in industry there. No reason to use it otherwise.
    | ARIA128
    | ARIA192
    | ARIA256
      -- | Blowfish
      --
      -- A 64-bit cipher popular in the pre-AES era. Very slow key setup.
      -- Also used (with bcrypt) for password hashing.
    | Blowfish
      -- | Camellia
      --
      -- Comes in three variants, Camellia-128, Camellia-192, and Camellia-256.
      -- A Japanese design standardized by ISO, NESSIE and CRYPTREC. Rarely used outside of Japan.
    | Camellia128
    | Camellia192
    | Camellia256
      -- | Cascade
      --
      -- Creates a block cipher cascade, where each block is encrypted by two ciphers with independent keys.
      -- Useful if you're very paranoid. In practice any single good cipher (such as Serpent, SHACAL2, or AES-256)
      -- is more than sufficient.
      --
      -- Please set a key with size = max_key_size_A + max_key_size_B.
    | Cascade BlockCipherType BlockCipherType
      -- | CAST-128
      --
      -- A 64-bit cipher, commonly used in OpenPGP.
    | CAST128
      -- | CAST-256
      --
      -- A 128-bit cipher that was a contestant in the NIST AES competition.
      -- Almost never used in practice. Prefer AES or Serpent.
      -- Warning: Support for CAST-256 is deprecated and will be removed in a future major release.
    | CAST256
      -- | DES, 3DES, DESX
      --
      -- Originally designed by IBM and NSA in the 1970s. Today, DES's 56-bit key renders it insecure
      -- to any well-resourced attacker. DESX and 3DES extend the key length, and are still thought to be secure,
      -- modulo the limitation of a 64-bit block.
      -- All are somewhat common in some industries such as finance. Avoid in new code.
      -- Warning: Support for DESX is deprecated and it will be removed in a future major release.
    | DES
    | DESX
    | TripleDES
      -- | IDEA
      --
      -- An older but still unbroken 64-bit cipher with a 128-bit key.
      -- Somewhat common due to its use in PGP. Avoid in new designs.
    | IDEA
      -- | Kasumi
      --
      -- A 64-bit cipher used in 3GPP mobile phone protocols. There is no reason to use it outside of this context.
      -- Warning: Support for Kasumi is deprecated and will be removed in a future major release.
    | KASUMI
      -- | Lion
      --
      -- A "block cipher construction" which can encrypt blocks of nearly arbitrary length.
      -- Built from a stream cipher and a hash function.
      -- Useful in certain protocols where being able to encrypt large or arbitrary length blocks is necessary.
    | Lion HashType StreamCipherType Int
      -- | MISTY1
      --
      -- A 64-bit Japanese cipher standardized by NESSIE and ISO.
      -- Seemingly secure, but quite slow and saw little adoption. No reason to use it in new code.
      -- Warning: Support for MISTY1 is deprecated and will be removed in a future major release.
    | MISTY1
      -- | Noekeon
      --
      -- A fast 128-bit cipher by the designers of AES. Easily secured against side channels.
    | Noekeon
      -- | SEED
      --
      -- A older South Korean cipher, widely used in industry there. No reason to choose it otherwise.
    | SEED
      -- | Serpent
      --
      -- An AES contender. Widely considered the most conservative design.
      -- Fairly slow unless SIMD instructions are available.
    | Serpent
      -- | SHACAL2
      --
      -- The 256-bit block cipher used inside SHA-256. Accepts up to a 512-bit key.
      -- Fast, especially when SIMD or SHA-2 acceleration instructions are available.
      -- Standardized by NESSIE but otherwise obscure.
    | SHACAL2
      -- | Twofish
      --
      -- A 128-bit block cipher that was one of the AES finalists.
      -- Has a somewhat complicated key setup and a "kitchen sink" design.
    | Twofish
      -- | SM4
      --
      -- A 128-bit Chinese national cipher, required for use in certain commercial applications in China.
      -- Quite slow. Probably no reason to use it outside of legal requirements.
    | SM4
      -- | Threefish-512
      --
      -- A 512-bit tweakable block cipher that was used in the Skein hash function. Very fast on 64-bit processors.
    | Threefish512
      -- | XTEA
      --
      -- A 64-bit cipher popular for its simple implementation. Avoid in new code.
    | XTEA
  deriving (Int -> BlockCipherType -> ShowS
[BlockCipherType] -> ShowS
BlockCipherType -> String
(Int -> BlockCipherType -> ShowS)
-> (BlockCipherType -> String)
-> ([BlockCipherType] -> ShowS)
-> Show BlockCipherType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockCipherType] -> ShowS
$cshowList :: [BlockCipherType] -> ShowS
show :: BlockCipherType -> String
$cshow :: BlockCipherType -> String
showsPrec :: Int -> BlockCipherType -> ShowS
$cshowsPrec :: Int -> BlockCipherType -> ShowS
Show, ReadPrec [BlockCipherType]
ReadPrec BlockCipherType
Int -> ReadS BlockCipherType
ReadS [BlockCipherType]
(Int -> ReadS BlockCipherType)
-> ReadS [BlockCipherType]
-> ReadPrec BlockCipherType
-> ReadPrec [BlockCipherType]
-> Read BlockCipherType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BlockCipherType]
$creadListPrec :: ReadPrec [BlockCipherType]
readPrec :: ReadPrec BlockCipherType
$creadPrec :: ReadPrec BlockCipherType
readList :: ReadS [BlockCipherType]
$creadList :: ReadS [BlockCipherType]
readsPrec :: Int -> ReadS BlockCipherType
$creadsPrec :: Int -> ReadS BlockCipherType
Read, BlockCipherType -> BlockCipherType -> Bool
(BlockCipherType -> BlockCipherType -> Bool)
-> (BlockCipherType -> BlockCipherType -> Bool)
-> Eq BlockCipherType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockCipherType -> BlockCipherType -> Bool
$c/= :: BlockCipherType -> BlockCipherType -> Bool
== :: BlockCipherType -> BlockCipherType -> Bool
$c== :: BlockCipherType -> BlockCipherType -> Bool
Eq, Eq BlockCipherType
Eq BlockCipherType
-> (BlockCipherType -> BlockCipherType -> Ordering)
-> (BlockCipherType -> BlockCipherType -> Bool)
-> (BlockCipherType -> BlockCipherType -> Bool)
-> (BlockCipherType -> BlockCipherType -> Bool)
-> (BlockCipherType -> BlockCipherType -> Bool)
-> (BlockCipherType -> BlockCipherType -> BlockCipherType)
-> (BlockCipherType -> BlockCipherType -> BlockCipherType)
-> Ord BlockCipherType
BlockCipherType -> BlockCipherType -> Bool
BlockCipherType -> BlockCipherType -> Ordering
BlockCipherType -> BlockCipherType -> BlockCipherType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlockCipherType -> BlockCipherType -> BlockCipherType
$cmin :: BlockCipherType -> BlockCipherType -> BlockCipherType
max :: BlockCipherType -> BlockCipherType -> BlockCipherType
$cmax :: BlockCipherType -> BlockCipherType -> BlockCipherType
>= :: BlockCipherType -> BlockCipherType -> Bool
$c>= :: BlockCipherType -> BlockCipherType -> Bool
> :: BlockCipherType -> BlockCipherType -> Bool
$c> :: BlockCipherType -> BlockCipherType -> Bool
<= :: BlockCipherType -> BlockCipherType -> Bool
$c<= :: BlockCipherType -> BlockCipherType -> Bool
< :: BlockCipherType -> BlockCipherType -> Bool
$c< :: BlockCipherType -> BlockCipherType -> Bool
compare :: BlockCipherType -> BlockCipherType -> Ordering
$ccompare :: BlockCipherType -> BlockCipherType -> Ordering
$cp1Ord :: Eq BlockCipherType
Ord, (forall x. BlockCipherType -> Rep BlockCipherType x)
-> (forall x. Rep BlockCipherType x -> BlockCipherType)
-> Generic BlockCipherType
forall x. Rep BlockCipherType x -> BlockCipherType
forall x. BlockCipherType -> Rep BlockCipherType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockCipherType x -> BlockCipherType
$cfrom :: forall x. BlockCipherType -> Rep BlockCipherType x
Generic)
  deriving anyclass (Int -> BlockCipherType -> Builder ()
(Int -> BlockCipherType -> Builder ()) -> Print BlockCipherType
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> BlockCipherType -> Builder ()
$ctoUTF8BuilderP :: Int -> BlockCipherType -> Builder ()
T.Print, Value -> Converter BlockCipherType
BlockCipherType -> Value
BlockCipherType -> Builder ()
(Value -> Converter BlockCipherType)
-> (BlockCipherType -> Value)
-> (BlockCipherType -> Builder ())
-> JSON BlockCipherType
forall a.
(Value -> Converter a)
-> (a -> Value) -> (a -> Builder ()) -> JSON a
encodeJSON :: BlockCipherType -> Builder ()
$cencodeJSON :: BlockCipherType -> Builder ()
toValue :: BlockCipherType -> Value
$ctoValue :: BlockCipherType -> Value
fromValue :: Value -> Converter BlockCipherType
$cfromValue :: Value -> Converter BlockCipherType
JSON)

blockCipherTypeToCBytes :: BlockCipherType -> CBytes
{-# INLINABLE blockCipherTypeToCBytes #-}
blockCipherTypeToCBytes :: BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
b = case BlockCipherType
b of
    BlockCipherType
AES128           ->    CBytes
"AES-128"
    BlockCipherType
AES192           ->    CBytes
"AES-192"
    BlockCipherType
AES256           ->    CBytes
"AES-256"
    BlockCipherType
ARIA128          ->    CBytes
"ARIA-128"
    BlockCipherType
ARIA192          ->    CBytes
"ARIA-192"
    BlockCipherType
ARIA256          ->    CBytes
"ARIA-256"
    BlockCipherType
Serpent          ->    CBytes
"Serpent"
    BlockCipherType
SHACAL2          ->    CBytes
"SHACAL2"
    BlockCipherType
Twofish          ->    CBytes
"Twofish"
    BlockCipherType
Threefish512     ->    CBytes
"Threefish-512"
    BlockCipherType
Blowfish         ->    CBytes
"Blowfish"
    BlockCipherType
Camellia128      ->    CBytes
"Camellia-128"
    BlockCipherType
Camellia192      ->    CBytes
"Camellia-192"
    BlockCipherType
Camellia256      ->    CBytes
"Camellia-256"
    BlockCipherType
DES              ->    CBytes
"DES"
    BlockCipherType
DESX             ->    CBytes
"DESX"
    BlockCipherType
TripleDES        ->    CBytes
"TripleDES"
    BlockCipherType
Noekeon          ->    CBytes
"Noekeon"
    BlockCipherType
CAST128          ->    CBytes
"CAST-128"
    BlockCipherType
CAST256          ->    CBytes
"CAST-256"
    BlockCipherType
IDEA             ->    CBytes
"IDEA"
    BlockCipherType
KASUMI           ->    CBytes
"KASUMI"
    BlockCipherType
MISTY1           ->    CBytes
"MISTY1"
    BlockCipherType
SEED             ->    CBytes
"SEED"
    BlockCipherType
SM4              ->    CBytes
"SM4"
    BlockCipherType
XTEA             ->    CBytes
"XTEA"
    Cascade BlockCipherType
b1 BlockCipherType
b2    ->    [CBytes] -> CBytes
CB.concat [ CBytes
"Cascade("
                                     , BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
b1
                                     , CBytes
","
                                     , BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
b2
                                     , CBytes
")"]
    Lion HashType
hasht StreamCipherType
st Int
siz -> [CBytes] -> CBytes
CB.concat [ CBytes
"Lion("
                                  , HashType -> CBytes
hashTypeToCBytes HashType
hasht
                                  , CBytes
","
                                  , StreamCipherType -> CBytes
streamCipherTypeToCBytes StreamCipherType
st
                                  , CBytes
","
                                  , Text -> CBytes
CB.fromText (Int -> Text
forall a. Print a => a -> Text
T.toText Int
siz)
                                  , CBytes
")"]

-- | A Botan block cipher.
--
-- In almost all cases, a bare block cipher is not what you should be using.
-- You probably want an authenticated cipher mode instead (see 'CipherMode'),
-- This interface is used to build higher level operations (such as cipher modes or MACs),
-- or in the very rare situation where ECB is required, eg for compatibility with an existing system.
--
data BlockCipher = BlockCipher
    { BlockCipher -> BotanStruct
blockCipher        :: {-# UNPACK #-} !BotanStruct
    , BlockCipher -> CBytes
blockCipherName    :: {-# UNPACK #-} !CBytes          -- ^ block cipher algo name
    , BlockCipher -> Int
blockCipherSize    :: {-# UNPACK #-} !Int             -- ^ block cipher block size
    , BlockCipher -> KeySpec
blockCipherKeySpec :: {-# UNPACK #-} !KeySpec         -- ^ block cipher keyspec
    }
    deriving (Int -> BlockCipher -> ShowS
[BlockCipher] -> ShowS
BlockCipher -> String
(Int -> BlockCipher -> ShowS)
-> (BlockCipher -> String)
-> ([BlockCipher] -> ShowS)
-> Show BlockCipher
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockCipher] -> ShowS
$cshowList :: [BlockCipher] -> ShowS
show :: BlockCipher -> String
$cshow :: BlockCipher -> String
showsPrec :: Int -> BlockCipher -> ShowS
$cshowsPrec :: Int -> BlockCipher -> ShowS
Show, (forall x. BlockCipher -> Rep BlockCipher x)
-> (forall x. Rep BlockCipher x -> BlockCipher)
-> Generic BlockCipher
forall x. Rep BlockCipher x -> BlockCipher
forall x. BlockCipher -> Rep BlockCipher x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockCipher x -> BlockCipher
$cfrom :: forall x. BlockCipher -> Rep BlockCipher x
Generic)
    deriving anyclass Int -> BlockCipher -> Builder ()
(Int -> BlockCipher -> Builder ()) -> Print BlockCipher
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> BlockCipher -> Builder ()
$ctoUTF8BuilderP :: Int -> BlockCipher -> Builder ()
T.Print

-- | Pass 'BlockCipher' to FFI as 'botan_block_cipher_t'.
withBlockCipher :: BlockCipher -> (BotanStructT -> IO r) -> IO r
{-# INLINABLE withBlockCipher #-}
withBlockCipher :: BlockCipher -> (BotanStructT -> IO r) -> IO r
withBlockCipher (BlockCipher BotanStruct
bc CBytes
_ Int
_ KeySpec
_) = BotanStruct -> (BotanStructT -> IO r) -> IO r
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bc

data KeySpec = KeySpec
    { KeySpec -> Int
keyLenMin :: {-# UNPACK #-} !Int  -- ^ minimum keylength
    , KeySpec -> Int
keyLenMax :: {-# UNPACK #-} !Int  -- ^ maximum keylength
    , KeySpec -> Int
keyLenMod :: {-# UNPACK #-} !Int  -- ^ keylength modulo
    }
    deriving (KeySpec -> KeySpec -> Bool
(KeySpec -> KeySpec -> Bool)
-> (KeySpec -> KeySpec -> Bool) -> Eq KeySpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeySpec -> KeySpec -> Bool
$c/= :: KeySpec -> KeySpec -> Bool
== :: KeySpec -> KeySpec -> Bool
$c== :: KeySpec -> KeySpec -> Bool
Eq, Eq KeySpec
Eq KeySpec
-> (KeySpec -> KeySpec -> Ordering)
-> (KeySpec -> KeySpec -> Bool)
-> (KeySpec -> KeySpec -> Bool)
-> (KeySpec -> KeySpec -> Bool)
-> (KeySpec -> KeySpec -> Bool)
-> (KeySpec -> KeySpec -> KeySpec)
-> (KeySpec -> KeySpec -> KeySpec)
-> Ord KeySpec
KeySpec -> KeySpec -> Bool
KeySpec -> KeySpec -> Ordering
KeySpec -> KeySpec -> KeySpec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeySpec -> KeySpec -> KeySpec
$cmin :: KeySpec -> KeySpec -> KeySpec
max :: KeySpec -> KeySpec -> KeySpec
$cmax :: KeySpec -> KeySpec -> KeySpec
>= :: KeySpec -> KeySpec -> Bool
$c>= :: KeySpec -> KeySpec -> Bool
> :: KeySpec -> KeySpec -> Bool
$c> :: KeySpec -> KeySpec -> Bool
<= :: KeySpec -> KeySpec -> Bool
$c<= :: KeySpec -> KeySpec -> Bool
< :: KeySpec -> KeySpec -> Bool
$c< :: KeySpec -> KeySpec -> Bool
compare :: KeySpec -> KeySpec -> Ordering
$ccompare :: KeySpec -> KeySpec -> Ordering
$cp1Ord :: Eq KeySpec
Ord, Int -> KeySpec -> ShowS
[KeySpec] -> ShowS
KeySpec -> String
(Int -> KeySpec -> ShowS)
-> (KeySpec -> String) -> ([KeySpec] -> ShowS) -> Show KeySpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeySpec] -> ShowS
$cshowList :: [KeySpec] -> ShowS
show :: KeySpec -> String
$cshow :: KeySpec -> String
showsPrec :: Int -> KeySpec -> ShowS
$cshowsPrec :: Int -> KeySpec -> ShowS
Show, (forall x. KeySpec -> Rep KeySpec x)
-> (forall x. Rep KeySpec x -> KeySpec) -> Generic KeySpec
forall x. Rep KeySpec x -> KeySpec
forall x. KeySpec -> Rep KeySpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeySpec x -> KeySpec
$cfrom :: forall x. KeySpec -> Rep KeySpec x
Generic)
    deriving anyclass Int -> KeySpec -> Builder ()
(Int -> KeySpec -> Builder ()) -> Print KeySpec
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> KeySpec -> Builder ()
$ctoUTF8BuilderP :: Int -> KeySpec -> Builder ()
T.Print

-- | Create a new block cipher.
--
newBlockCipher :: HasCallStack => BlockCipherType -> IO BlockCipher
{-# INLINABLE newBlockCipher #-}
newBlockCipher :: BlockCipherType -> IO BlockCipher
newBlockCipher BlockCipherType
typ = do
    let name :: CBytes
name = BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
typ
    BotanStruct
bc <- (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
        (\ MBA# BotanStructT
bts -> CBytes -> (BA# Word8 -> IO CInt) -> IO CInt
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
name (MBA# BotanStructT -> BA# Word8 -> IO CInt
botan_block_cipher_init MBA# BotanStructT
bts))
        FunPtr (BotanStructT -> IO ())
botan_block_cipher_destroy

    CInt
bsiz <- BotanStruct -> (BotanStructT -> IO CInt) -> IO CInt
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bc BotanStructT -> IO CInt
botan_block_cipher_block_size

    (Int
a, (Int
b, (Int
c, ()
_))) <- BotanStruct
-> (BotanStructT -> IO (Int, (Int, (Int, ()))))
-> IO (Int, (Int, (Int, ())))
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bc ((BotanStructT -> IO (Int, (Int, (Int, ()))))
 -> IO (Int, (Int, (Int, ()))))
-> (BotanStructT -> IO (Int, (Int, (Int, ()))))
-> IO (Int, (Int, (Int, ())))
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pbc ->
        (MBA# BotanStructT -> IO (Int, (Int, ())))
-> IO (Int, (Int, (Int, ())))
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# BotanStructT -> IO (Int, (Int, ())))
 -> IO (Int, (Int, (Int, ()))))
-> (MBA# BotanStructT -> IO (Int, (Int, ())))
-> IO (Int, (Int, (Int, ())))
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pa ->
            (MBA# BotanStructT -> IO (Int, ())) -> IO (Int, (Int, ()))
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# BotanStructT -> IO (Int, ())) -> IO (Int, (Int, ())))
-> (MBA# BotanStructT -> IO (Int, ())) -> IO (Int, (Int, ()))
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pb ->
                (MBA# BotanStructT -> IO ()) -> IO (Int, ())
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# BotanStructT -> IO ()) -> IO (Int, ()))
-> (MBA# BotanStructT -> IO ()) -> IO (Int, ())
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pc ->
                    IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_
                        (BotanStructT
-> MBA# BotanStructT
-> MBA# BotanStructT
-> MBA# BotanStructT
-> IO CInt
botan_block_cipher_get_keyspec BotanStructT
pbc MBA# BotanStructT
pa MBA# BotanStructT
pb MBA# BotanStructT
pc)

    BlockCipher -> IO BlockCipher
forall (m :: * -> *) a. Monad m => a -> m a
return (BotanStruct -> CBytes -> Int -> KeySpec -> BlockCipher
BlockCipher BotanStruct
bc CBytes
name (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
bsiz) (Int -> Int -> Int -> KeySpec
KeySpec Int
a Int
b Int
c))

-- | Set the cipher key, which is required before encrypting or decrypting.
--
setBlockCipherKey :: HasCallStack => BlockCipher -> Secret -> IO ()
{-# INLINABLE setBlockCipherKey #-}
setBlockCipherKey :: BlockCipher -> Secret -> IO ()
setBlockCipherKey (BlockCipher BotanStruct
bc CBytes
_ Int
_ KeySpec
_) Secret
key =
    BotanStruct -> (BotanStructT -> IO ()) -> IO ()
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bc ((BotanStructT -> IO ()) -> IO ())
-> (BotanStructT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pbc -> do
        Secret -> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall r. Secret -> (Ptr Word8 -> CSize -> IO r) -> IO r
withSecret Secret
key ((Ptr Word8 -> CSize -> IO ()) -> IO ())
-> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
pkey CSize
key_len ->
            IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT -> Ptr Word8 -> CSize -> IO CInt
botan_block_cipher_set_key BotanStructT
pbc Ptr Word8
pkey CSize
key_len)

-- | Clear the internal state (such as keys) of this cipher object.
clearBlockCipher :: HasCallStack => BlockCipher -> IO ()
{-# INLINABLE clearBlockCipher #-}
clearBlockCipher :: BlockCipher -> IO ()
clearBlockCipher (BlockCipher BotanStruct
bc CBytes
_ Int
_ KeySpec
_) =
    BotanStruct -> (BotanStructT -> IO ()) -> IO ()
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bc (IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (IO CInt -> IO ())
-> (BotanStructT -> IO CInt) -> BotanStructT -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotanStructT -> IO CInt
botan_block_cipher_clear)

-- | Encrypt blocks of data.
--
-- The key must have been set first with 'setBlockCipherKey'.
encryptBlocks :: HasCallStack
              => BlockCipher
              -> V.Bytes    -- ^ blocks of data, length must be equal to block_size * number_of_blocks
              -> Int        -- ^ number of blocks
              -> IO V.Bytes
{-# INLINABLE encryptBlocks #-}
encryptBlocks :: BlockCipher -> Bytes -> Int -> IO Bytes
encryptBlocks (BlockCipher BotanStruct
bc CBytes
_ Int
blockSiz KeySpec
_) Bytes
blocks Int
n = do
    let inputLen :: Int
inputLen = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
blocks
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
inputLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
blockSiz Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        CInt -> IO ()
forall x. HasCallStack => CInt -> IO x
throwBotanError CInt
BOTAN_FFI_ERROR_INVALID_INPUT
    BotanStruct -> (BotanStructT -> IO Bytes) -> IO Bytes
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bc ((BotanStructT -> IO Bytes) -> IO Bytes)
-> (BotanStructT -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pbc -> do
        Bytes -> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
blocks ((BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes)
-> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pb Int
pboff Int
_ ->
            (Bytes, ()) -> Bytes
forall a b. (a, b) -> a
fst ((Bytes, ()) -> Bytes) -> IO (Bytes, ()) -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (MBA# BotanStructT -> IO ()) -> IO (Bytes, ())
forall a b.
Prim a =>
Int -> (MBA# BotanStructT -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe Int
inputLen (\ MBA# BotanStructT
pbuf ->
                IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT
-> BA# Word8 -> Int -> MBA# BotanStructT -> Int -> IO CInt
hs_botan_block_cipher_encrypt_blocks
                    BotanStructT
pbc BA# Word8
pb Int
pboff MBA# BotanStructT
pbuf Int
n))

-- | Decrypt blocks of data.
--
-- The key must have been set first with 'setBlockCipherKey'.
decryptBlocks :: HasCallStack
              => BlockCipher
              -> V.Bytes    -- ^ blocks of data, length must be equal to block_size * number_of_blocks
              -> Int        -- ^ number of blocks
              -> IO V.Bytes
{-# INLINABLE decryptBlocks #-}
decryptBlocks :: BlockCipher -> Bytes -> Int -> IO Bytes
decryptBlocks (BlockCipher BotanStruct
bc CBytes
_ Int
blockSiz KeySpec
_) Bytes
blocks Int
n = do
    let inputLen :: Int
inputLen = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
blocks
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
inputLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
blockSiz Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        CInt -> IO ()
forall x. HasCallStack => CInt -> IO x
throwBotanError CInt
BOTAN_FFI_ERROR_INVALID_INPUT
    BotanStruct -> (BotanStructT -> IO Bytes) -> IO Bytes
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bc ((BotanStructT -> IO Bytes) -> IO Bytes)
-> (BotanStructT -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pbc -> do
        Bytes -> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
blocks ((BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes)
-> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pb Int
pboff Int
_ ->
            (Bytes, ()) -> Bytes
forall a b. (a, b) -> a
fst ((Bytes, ()) -> Bytes) -> IO (Bytes, ()) -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (MBA# BotanStructT -> IO ()) -> IO (Bytes, ())
forall a b.
Prim a =>
Int -> (MBA# BotanStructT -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe Int
inputLen (\ MBA# BotanStructT
pbuf ->
                IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT
-> BA# Word8 -> Int -> MBA# BotanStructT -> Int -> IO CInt
hs_botan_block_cipher_decrypt_blocks
                    BotanStructT
pbc BA# Word8
pb Int
pboff MBA# BotanStructT
pbuf Int
n))


--------------------------------------------------------------------------------
--

-- | All available cipher types.
--
-- A block cipher by itself, is only able to securely encrypt a single data block.
-- To be able to securely encrypt data of arbitrary length, a mode of operation applies
-- the block cipher’s single block operation repeatedly to encrypt an entire message.
--
-- Notes on the AEAD modes(CCM, ChaCha20Poly1305, EAX, GCM, OCB, SIV):
--
-- AEAD (Authenticated Encryption with Associated Data) modes provide message encryption,
-- message authentication, and the ability to authenticate additional data that is not included
-- in the ciphertext (such as a sequence number or header).
--
data CipherMode
    -- | ChaCha20Poly1305
    --
    -- Unlike the other AEADs which are based on block ciphers,
    -- this mode is based on the ChaCha stream cipher and the Poly1305 authentication code.
    -- It is very fast on all modern platforms.
    --
    -- ChaCha20Poly1305 supports 64-bit, 96-bit, and (since 2.8) 192-bit nonces.
    -- 64-bit nonces are the “classic” ChaCha20Poly1305 design.
    -- 96-bit nonces are used by the IETF standard version of ChaCha20Poly1305.
    -- And 192-bit nonces is the XChaCha20Poly1305 construction, which is somewhat less common.
    --
    -- For best interop use the IETF version with 96-bit nonces.
    -- However 96 bits is small enough that it can be dangerous to generate nonces randomly
    -- if more than ~ 2^32 messages are encrypted under a single key,
    -- since if a nonce is ever reused ChaCha20Poly1305 becomes insecure.
    -- It is better to use a counter for the nonce in this case.
    --
    -- If you are encrypting many messages under a single key and cannot maintain a counter for the nonce,
    -- prefer XChaCha20Poly1305 since a 192 bit nonce is large enough that randomly chosen nonces
    -- are extremely unlikely to repeat.
    = ChaCha20Poly1305
    -- | GCM
    --
    -- NIST standard, commonly used. Requires a 128-bit block cipher.
    -- Fairly slow, unless hardware support for carryless multiplies is available.
    --
    -- Default tag size is 16
    | GCM BlockCipherType
    -- | GCM with custom tag length
    | GCM' BlockCipherType Int         -- ^ tag size

    -- | OCB
    --
    -- A block cipher based AEAD. Supports 128-bit, 256-bit and 512-bit block ciphers.
    -- This mode is very fast and easily secured against side channels.
    -- Adoption has been poor because it is patented in the United States,
    -- though a license is available allowing it to be freely used by open source software.
    --
    -- Default tag size is 16
    | OCB BlockCipherType
    -- | OCB with custom tag length
    | OCB' BlockCipherType Int         -- ^ tag size

    -- | EAX
    -- A secure composition of CTR mode and CMAC. Supports 128-bit, 256-bit and 512-bit block ciphers.
    --
    -- Default tag size is the block size
    | EAX BlockCipherType
    -- | EAX with custom tag length
    | EAX' BlockCipherType Int         -- ^ tag size

    -- | SIV
    --
    -- Requires a 128-bit block cipher. Unlike other AEADs, SIV is “misuse resistant”;
    -- if a nonce is repeated, SIV retains security, with the exception that if the same nonce
    -- is used to encrypt the same message multiple times,
    -- an attacker can detect the fact that the message was duplicated
    -- (this is simply because if both the nonce and the message are reused,
    -- SIV will output identical ciphertexts).
    | SIV BlockCipherType
    -- | CCM
    --
    -- A composition of CTR mode and CBC-MAC. Requires a 128-bit block cipher.
    -- This is a NIST standard mode, but that is about all to recommend it. Prefer EAX.
    --
    -- Default tag size is 16 and L is 3
    | CCM BlockCipherType
    -- | CCM with custom tag size
    | CCM' BlockCipherType
            Int         -- ^ tag size
            Int         -- ^ L

    -- | CFB
    --
    -- CFB uses a block cipher to create a self-synchronizing stream cipher.
    -- It is used for example in the OpenPGP protocol. There is no reason to prefer it,
    -- as it has worse performance characteristics than modes such as CTR or CBC.
    --
    -- The default feedback bits size are 8*blocksize
    | CFB BlockCipherType
    -- | CFB with custom feedback bits size
    | CFB' BlockCipherType
            Int     -- ^ feedback bits size

    -- | XTS
    --
    -- XTS is a mode specialized for encrypting disk or database storage where ciphertext expansion
    -- is not possible. XTS requires all inputs be at least one full block (16 bytes for AES),
    -- however for any acceptable input length, there is no ciphertext expansion.
    | XTS BlockCipherType
    -- | CBC
    --
    -- CBC requires the plaintext be padded using a reversible rule. The following padding schemes are implemented
    --
    --  * PKCS#7 (RFC5652)
    --    The last byte in the padded block defines the padding length p,
    --    the remaining padding bytes are set to p as well.
    | CBC_PKCS7 BlockCipherType
    -- | CBC
    --
    --  * OneAndZeros (ISO/IEC 7816-4)
    --    The first padding byte is set to 0x80, the remaining padding bytes are set to 0x00.
    | CBC_OneAndZeros BlockCipherType
    -- | CBC
    --
    --  * ANSI X9.23
    --    The last byte in the padded block defines the padding length,
    --    the remaining padding is filled with 0x00.
    | CBC_X9'23 BlockCipherType
    -- | CBC
    --
    --  * ESP (RFC4303)
    --    Padding with 0x01, 0x02, 0x03...
    | CBC_ESP BlockCipherType
    -- | CTS
    --
    -- This scheme allows the ciphertext to have the same length as the plaintext,
    -- however using CTS requires the input be at least one full block plus one byte.
    -- It is also less commonly implemented.
    | CBC_CTS BlockCipherType
    -- | No padding CBC
    --
    -- Only use this mode when input length is a multipler of cipher block size.
    | CBC_NoPadding BlockCipherType
  deriving (Int -> CipherMode -> ShowS
[CipherMode] -> ShowS
CipherMode -> String
(Int -> CipherMode -> ShowS)
-> (CipherMode -> String)
-> ([CipherMode] -> ShowS)
-> Show CipherMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CipherMode] -> ShowS
$cshowList :: [CipherMode] -> ShowS
show :: CipherMode -> String
$cshow :: CipherMode -> String
showsPrec :: Int -> CipherMode -> ShowS
$cshowsPrec :: Int -> CipherMode -> ShowS
Show, ReadPrec [CipherMode]
ReadPrec CipherMode
Int -> ReadS CipherMode
ReadS [CipherMode]
(Int -> ReadS CipherMode)
-> ReadS [CipherMode]
-> ReadPrec CipherMode
-> ReadPrec [CipherMode]
-> Read CipherMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CipherMode]
$creadListPrec :: ReadPrec [CipherMode]
readPrec :: ReadPrec CipherMode
$creadPrec :: ReadPrec CipherMode
readList :: ReadS [CipherMode]
$creadList :: ReadS [CipherMode]
readsPrec :: Int -> ReadS CipherMode
$creadsPrec :: Int -> ReadS CipherMode
Read, CipherMode -> CipherMode -> Bool
(CipherMode -> CipherMode -> Bool)
-> (CipherMode -> CipherMode -> Bool) -> Eq CipherMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CipherMode -> CipherMode -> Bool
$c/= :: CipherMode -> CipherMode -> Bool
== :: CipherMode -> CipherMode -> Bool
$c== :: CipherMode -> CipherMode -> Bool
Eq, Eq CipherMode
Eq CipherMode
-> (CipherMode -> CipherMode -> Ordering)
-> (CipherMode -> CipherMode -> Bool)
-> (CipherMode -> CipherMode -> Bool)
-> (CipherMode -> CipherMode -> Bool)
-> (CipherMode -> CipherMode -> Bool)
-> (CipherMode -> CipherMode -> CipherMode)
-> (CipherMode -> CipherMode -> CipherMode)
-> Ord CipherMode
CipherMode -> CipherMode -> Bool
CipherMode -> CipherMode -> Ordering
CipherMode -> CipherMode -> CipherMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CipherMode -> CipherMode -> CipherMode
$cmin :: CipherMode -> CipherMode -> CipherMode
max :: CipherMode -> CipherMode -> CipherMode
$cmax :: CipherMode -> CipherMode -> CipherMode
>= :: CipherMode -> CipherMode -> Bool
$c>= :: CipherMode -> CipherMode -> Bool
> :: CipherMode -> CipherMode -> Bool
$c> :: CipherMode -> CipherMode -> Bool
<= :: CipherMode -> CipherMode -> Bool
$c<= :: CipherMode -> CipherMode -> Bool
< :: CipherMode -> CipherMode -> Bool
$c< :: CipherMode -> CipherMode -> Bool
compare :: CipherMode -> CipherMode -> Ordering
$ccompare :: CipherMode -> CipherMode -> Ordering
$cp1Ord :: Eq CipherMode
Ord, (forall x. CipherMode -> Rep CipherMode x)
-> (forall x. Rep CipherMode x -> CipherMode) -> Generic CipherMode
forall x. Rep CipherMode x -> CipherMode
forall x. CipherMode -> Rep CipherMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CipherMode x -> CipherMode
$cfrom :: forall x. CipherMode -> Rep CipherMode x
Generic)
  deriving anyclass (Int -> CipherMode -> Builder ()
(Int -> CipherMode -> Builder ()) -> Print CipherMode
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> CipherMode -> Builder ()
$ctoUTF8BuilderP :: Int -> CipherMode -> Builder ()
T.Print, Value -> Converter CipherMode
CipherMode -> Value
CipherMode -> Builder ()
(Value -> Converter CipherMode)
-> (CipherMode -> Value)
-> (CipherMode -> Builder ())
-> JSON CipherMode
forall a.
(Value -> Converter a)
-> (a -> Value) -> (a -> Builder ()) -> JSON a
encodeJSON :: CipherMode -> Builder ()
$cencodeJSON :: CipherMode -> Builder ()
toValue :: CipherMode -> Value
$ctoValue :: CipherMode -> Value
fromValue :: Value -> Converter CipherMode
$cfromValue :: Value -> Converter CipherMode
JSON)

cipherTypeToCBytes :: CipherMode -> CBytes
{-# INLINABLE cipherTypeToCBytes #-}
cipherTypeToCBytes :: CipherMode -> CBytes
cipherTypeToCBytes CipherMode
ct = case CipherMode
ct of
    CipherMode
ChaCha20Poly1305 -> CBytes
"ChaCha20Poly1305"
    GCM        BlockCipherType
bct        -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/GCM"
    GCM'       BlockCipherType
bct Int
tagsiz -> [CBytes] -> CBytes
CB.concat [ BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct
                                     , CBytes
"/GCM("
                                     , Text -> CBytes
CB.fromText (Int -> Text
forall a. Print a => a -> Text
T.toText Int
tagsiz)
                                     , CBytes
")"
                                     ]

    OCB        BlockCipherType
bct        -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/OCB"
    OCB'       BlockCipherType
bct Int
tagsiz -> [CBytes] -> CBytes
CB.concat [ BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct
                                     , CBytes
"/OCB("
                                     , Text -> CBytes
CB.fromText (Int -> Text
forall a. Print a => a -> Text
T.toText Int
tagsiz)
                                     , CBytes
")"
                                     ]

    EAX        BlockCipherType
bct        -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/EAX"
    EAX'       BlockCipherType
bct Int
tagsiz -> [CBytes] -> CBytes
CB.concat [ BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct
                                     , CBytes
"/EAX("
                                     , Text -> CBytes
CB.fromText (Int -> Text
forall a. Print a => a -> Text
T.toText Int
tagsiz)
                                     , CBytes
")"
                                     ]


    SIV        BlockCipherType
bct -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/SIV"

    CCM        BlockCipherType
bct          -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/CCM"
    CCM'       BlockCipherType
bct Int
tagsiz Int
l -> [CBytes] -> CBytes
CB.concat [ BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct
                                         , CBytes
"/CCM("
                                         , Text -> CBytes
CB.fromText (Int -> Text
forall a. Print a => a -> Text
T.toText Int
tagsiz)
                                         , CBytes
","
                                         , Text -> CBytes
CB.fromText (Int -> Text
forall a. Print a => a -> Text
T.toText Int
l)
                                         , CBytes
")"
                                         ]

    CFB           BlockCipherType
bct   -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/CFB"
    CFB'          BlockCipherType
bct Int
x -> [CBytes] -> CBytes
CB.concat [ BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct
                                     , CBytes
"/CFB("
                                     , Text -> CBytes
CB.fromText (Int -> Text
forall a. Print a => a -> Text
T.toText Int
x)
                                     , CBytes
")"
                                     ]
    XTS             BlockCipherType
bct -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/XTS"
    CBC_PKCS7       BlockCipherType
bct -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/CBC/PKCS7"
    CBC_OneAndZeros BlockCipherType
bct -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/CBC/OneAndZeros"
    CBC_X9'23       BlockCipherType
bct -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/CBC/X9.23"
    CBC_ESP         BlockCipherType
bct -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/CBC/ESP"
    CBC_CTS         BlockCipherType
bct -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/CBC/CTS"
    CBC_NoPadding   BlockCipherType
bct -> BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
bct CBytes -> CBytes -> CBytes
forall a. Semigroup a => a -> a -> a
<> CBytes
"/CBC/NoPadding"

-- | A Botan cipher.
data Cipher = Cipher
    { Cipher -> BotanStruct
cipher                  :: {-# UNPACK #-} !BotanStruct
    , Cipher -> CBytes
cipherName              :: {-# UNPACK #-} !CBytes        -- ^ cipher algo name
    , Cipher -> KeySpec
cipherKeySpec           :: {-# UNPACK #-} !KeySpec       -- ^ cipher keyspec
    , Cipher -> Int
cipherTagLength         :: {-# UNPACK #-} !Int           -- ^ AEAD tag length, will be 0 for non-authenticated ciphers.
    , Cipher -> Int
defaultNonceLength      :: {-# UNPACK #-} !Int    -- ^ a proper default nonce length.
    }
    deriving (Int -> Cipher -> ShowS
[Cipher] -> ShowS
Cipher -> String
(Int -> Cipher -> ShowS)
-> (Cipher -> String) -> ([Cipher] -> ShowS) -> Show Cipher
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cipher] -> ShowS
$cshowList :: [Cipher] -> ShowS
show :: Cipher -> String
$cshow :: Cipher -> String
showsPrec :: Int -> Cipher -> ShowS
$cshowsPrec :: Int -> Cipher -> ShowS
Show, (forall x. Cipher -> Rep Cipher x)
-> (forall x. Rep Cipher x -> Cipher) -> Generic Cipher
forall x. Rep Cipher x -> Cipher
forall x. Cipher -> Rep Cipher x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cipher x -> Cipher
$cfrom :: forall x. Cipher -> Rep Cipher x
Generic)
    deriving anyclass Int -> Cipher -> Builder ()
(Int -> Cipher -> Builder ()) -> Print Cipher
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> Cipher -> Builder ()
$ctoUTF8BuilderP :: Int -> Cipher -> Builder ()
T.Print

-- | Pass 'Cipher' to FFI as 'botan_cipher_t'.
withCipher :: Cipher -> (BotanStructT -> IO r) -> IO r
{-# INLINABLE withCipher #-}
withCipher :: Cipher -> (BotanStructT -> IO r) -> IO r
withCipher (Cipher BotanStruct
c CBytes
_ KeySpec
_ Int
_ Int
_) = BotanStruct -> (BotanStructT -> IO r) -> IO r
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
c

-- | Create a new cipher.
--
newCipher :: HasCallStack => CipherMode -> CipherDirection -> IO Cipher
{-# INLINABLE newCipher #-}
newCipher :: CipherMode -> CipherDirection -> IO Cipher
newCipher CipherMode
typ CipherDirection
dir = do
    let name :: CBytes
name = CipherMode -> CBytes
cipherTypeToCBytes CipherMode
typ
    BotanStruct
ci <- (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
        (\ MBA# BotanStructT
bts -> CBytes -> (BA# Word8 -> IO CInt) -> IO CInt
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
name ((BA# Word8 -> IO CInt) -> IO CInt)
-> (BA# Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pb ->
            MBA# BotanStructT -> BA# Word8 -> Word32 -> IO CInt
botan_cipher_init MBA# BotanStructT
bts BA# Word8
pb (CipherDirection -> Word32
cipherDirectionToFlag CipherDirection
dir))
        FunPtr (BotanStructT -> IO ())
botan_cipher_destroy

    BotanStruct -> (BotanStructT -> IO Cipher) -> IO Cipher
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
ci ((BotanStructT -> IO Cipher) -> IO Cipher)
-> (BotanStructT -> IO Cipher) -> IO Cipher
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pci -> do

        (Int
a, (Int
b, (Int
c, ()
_))) <- (MBA# BotanStructT -> IO (Int, (Int, ())))
-> IO (Int, (Int, (Int, ())))
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# BotanStructT -> IO (Int, (Int, ())))
 -> IO (Int, (Int, (Int, ()))))
-> (MBA# BotanStructT -> IO (Int, (Int, ())))
-> IO (Int, (Int, (Int, ())))
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pa ->
            (MBA# BotanStructT -> IO (Int, ())) -> IO (Int, (Int, ()))
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# BotanStructT -> IO (Int, ())) -> IO (Int, (Int, ())))
-> (MBA# BotanStructT -> IO (Int, ())) -> IO (Int, (Int, ()))
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pb ->
                (MBA# BotanStructT -> IO ()) -> IO (Int, ())
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# BotanStructT -> IO ()) -> IO (Int, ()))
-> (MBA# BotanStructT -> IO ()) -> IO (Int, ())
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pc ->
                    IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_
                        (BotanStructT
-> MBA# BotanStructT
-> MBA# BotanStructT
-> MBA# BotanStructT
-> IO CInt
botan_cipher_get_keyspec BotanStructT
pci MBA# BotanStructT
pa MBA# BotanStructT
pb MBA# BotanStructT
pc)

        (Int
t, CInt
_) <- (MBA# BotanStructT -> IO CInt) -> IO (Int, CInt)
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# BotanStructT -> IO CInt) -> IO (Int, CInt))
-> (MBA# BotanStructT -> IO CInt) -> IO (Int, CInt)
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pt ->
            BotanStructT -> MBA# BotanStructT -> IO CInt
botan_cipher_get_tag_length BotanStructT
pci MBA# BotanStructT
pt

        (Int
n, CInt
_) <- (MBA# BotanStructT -> IO CInt) -> IO (Int, CInt)
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# BotanStructT -> IO CInt) -> IO (Int, CInt))
-> (MBA# BotanStructT -> IO CInt) -> IO (Int, CInt)
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pn ->
            BotanStructT -> MBA# BotanStructT -> IO CInt
botan_cipher_get_default_nonce_length BotanStructT
pci MBA# BotanStructT
pn

        Cipher -> IO Cipher
forall (m :: * -> *) a. Monad m => a -> m a
return (BotanStruct -> CBytes -> KeySpec -> Int -> Int -> Cipher
Cipher BotanStruct
ci CBytes
name (Int -> Int -> Int -> KeySpec
KeySpec Int
a Int
b Int
c) Int
t Int
n)

-- | Clear the internal state (such as keys) of this cipher object.
--
clearCipher :: HasCallStack => Cipher -> IO ()
{-# INLINABLE clearCipher #-}
clearCipher :: Cipher -> IO ()
clearCipher Cipher
ci = Cipher -> (BotanStructT -> IO ()) -> IO ()
forall r. Cipher -> (BotanStructT -> IO r) -> IO r
withCipher Cipher
ci (IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (IO CInt -> IO ())
-> (BotanStructT -> IO CInt) -> BotanStructT -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotanStructT -> IO CInt
botan_cipher_clear)

-- | Set the key for this cipher object
--
setCipherKey :: HasCallStack => Cipher -> Secret -> IO ()
{-# INLINABLE setCipherKey #-}
setCipherKey :: Cipher -> Secret -> IO ()
setCipherKey Cipher
ci Secret
key =
    Cipher -> (BotanStructT -> IO ()) -> IO ()
forall r. Cipher -> (BotanStructT -> IO r) -> IO r
withCipher Cipher
ci ((BotanStructT -> IO ()) -> IO ())
-> (BotanStructT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pci -> do
        Secret -> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall r. Secret -> (Ptr Word8 -> CSize -> IO r) -> IO r
withSecret Secret
key ((Ptr Word8 -> CSize -> IO ()) -> IO ())
-> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
pkey CSize
key_len -> do
            IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT -> Ptr Word8 -> CSize -> IO CInt
botan_cipher_set_key BotanStructT
pci Ptr Word8
pkey CSize
key_len)

-- | Do the encryption or decryption.
--
-- BE CAREFUL ON 'Nonce' handling! Some 'CipherMode's will fail if 'Nonce' is reused or not randomly enough.
runCipher :: HasCallStack
          => Cipher
          -> Nonce         -- ^ nonce
          -> V.Bytes       -- ^ input
          -> V.Bytes       -- ^ associated data, ignored if not an AEAD or empty
          -> IO V.Bytes
{-# INLINABLE runCipher #-}
runCipher :: Cipher -> Bytes -> Bytes -> Bytes -> IO Bytes
runCipher Cipher
ci Bytes
nonce Bytes
inp Bytes
ad =
    Cipher -> (BotanStructT -> IO Bytes) -> IO Bytes
forall r. Cipher -> (BotanStructT -> IO r) -> IO r
withCipher Cipher
ci ((BotanStructT -> IO Bytes) -> IO Bytes)
-> (BotanStructT -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pci -> do

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Cipher -> Int
cipherTagLength Cipher
ci Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (IO () -> IO ())
-> ((BA# Word8 -> Int -> Int -> IO ()) -> IO ())
-> (BA# Word8 -> Int -> Int -> IO ())
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
ad ((BA# Word8 -> Int -> Int -> IO ()) -> IO ())
-> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pad Int
ad_off Int
ad_len -> do
            IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT -> BA# Word8 -> Int -> Int -> IO CInt
hs_botan_cipher_set_associated_data
                BotanStructT
pci BA# Word8
pad Int
ad_off Int
ad_len)

        Bytes -> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
nonce ((BA# Word8 -> Int -> Int -> IO ()) -> IO ())
-> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pnonce Int
nonce_off Int
nonce_len ->
            IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT -> BA# Word8 -> Int -> Int -> IO CInt
hs_botan_cipher_start BotanStructT
pci BA# Word8
pnonce Int
nonce_off Int
nonce_len)

        Int
osiz <- BotanStructT -> Int -> IO Int
hs_botan_cipher_output_size BotanStructT
pci (Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
inp)

        (Bytes
out, Int
r) <- Int -> (MBA# BotanStructT -> IO Int) -> IO (Bytes, Int)
forall a b.
Prim a =>
Int -> (MBA# BotanStructT -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe Int
osiz ((MBA# BotanStructT -> IO Int) -> IO (Bytes, Int))
-> (MBA# BotanStructT -> IO Int) -> IO (Bytes, Int)
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
out ->
            Bytes -> (BA# Word8 -> Int -> Int -> IO Int) -> IO Int
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
inp ((BA# Word8 -> Int -> Int -> IO Int) -> IO Int)
-> (BA# Word8 -> Int -> Int -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pinp Int
inp_off Int
inp_len ->
                IO Int -> IO Int
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwBotanIfMinus (BotanStructT
-> MBA# BotanStructT -> Int -> BA# Word8 -> Int -> Int -> IO Int
hs_botan_cipher_finish BotanStructT
pci MBA# BotanStructT
out Int
osiz BA# Word8
pinp Int
inp_off Int
inp_len)

        Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes -> IO Bytes) -> Bytes -> IO Bytes
forall a b. (a -> b) -> a -> b
$! Int -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => Int -> v a -> v a
V.unsafeTake Int
r Bytes
out

--------------------------------------------------------------------------------

-- | In contrast to block ciphers, stream ciphers operate on a plaintext stream instead of blocks. Thus encrypting data results in changing the internal state of the cipher and encryption of plaintext with arbitrary length is possible in one go (in byte amounts).
data StreamCipherType
      -- | A cipher mode that converts a block cipher into a stream cipher.
      --  It offers parallel execution and can seek within the output stream, both useful properties.
    = CTR_BE BlockCipherType
      -- | Another stream cipher based on a block cipher.
      -- Unlike CTR mode, it does not allow parallel execution or seeking within the output stream. Prefer CTR.
    | OFB BlockCipherType
      -- | A very fast cipher, now widely deployed in TLS as part of the ChaCha20Poly1305 AEAD.
      -- Can be used with 8 (fast but dangerous), 12 (balance), or 20 rounds (conservative).
      -- Even with 20 rounds, ChaCha is very fast. Use 20 rounds.
    | ChaCha8
    | ChaCha12
    | ChaCha20
      -- | An earlier iteration of the ChaCha design,
      -- this cipher is popular due to its use in the libsodium library. Prefer ChaCha.
    | Salsa20
      -- | This is the SHAKE-128 XOF exposed as a stream cipher.
      -- It is slower than ChaCha and somewhat obscure.
      -- It does not support IVs or seeking within the cipher stream.
    | SHAKE128'
      -- | An old and very widely deployed stream cipher notable for its simplicity.
      -- It does not support IVs or seeking within the cipher stream.
      -- Warning: RC4 is now badly broken. Avoid in new code and use only if
      -- required for compatibility with existing systems.
    | RC4
  deriving (Int -> StreamCipherType -> ShowS
[StreamCipherType] -> ShowS
StreamCipherType -> String
(Int -> StreamCipherType -> ShowS)
-> (StreamCipherType -> String)
-> ([StreamCipherType] -> ShowS)
-> Show StreamCipherType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamCipherType] -> ShowS
$cshowList :: [StreamCipherType] -> ShowS
show :: StreamCipherType -> String
$cshow :: StreamCipherType -> String
showsPrec :: Int -> StreamCipherType -> ShowS
$cshowsPrec :: Int -> StreamCipherType -> ShowS
Show, ReadPrec [StreamCipherType]
ReadPrec StreamCipherType
Int -> ReadS StreamCipherType
ReadS [StreamCipherType]
(Int -> ReadS StreamCipherType)
-> ReadS [StreamCipherType]
-> ReadPrec StreamCipherType
-> ReadPrec [StreamCipherType]
-> Read StreamCipherType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StreamCipherType]
$creadListPrec :: ReadPrec [StreamCipherType]
readPrec :: ReadPrec StreamCipherType
$creadPrec :: ReadPrec StreamCipherType
readList :: ReadS [StreamCipherType]
$creadList :: ReadS [StreamCipherType]
readsPrec :: Int -> ReadS StreamCipherType
$creadsPrec :: Int -> ReadS StreamCipherType
Read, StreamCipherType -> StreamCipherType -> Bool
(StreamCipherType -> StreamCipherType -> Bool)
-> (StreamCipherType -> StreamCipherType -> Bool)
-> Eq StreamCipherType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamCipherType -> StreamCipherType -> Bool
$c/= :: StreamCipherType -> StreamCipherType -> Bool
== :: StreamCipherType -> StreamCipherType -> Bool
$c== :: StreamCipherType -> StreamCipherType -> Bool
Eq, Eq StreamCipherType
Eq StreamCipherType
-> (StreamCipherType -> StreamCipherType -> Ordering)
-> (StreamCipherType -> StreamCipherType -> Bool)
-> (StreamCipherType -> StreamCipherType -> Bool)
-> (StreamCipherType -> StreamCipherType -> Bool)
-> (StreamCipherType -> StreamCipherType -> Bool)
-> (StreamCipherType -> StreamCipherType -> StreamCipherType)
-> (StreamCipherType -> StreamCipherType -> StreamCipherType)
-> Ord StreamCipherType
StreamCipherType -> StreamCipherType -> Bool
StreamCipherType -> StreamCipherType -> Ordering
StreamCipherType -> StreamCipherType -> StreamCipherType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StreamCipherType -> StreamCipherType -> StreamCipherType
$cmin :: StreamCipherType -> StreamCipherType -> StreamCipherType
max :: StreamCipherType -> StreamCipherType -> StreamCipherType
$cmax :: StreamCipherType -> StreamCipherType -> StreamCipherType
>= :: StreamCipherType -> StreamCipherType -> Bool
$c>= :: StreamCipherType -> StreamCipherType -> Bool
> :: StreamCipherType -> StreamCipherType -> Bool
$c> :: StreamCipherType -> StreamCipherType -> Bool
<= :: StreamCipherType -> StreamCipherType -> Bool
$c<= :: StreamCipherType -> StreamCipherType -> Bool
< :: StreamCipherType -> StreamCipherType -> Bool
$c< :: StreamCipherType -> StreamCipherType -> Bool
compare :: StreamCipherType -> StreamCipherType -> Ordering
$ccompare :: StreamCipherType -> StreamCipherType -> Ordering
$cp1Ord :: Eq StreamCipherType
Ord, (forall x. StreamCipherType -> Rep StreamCipherType x)
-> (forall x. Rep StreamCipherType x -> StreamCipherType)
-> Generic StreamCipherType
forall x. Rep StreamCipherType x -> StreamCipherType
forall x. StreamCipherType -> Rep StreamCipherType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StreamCipherType x -> StreamCipherType
$cfrom :: forall x. StreamCipherType -> Rep StreamCipherType x
Generic)
  deriving anyclass (Int -> StreamCipherType -> Builder ()
(Int -> StreamCipherType -> Builder ()) -> Print StreamCipherType
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> StreamCipherType -> Builder ()
$ctoUTF8BuilderP :: Int -> StreamCipherType -> Builder ()
T.Print, Value -> Converter StreamCipherType
StreamCipherType -> Value
StreamCipherType -> Builder ()
(Value -> Converter StreamCipherType)
-> (StreamCipherType -> Value)
-> (StreamCipherType -> Builder ())
-> JSON StreamCipherType
forall a.
(Value -> Converter a)
-> (a -> Value) -> (a -> Builder ()) -> JSON a
encodeJSON :: StreamCipherType -> Builder ()
$cencodeJSON :: StreamCipherType -> Builder ()
toValue :: StreamCipherType -> Value
$ctoValue :: StreamCipherType -> Value
fromValue :: Value -> Converter StreamCipherType
$cfromValue :: Value -> Converter StreamCipherType
JSON)

-- | A Botan stream cipher.
data StreamCipher = StreamCipher
    { StreamCipher -> BotanStruct
streamCipher                  :: {-# UNPACK #-} !BotanStruct
    , StreamCipher -> CBytes
streamCipherName              :: {-# UNPACK #-} !CBytes        -- ^ cipher algo name
    , StreamCipher -> KeySpec
streamCipherKeySpec           :: {-# UNPACK #-} !KeySpec       -- ^ cipher keyspec
    , StreamCipher -> Int
defaultIVLength               :: {-# UNPACK #-} !Int           -- ^ a proper default IV length.
    }
    deriving (Int -> StreamCipher -> ShowS
[StreamCipher] -> ShowS
StreamCipher -> String
(Int -> StreamCipher -> ShowS)
-> (StreamCipher -> String)
-> ([StreamCipher] -> ShowS)
-> Show StreamCipher
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamCipher] -> ShowS
$cshowList :: [StreamCipher] -> ShowS
show :: StreamCipher -> String
$cshow :: StreamCipher -> String
showsPrec :: Int -> StreamCipher -> ShowS
$cshowsPrec :: Int -> StreamCipher -> ShowS
Show, (forall x. StreamCipher -> Rep StreamCipher x)
-> (forall x. Rep StreamCipher x -> StreamCipher)
-> Generic StreamCipher
forall x. Rep StreamCipher x -> StreamCipher
forall x. StreamCipher -> Rep StreamCipher x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StreamCipher x -> StreamCipher
$cfrom :: forall x. StreamCipher -> Rep StreamCipher x
Generic)
    deriving anyclass Int -> StreamCipher -> Builder ()
(Int -> StreamCipher -> Builder ()) -> Print StreamCipher
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> StreamCipher -> Builder ()
$ctoUTF8BuilderP :: Int -> StreamCipher -> Builder ()
T.Print

withStreamCipher :: StreamCipher -> (BotanStructT -> IO r) -> IO r
{-# INLINE withStreamCipher #-}
withStreamCipher :: StreamCipher -> (BotanStructT -> IO r) -> IO r
withStreamCipher (StreamCipher BotanStruct
sci CBytes
_ KeySpec
_ Int
_) = BotanStruct -> (BotanStructT -> IO r) -> IO r
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
sci

streamCipherTypeToCBytes :: StreamCipherType -> CBytes
{-# INLINABLE streamCipherTypeToCBytes #-}
streamCipherTypeToCBytes :: StreamCipherType -> CBytes
streamCipherTypeToCBytes StreamCipherType
s = case StreamCipherType
s of
    CTR_BE BlockCipherType
b  -> [CBytes] -> CBytes
CB.concat [CBytes
"CTR-BE(", BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
b, CBytes
")"]
    OFB BlockCipherType
b     -> [CBytes] -> CBytes
CB.concat [CBytes
"OFB(", BlockCipherType -> CBytes
blockCipherTypeToCBytes BlockCipherType
b, CBytes
")"]
    StreamCipherType
ChaCha8   -> CBytes
"ChaCha(8)"
    StreamCipherType
ChaCha12  -> CBytes
"ChaCha(12)"
    StreamCipherType
ChaCha20  -> CBytes
"ChaCha(20)"
    StreamCipherType
Salsa20   -> CBytes
"Salsa20"
    StreamCipherType
SHAKE128' ->  CBytes
"SHAKE-128"
    StreamCipherType
RC4       -> CBytes
"RC4"

-- | Create a new stream cipher.
--
-- A stream cipher is a symmetric key cipher where plaintext digits are combined with a pseudorandom cipher digit stream (keystream).
-- In a stream cipher, each plaintext digit is encrypted one at a time with the corresponding digit of the keystream, to give a digit of the ciphertext stream.
-- Since encryption of each digit is dependent on the current state of the cipher, it is also known as state cipher.
-- In practice, a digit is typically a bit and the combining operation is an exclusive-or (XOR).
--
newStreamCipher :: HasCallStack => StreamCipherType -> IO StreamCipher
{-# INLINABLE newStreamCipher #-}
newStreamCipher :: StreamCipherType -> IO StreamCipher
newStreamCipher StreamCipherType
typ = do
    let name :: CBytes
name = StreamCipherType -> CBytes
streamCipherTypeToCBytes StreamCipherType
typ
    BotanStruct
ci <- (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
        (\ MBA# BotanStructT
bts -> CBytes -> (BA# Word8 -> IO CInt) -> IO CInt
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
name (MBA# BotanStructT -> BA# Word8 -> IO CInt
botan_stream_cipher_init MBA# BotanStructT
bts))
        FunPtr (BotanStructT -> IO ())
botan_stream_cipher_destroy

    BotanStruct -> (BotanStructT -> IO StreamCipher) -> IO StreamCipher
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
ci ((BotanStructT -> IO StreamCipher) -> IO StreamCipher)
-> (BotanStructT -> IO StreamCipher) -> IO StreamCipher
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pci -> do

        (Int
a, (Int
b, (Int
c, ()
_))) <- (MBA# BotanStructT -> IO (Int, (Int, ())))
-> IO (Int, (Int, (Int, ())))
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# BotanStructT -> IO (Int, (Int, ())))
 -> IO (Int, (Int, (Int, ()))))
-> (MBA# BotanStructT -> IO (Int, (Int, ())))
-> IO (Int, (Int, (Int, ())))
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pa ->
            (MBA# BotanStructT -> IO (Int, ())) -> IO (Int, (Int, ()))
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# BotanStructT -> IO (Int, ())) -> IO (Int, (Int, ())))
-> (MBA# BotanStructT -> IO (Int, ())) -> IO (Int, (Int, ()))
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pb ->
                (MBA# BotanStructT -> IO ()) -> IO (Int, ())
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# BotanStructT -> IO ()) -> IO (Int, ()))
-> (MBA# BotanStructT -> IO ()) -> IO (Int, ())
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pc ->
                    IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_
                        (BotanStructT
-> MBA# BotanStructT
-> MBA# BotanStructT
-> MBA# BotanStructT
-> IO CInt
botan_stream_cipher_get_keyspec BotanStructT
pci MBA# BotanStructT
pa MBA# BotanStructT
pb MBA# BotanStructT
pc)

        (Int
n, CInt
_) <- (MBA# BotanStructT -> IO CInt) -> IO (Int, CInt)
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# BotanStructT -> IO CInt) -> IO (Int, CInt))
-> (MBA# BotanStructT -> IO CInt) -> IO (Int, CInt)
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pn ->
            BotanStructT -> MBA# BotanStructT -> IO CInt
botan_stream_cipher_get_default_iv_length BotanStructT
pci MBA# BotanStructT
pn

        StreamCipher -> IO StreamCipher
forall (m :: * -> *) a. Monad m => a -> m a
return (BotanStruct -> CBytes -> KeySpec -> Int -> StreamCipher
StreamCipher BotanStruct
ci CBytes
name (Int -> Int -> Int -> KeySpec
KeySpec Int
a Int
b Int
c) Int
n)

-- | Set the key for the 'StreamCipher' object
--
setStreamCipherKey :: HasCallStack => StreamCipher -> Secret -> IO ()
{-# INLINABLE setStreamCipherKey #-}
setStreamCipherKey :: StreamCipher -> Secret -> IO ()
setStreamCipherKey StreamCipher
ci Secret
key =
    StreamCipher -> (BotanStructT -> IO ()) -> IO ()
forall r. StreamCipher -> (BotanStructT -> IO r) -> IO r
withStreamCipher StreamCipher
ci ((BotanStructT -> IO ()) -> IO ())
-> (BotanStructT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pci ->
    Secret -> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall r. Secret -> (Ptr Word8 -> CSize -> IO r) -> IO r
withSecret Secret
key ((Ptr Word8 -> CSize -> IO ()) -> IO ())
-> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
pkey CSize
key_len ->
        IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT -> Ptr Word8 -> CSize -> IO CInt
botan_stream_cipher_set_key BotanStructT
pci Ptr Word8
pkey CSize
key_len)

-- | Set the initail vector for a 'StreamCipher'.
setStreamCipherIV :: StreamCipher -> Nonce -> IO ()
{-# INLINABLE setStreamCipherIV #-}
setStreamCipherIV :: StreamCipher -> Bytes -> IO ()
setStreamCipherIV StreamCipher
sc Bytes
nonce =
    StreamCipher -> (BotanStructT -> IO ()) -> IO ()
forall r. StreamCipher -> (BotanStructT -> IO r) -> IO r
withStreamCipher StreamCipher
sc ((BotanStructT -> IO ()) -> IO ())
-> (BotanStructT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
psc ->
    Bytes -> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
nonce ((BA# Word8 -> Int -> Int -> IO ()) -> IO ())
-> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
n Int
noff Int
nlen ->
        IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanStructT -> BA# Word8 -> Int -> Int -> IO CInt
hs_botan_stream_cipher_set_iv BotanStructT
psc BA# Word8
n Int
noff Int
nlen

-- | Clear the internal state (such as keys) of this cipher object.
--
clearStreamCipher :: HasCallStack => StreamCipher -> IO ()
{-# INLINABLE clearStreamCipher #-}
clearStreamCipher :: StreamCipher -> IO ()
clearStreamCipher StreamCipher
ci = StreamCipher -> (BotanStructT -> IO ()) -> IO ()
forall r. StreamCipher -> (BotanStructT -> IO r) -> IO r
withStreamCipher StreamCipher
ci (IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (IO CInt -> IO ())
-> (BotanStructT -> IO CInt) -> BotanStructT -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotanStructT -> IO CInt
botan_stream_cipher_clear)

-- | Seek 'StreamCipher' 's state to given offset.
seekStreamCipher :: StreamCipher -> Int -> IO ()
{-# INLINABLE seekStreamCipher #-}
seekStreamCipher :: StreamCipher -> Int -> IO ()
seekStreamCipher StreamCipher
sc Int
off =
    StreamCipher -> (BotanStructT -> IO ()) -> IO ()
forall r. StreamCipher -> (BotanStructT -> IO r) -> IO r
withStreamCipher StreamCipher
sc ((BotanStructT -> IO ()) -> IO ())
-> (BotanStructT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
psc ->
        IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanStructT -> CSize -> IO CInt
botan_stream_cipher_seek BotanStructT
psc (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off)

-- | Update cipher with some data.
--
-- Since stream ciphers work by XOR data, encryption and decryption are the same process.
runStreamCipher :: HasCallStack
                   => StreamCipher
                   -> V.Bytes
                   -> IO V.Bytes        -- ^ trailing input, output
{-# INLINABLE runStreamCipher #-}
runStreamCipher :: StreamCipher -> Bytes -> IO Bytes
runStreamCipher StreamCipher
sci Bytes
input =
    StreamCipher -> (BotanStructT -> IO Bytes) -> IO Bytes
forall r. StreamCipher -> (BotanStructT -> IO r) -> IO r
withStreamCipher StreamCipher
sci ((BotanStructT -> IO Bytes) -> IO Bytes)
-> (BotanStructT -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pci -> do
        Bytes -> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
input ((BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes)
-> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
in_p Int
in_off Int
in_len -> do
            (Bytes
out, CInt
_) <- Int -> (MBA# BotanStructT -> IO CInt) -> IO (Bytes, CInt)
forall a b.
Prim a =>
Int -> (MBA# BotanStructT -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe Int
in_len ((MBA# BotanStructT -> IO CInt) -> IO (Bytes, CInt))
-> (MBA# BotanStructT -> IO CInt) -> IO (Bytes, CInt)
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
out_p ->
                IO CInt -> IO CInt
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwBotanIfMinus (BotanStructT
-> MBA# BotanStructT -> BA# Word8 -> Int -> Int -> IO CInt
hs_botan_stream_cipher_cipher BotanStructT
pci
                    MBA# BotanStructT
out_p BA# Word8
in_p Int
in_off Int
in_len)
            Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
out

-- | Export 'StreamCipher' 's key stream for other usage.
--
streamCipherKeyStream :: HasCallStack
                      => StreamCipher
                      -> Int
                      -> IO V.Bytes
{-# INLINABLE streamCipherKeyStream #-}
streamCipherKeyStream :: StreamCipher -> Int -> IO Bytes
streamCipherKeyStream StreamCipher
sci Int
siz =
    StreamCipher -> (BotanStructT -> IO Bytes) -> IO Bytes
forall r. StreamCipher -> (BotanStructT -> IO r) -> IO r
withStreamCipher StreamCipher
sci ((BotanStructT -> IO Bytes) -> IO Bytes)
-> (BotanStructT -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pci -> do
        (Bytes
pa, CInt
_) <- Int -> (MBA# BotanStructT -> IO CInt) -> IO (Bytes, CInt)
forall a b.
Prim a =>
Int -> (MBA# BotanStructT -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe Int
siz ((MBA# BotanStructT -> IO CInt) -> IO (Bytes, CInt))
-> (MBA# BotanStructT -> IO CInt) -> IO (Bytes, CInt)
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
out_p -> do
            IO CInt -> IO CInt
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwBotanIfMinus (BotanStructT -> MBA# BotanStructT -> CSize -> IO CInt
botan_stream_cipher_write_keystream BotanStructT
pci MBA# BotanStructT
out_p (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz))
        Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
pa

-- | Wrap a 'StreamCipher' into a 'BIO' node(experimental).
--
-- The cipher should have already started by setting key, iv, etc,
-- for example to encrypt a file in constant memory using AES with CTR mode:
--
-- @
-- import Z.Data.CBytes (CBytes)
-- import Z.IO.BIO
-- import Z.IO
-- import Z.Crypto.Cipher
--
-- -- | encryption and decryption are the same process.
-- cipherFile :: CBytes -> CBytes -> IO ()
-- cipherFile origin target = do
--     let demoKey = "12345678123456781234567812345678"
--         iv = "demo only !!!!!!"
--     cipher <- newStreamCipher (CTR_BE AES256)
--     setStreamCipherKey cipher demoKey
--     setStreamCipherIV cipher iv
--
--     withResource (initSourceFromFile origin) $ \\ src ->
--         withResource (initSinkToFile target) $ \\ sink ->
--             runBIO_ $ src . streamCipherBIO cipher . sink
-- @
--
-- Note that many cipher modes have a maximum length limit on the plaintext under a security context,
-- i.e. a key nonce combination. If you want to encrypt a large message, please consider divide it into
-- smaller chunks, and re-key or change the iv.
streamCipherBIO :: HasCallStack => StreamCipher -> BIO V.Bytes V.Bytes
{-# INLINABLE streamCipherBIO #-}
streamCipherBIO :: StreamCipher -> BIO Bytes Bytes
streamCipherBIO StreamCipher
c = \ Maybe Bytes -> IO ()
k Maybe Bytes
mbs -> case Maybe Bytes
mbs of
    Just Bytes
chunk -> Maybe Bytes -> IO ()
k (Maybe Bytes -> IO ()) -> (Bytes -> Maybe Bytes) -> Bytes -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just (Bytes -> IO ()) -> IO Bytes -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HasCallStack => StreamCipher -> Bytes -> IO Bytes
StreamCipher -> Bytes -> IO Bytes
runStreamCipher StreamCipher
c Bytes
chunk
    Maybe Bytes
_ -> Maybe Bytes -> IO ()
k Maybe Bytes
forall a. Maybe a
EOF

-- | Turn a 'StreamCipher' into a key stream source.
--
keyStreamSource :: HasCallStack
                => StreamCipher
                -> Int              -- ^ each chunk size
                -> Source V.Bytes
{-# INLINABLE keyStreamSource #-}
keyStreamSource :: StreamCipher -> Int -> Source Bytes
keyStreamSource StreamCipher
c Int
cs = \ Maybe Bytes -> IO ()
k Maybe Void
_ -> Maybe Bytes -> IO ()
k (Maybe Bytes -> IO ()) -> (Bytes -> Maybe Bytes) -> Bytes -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just (Bytes -> IO ()) -> IO Bytes -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HasCallStack => StreamCipher -> Int -> IO Bytes
StreamCipher -> Int -> IO Bytes
streamCipherKeyStream StreamCipher
c Int
cs