{-|
Module      : Botan.Low.BlockCipher
Description : Raw Block Cipher (PRP) interface
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : leo@apotheca.io
Stability   : experimental
Portability : POSIX

This is a ‘raw’ interface to ECB mode block ciphers.
Most applications want the higher level cipher API which provides authenticated encryption.
This API exists as an escape hatch for applications which need to implement custom primitives using a PRP.
-}

module Botan.Low.BlockCipher
(

-- * Block ciphers
-- $introduction

-- * Usage
-- $usage

  BlockCipher(..)
, BlockCipherName(..)
, BlockCipher128Name(..)
, BlockCipherKey(..)
, BlockCipherCiphertext(..)
, withBlockCipher
, blockCipherInit
, blockCipherDestroy
, blockCipherName
, blockCipherBlockSize
, blockCipherGetKeyspec
, blockCipherSetKey
, blockCipherEncryptBlocks
, blockCipherDecryptBlocks
, blockCipherClear

-- * 64-bit block ciphers

, pattern Blowfish
, pattern CAST128
, pattern DES
, pattern TripleDES
, pattern GOST_28147_89
, pattern IDEA

-- * 128-bit block ciphers

, pattern AES128
, pattern AES192
, pattern AES256
, pattern ARIA128
, pattern ARIA192
, pattern ARIA256
, pattern Camellia128
, pattern Camellia192
, pattern Camellia256
, pattern Noekeon
, pattern SEED
, pattern SM4
, pattern Serpent
, pattern Twofish

-- * 256-bit block ciphers

, pattern SHACAL2

-- * 512-bit block ciphers

, pattern Threefish512

-- * Convenience

, blockCiphers
, blockCipher128s
, allBlockCiphers

) where

import qualified Data.ByteString as ByteString

import Botan.Bindings.BlockCipher

import Botan.Low.Error
import Botan.Low.Make
import Botan.Low.Prelude
import Botan.Low.Remake

{- $introduction

A `block cipher` is a deterministic, cryptographic primitive suitable for
encrypting or decrypting a single, fixed-size block of data at a time. Block
ciphers are used as building blocks for more complex cryptographic operations.
If you are looking to encrypt user data, you are probably looking for
`Botan.Low.Cipher` instead.

-}

{- $usage

Unless you need a specific block cipher, it is strongly recommended that you use the `AES256` algorithm.

> import Botan.Low.BlockCipher
> blockCipher <- blockCipherInit AES256

To use a block cipher, we first need to generate (if we haven't already) a secret key.

> import Botan.Low.RNG
> rng <- rngInit "user"
> -- We will use the maximum key size; AES256 keys are always 16 bytes
> (_,keySize,_) <- blockCipherGetKeyspec blockCipher
> -- Block cipher keys are randomly generated
> key <- rngGet rng keySize

After the key is generated, we must set it as the block cipher key:

> blockCipherSetKey blockCipher key

To encrypt a message, it must be a multiple of the block size.

> blockSize <- blockCipherBlockSize blockCipher
> -- AES256 block size is always 16 bytes
> message = "0000DEADBEEF0000" :: ByteString
> ciphertext <- blockCipherEncryptBlocks blockCipher message

To decrypt a message, simply reverse the process:

> plaintext <- blockCipherDecryptBlocks blockCipher ciphertext
> message == plaintext -- True

-}

-- | A mutable block cipher object
newtype BlockCipher = MkBlockCipher { BlockCipher -> ForeignPtr BotanBlockCipherStruct
getBlockCipherForeignPtr :: ForeignPtr BotanBlockCipherStruct }

newBlockCipher      :: BotanBlockCipher -> IO BlockCipher
withBlockCipher     :: BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
-- | Destroy a block cipher object immediately
blockCipherDestroy  :: BlockCipher -> IO ()
createBlockCipher   :: (Ptr BotanBlockCipher -> IO CInt) -> IO BlockCipher
(BotanBlockCipher -> IO BlockCipher
newBlockCipher, BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
withBlockCipher, BlockCipher -> IO ()
blockCipherDestroy, (Ptr BotanBlockCipher -> IO CInt) -> IO BlockCipher
createBlockCipher, (Ptr BotanBlockCipher -> Ptr CSize -> IO CInt) -> IO [BlockCipher]
_)
    = (Ptr BotanBlockCipherStruct -> BotanBlockCipher)
-> (BotanBlockCipher -> Ptr BotanBlockCipherStruct)
-> (ForeignPtr BotanBlockCipherStruct -> BlockCipher)
-> (BlockCipher -> ForeignPtr BotanBlockCipherStruct)
-> FinalizerPtr BotanBlockCipherStruct
-> (BotanBlockCipher -> IO BlockCipher,
    BlockCipher -> (BotanBlockCipher -> IO a) -> IO a,
    BlockCipher -> IO (),
    (Ptr BotanBlockCipher -> IO CInt) -> IO BlockCipher,
    (Ptr BotanBlockCipher -> Ptr CSize -> IO CInt) -> IO [BlockCipher])
forall botan struct object a.
Storable botan =>
(Ptr struct -> botan)
-> (botan -> Ptr struct)
-> (ForeignPtr struct -> object)
-> (object -> ForeignPtr struct)
-> FinalizerPtr struct
-> (botan -> IO object, object -> (botan -> IO a) -> IO a,
    object -> IO (), (Ptr botan -> IO CInt) -> IO object,
    (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object])
mkBindings
        Ptr BotanBlockCipherStruct -> BotanBlockCipher
MkBotanBlockCipher BotanBlockCipher -> Ptr BotanBlockCipherStruct
runBotanBlockCipher
        ForeignPtr BotanBlockCipherStruct -> BlockCipher
MkBlockCipher BlockCipher -> ForeignPtr BotanBlockCipherStruct
getBlockCipherForeignPtr
        FinalizerPtr BotanBlockCipherStruct
botan_block_cipher_destroy

-- | 128-bit block cipher name type
type BlockCipher128Name = BlockCipherName

pattern AES128
    ,   AES192
    ,   AES256
    ,   ARIA128
    ,   ARIA192
    ,   ARIA256
    ,   Camellia128
    ,   Camellia192
    ,   Camellia256
    ,   Noekeon
    ,   SEED
    ,   SM4
    ,   Serpent
    ,   Twofish
    :: BlockCipher128Name

pattern $mAES128 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bAES128 :: BlockCipherName
AES128      = BOTAN_BLOCK_CIPHER_128_AES_128
pattern $mAES192 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bAES192 :: BlockCipherName
AES192      = BOTAN_BLOCK_CIPHER_128_AES_192
pattern $mAES256 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bAES256 :: BlockCipherName
AES256      = BOTAN_BLOCK_CIPHER_128_AES_256
pattern $mARIA128 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bARIA128 :: BlockCipherName
ARIA128     = BOTAN_BLOCK_CIPHER_128_ARIA_128
pattern $mARIA192 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bARIA192 :: BlockCipherName
ARIA192     = BOTAN_BLOCK_CIPHER_128_ARIA_192
pattern $mARIA256 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bARIA256 :: BlockCipherName
ARIA256     = BOTAN_BLOCK_CIPHER_128_ARIA_256
pattern $mCamellia128 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bCamellia128 :: BlockCipherName
Camellia128 = BOTAN_BLOCK_CIPHER_128_CAMELLIA_128
pattern $mCamellia192 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bCamellia192 :: BlockCipherName
Camellia192 = BOTAN_BLOCK_CIPHER_128_CAMELLIA_192
pattern $mCamellia256 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bCamellia256 :: BlockCipherName
Camellia256 = BOTAN_BLOCK_CIPHER_128_CAMELLIA_256
pattern $mNoekeon :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bNoekeon :: BlockCipherName
Noekeon     = BOTAN_BLOCK_CIPHER_128_NOEKEON
pattern $mSEED :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSEED :: BlockCipherName
SEED        = BOTAN_BLOCK_CIPHER_128_SEED
pattern $mSM4 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSM4 :: BlockCipherName
SM4         = BOTAN_BLOCK_CIPHER_128_SM4
pattern $mSerpent :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSerpent :: BlockCipherName
Serpent     = BOTAN_BLOCK_CIPHER_128_SERPENT
pattern $mTwofish :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bTwofish :: BlockCipherName
Twofish     = BOTAN_BLOCK_CIPHER_128_TWOFISH

blockCipher128s :: [BlockCipherName]
blockCipher128s =
    [ BlockCipherName
AES128
    , BlockCipherName
AES192
    , BlockCipherName
AES256
    , BlockCipherName
ARIA128
    , BlockCipherName
ARIA192
    , BlockCipherName
ARIA256
    , BlockCipherName
Camellia128
    , BlockCipherName
Camellia192
    , BlockCipherName
Camellia256
    , BlockCipherName
Noekeon
    , BlockCipherName
SEED
    , BlockCipherName
SM4
    , BlockCipherName
Serpent
    , BlockCipherName
Twofish
    ]

-- | Block cipher name type
type BlockCipherName = ByteString

pattern Blowfish
    ,   CAST128
    ,   DES
    ,   TripleDES
    ,   GOST_28147_89
    ,   IDEA
    ,   SHACAL2
    ,   Threefish512
    :: BlockCipherName

pattern $mBlowfish :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bBlowfish :: BlockCipherName
Blowfish        = BOTAN_BLOCK_CIPHER_BLOWFISH
pattern $mCAST128 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bCAST128 :: BlockCipherName
CAST128         = BOTAN_BLOCK_CIPHER_CAST_128
pattern $mDES :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bDES :: BlockCipherName
DES             = BOTAN_BLOCK_CIPHER_DES
pattern $mTripleDES :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bTripleDES :: BlockCipherName
TripleDES       = BOTAN_BLOCK_CIPHER_TRIPLEDES
pattern $mGOST_28147_89 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bGOST_28147_89 :: BlockCipherName
GOST_28147_89   = BOTAN_BLOCK_CIPHER_GOST_28147_89
pattern $mIDEA :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bIDEA :: BlockCipherName
IDEA            = BOTAN_BLOCK_CIPHER_IDEA
pattern $mSHACAL2 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHACAL2 :: BlockCipherName
SHACAL2         = BOTAN_BLOCK_CIPHER_SHACAL2
pattern $mThreefish512 :: forall {r}. BlockCipherName -> ((# #) -> r) -> ((# #) -> r) -> r
$bThreefish512 :: BlockCipherName
Threefish512    = BOTAN_BLOCK_CIPHER_THREEFISH_512

blockCiphers :: [BlockCipherName]
blockCiphers =
    [ BlockCipherName
Blowfish
    , BlockCipherName
CAST128
    , BlockCipherName
DES
    , BlockCipherName
TripleDES
    , BlockCipherName
GOST_28147_89
    , BlockCipherName
IDEA
    , BlockCipherName
SHACAL2
    , BlockCipherName
Threefish512
    ]

allBlockCiphers :: [BlockCipherName]
allBlockCiphers :: [BlockCipherName]
allBlockCiphers = [BlockCipherName]
blockCipher128s [BlockCipherName] -> [BlockCipherName] -> [BlockCipherName]
forall a. [a] -> [a] -> [a]
++ [BlockCipherName]
blockCiphers

-- | A block cipher secret key
type BlockCipherKey = ByteString

-- | A block cipher ciphertext
type BlockCipherCiphertext = ByteString
    
-- | Initialize a block cipher object
blockCipherInit
    :: BlockCipherName  -- ^ __cipher_name__
    -> IO BlockCipher   -- ^ __bc__
blockCipherInit :: BlockCipherName -> IO BlockCipher
blockCipherInit = ((Ptr BotanBlockCipher -> IO CInt) -> IO BlockCipher)
-> (Ptr BotanBlockCipher -> ConstPtr CChar -> IO CInt)
-> BlockCipherName
-> IO BlockCipher
forall botan object.
((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> ConstPtr CChar -> IO CInt)
-> BlockCipherName
-> IO object
mkCreateObjectCString (Ptr BotanBlockCipher -> IO CInt) -> IO BlockCipher
createBlockCipher Ptr BotanBlockCipher -> ConstPtr CChar -> IO CInt
botan_block_cipher_init

-- WARNING: withFooInit-style limited lifetime functions moved to high-level botan
withBlockCipherInit :: BlockCipherName -> (BlockCipher -> IO a) -> IO a
withBlockCipherInit :: forall a. BlockCipherName -> (BlockCipher -> IO a) -> IO a
withBlockCipherInit = (BlockCipherName -> IO BlockCipher)
-> (BlockCipher -> IO ())
-> BlockCipherName
-> (BlockCipher -> IO a)
-> IO a
forall x t a.
(x -> IO t) -> (t -> IO ()) -> x -> (t -> IO a) -> IO a
mkWithTemp1 BlockCipherName -> IO BlockCipher
blockCipherInit BlockCipher -> IO ()
blockCipherDestroy

{- |
Reinitializes a block cipher

You must call blockCipherSetKey in order to use the block cipher again.
-}
blockCipherClear
    :: BlockCipher  -- ^ __bc__: The cipher object
    -> IO ()
blockCipherClear :: BlockCipher -> IO ()
blockCipherClear = (forall a. BlockCipher -> (BotanBlockCipher -> IO a) -> IO a)
-> (BotanBlockCipher -> IO CInt) -> BlockCipher -> IO ()
forall object botan.
(forall a. object -> (botan -> IO a) -> IO a)
-> (botan -> IO CInt) -> object -> IO ()
mkWithObjectAction BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
forall a. BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
withBlockCipher BotanBlockCipher -> IO CInt
botan_block_cipher_clear

{- |
Set the key for a block cipher

Throws an error if the key is not valid.
-}
blockCipherSetKey
    :: BlockCipher      -- ^ __bc__: The cipher object
    -> BlockCipherKey   -- ^ __key[]__: A cipher key
    -> IO ()
blockCipherSetKey :: BlockCipher -> BlockCipherName -> IO ()
blockCipherSetKey = (forall a. BlockCipher -> (BotanBlockCipher -> IO a) -> IO a)
-> SetBytesLen BotanBlockCipher
-> BlockCipher
-> BlockCipherName
-> IO ()
forall typ ptr.
WithPtr typ ptr
-> SetBytesLen ptr -> typ -> BlockCipherName -> IO ()
mkSetBytesLen BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
forall a. BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
withBlockCipher (\ BotanBlockCipher
cipher Ptr Word8
key -> BotanBlockCipher -> ConstPtr Word8 -> CSize -> IO CInt
botan_block_cipher_set_key BotanBlockCipher
cipher (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
key))

-- | Return the block size of a block cipher.
blockCipherBlockSize
    :: BlockCipher  -- ^ __bc__: The cipher object
    -> IO Int
blockCipherBlockSize :: BlockCipher -> IO Int
blockCipherBlockSize = (forall a. BlockCipher -> (BotanBlockCipher -> IO a) -> IO a)
-> (BotanBlockCipher -> IO CInt) -> BlockCipher -> IO Int
forall typ ptr. WithPtr typ ptr -> GetIntCode ptr -> typ -> IO Int
mkGetIntCode BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
forall a. BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
withBlockCipher BotanBlockCipher -> IO CInt
botan_block_cipher_block_size

{- |
Encrypt one or more blocks with a block cipher

The plaintext length should be a multiple of the block size.
-}
blockCipherEncryptBlocks
    :: BlockCipher              -- ^ __bc__: The cipher object
    -> ByteString               -- ^ __in[]__: The plaintext
    -> IO BlockCipherCiphertext -- ^ __out[]__: The ciphertext
blockCipherEncryptBlocks :: BlockCipher -> BlockCipherName -> IO BlockCipherName
blockCipherEncryptBlocks BlockCipher
blockCipher BlockCipherName
bytes = BlockCipher
-> (BotanBlockCipher -> IO BlockCipherName) -> IO BlockCipherName
forall a. BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
withBlockCipher BlockCipher
blockCipher ((BotanBlockCipher -> IO BlockCipherName) -> IO BlockCipherName)
-> (BotanBlockCipher -> IO BlockCipherName) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ BotanBlockCipher
blockCipherPtr -> do
    BlockCipherName
-> (Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName
forall byte a.
BlockCipherName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen BlockCipherName
bytes ((Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName)
-> (Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
bytesPtr CSize
bytesLen -> do
        Int -> (Ptr Word8 -> IO ()) -> IO BlockCipherName
forall byte. Int -> (Ptr byte -> IO ()) -> IO BlockCipherName
allocBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
bytesLen) ((Ptr Word8 -> IO ()) -> IO BlockCipherName)
-> (Ptr Word8 -> IO ()) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
destPtr -> do
            HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanBlockCipher -> ConstPtr Word8 -> Ptr Word8 -> CSize -> IO CInt
botan_block_cipher_encrypt_blocks
                BotanBlockCipher
blockCipherPtr
                (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
bytesPtr)
                Ptr Word8
destPtr
                CSize
bytesLen
{-# WARNING blockCipherEncryptBlocks "The plaintext length should be a multiple of the block size." #-}

{- |
Decrypt one or more blocks with a block cipher.

The ciphertext length should be a multiple of the block size.

If an incorrect key was set, the content of the decrypted plaintext is unspecified.
-}
blockCipherDecryptBlocks
    :: BlockCipher              -- ^ __bc__: The cipher object
    -> BlockCipherCiphertext    -- ^ __in[]__: The ciphertext
    -> IO ByteString            -- ^ __out[]__: The plaintext
blockCipherDecryptBlocks :: BlockCipher -> BlockCipherName -> IO BlockCipherName
blockCipherDecryptBlocks BlockCipher
blockCipher BlockCipherName
bytes = BlockCipher
-> (BotanBlockCipher -> IO BlockCipherName) -> IO BlockCipherName
forall a. BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
withBlockCipher BlockCipher
blockCipher ((BotanBlockCipher -> IO BlockCipherName) -> IO BlockCipherName)
-> (BotanBlockCipher -> IO BlockCipherName) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ BotanBlockCipher
blockCipherPtr -> do
    BlockCipherName
-> (Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName
forall byte a.
BlockCipherName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen BlockCipherName
bytes ((Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName)
-> (Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
bytesPtr CSize
bytesLen -> do
        Int -> (Ptr Word8 -> IO ()) -> IO BlockCipherName
forall byte. Int -> (Ptr byte -> IO ()) -> IO BlockCipherName
allocBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
bytesLen) ((Ptr Word8 -> IO ()) -> IO BlockCipherName)
-> (Ptr Word8 -> IO ()) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
destPtr -> do
            HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanBlockCipher -> ConstPtr Word8 -> Ptr Word8 -> CSize -> IO CInt
botan_block_cipher_decrypt_blocks
                BotanBlockCipher
blockCipherPtr
                (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
bytesPtr)
                Ptr Word8
destPtr
                CSize
bytesLen
{-# WARNING blockCipherDecryptBlocks "The ciphertext length should be a multiple of the block size." #-}

{- |
Get the name of a block cipher.

This function is not guaranteed to return the same exact value as used to initialize the context.
-}
blockCipherName
    :: BlockCipher          -- ^ __bc__
    -> IO BlockCipherName   -- ^ __name__
blockCipherName :: BlockCipher -> IO BlockCipherName
blockCipherName = (forall a. BlockCipher -> (BotanBlockCipher -> IO a) -> IO a)
-> GetCString BotanBlockCipher CChar
-> BlockCipher
-> IO BlockCipherName
forall typ ptr byte.
WithPtr typ ptr -> GetCString ptr byte -> typ -> IO BlockCipherName
mkGetCString BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
forall a. BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
withBlockCipher GetCString BotanBlockCipher CChar
botan_block_cipher_name

{- |
Get the key specification of a block cipher

Returns the minimum, maximum, and modulo of valid keys.
-}
blockCipherGetKeyspec
    :: BlockCipher      -- ^ __bc__
    -> IO (Int,Int,Int) -- ^ __(min,max,mod)__
blockCipherGetKeyspec :: BlockCipher -> IO (Int, Int, Int)
blockCipherGetKeyspec = (forall a. BlockCipher -> (BotanBlockCipher -> IO a) -> IO a)
-> GetSizes3 BotanBlockCipher -> BlockCipher -> IO (Int, Int, Int)
forall typ ptr.
WithPtr typ ptr -> GetSizes3 ptr -> typ -> IO (Int, Int, Int)
mkGetSizes3 BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
forall a. BlockCipher -> (BotanBlockCipher -> IO a) -> IO a
withBlockCipher GetSizes3 BotanBlockCipher
botan_block_cipher_get_keyspec