{-# LINE 1 "src/Botan/Bindings/FPE.hsc" #-}
{-|
Module      : Botan.Bindings.FPE
Description : Format Preserving Encryption
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : leo@apotheca.io
Stability   : experimental
Portability : POSIX

Format preserving encryption (FPE) refers to a set of techniques
for encrypting data such that the ciphertext has the same format
as the plaintext. For instance, you can use FPE to encrypt credit
card numbers with valid checksums such that the ciphertext is also
an credit card number with a valid checksum, or similarly for bank
account numbers, US Social Security numbers, or even more general
mappings like English words onto other English words.

The scheme currently implemented in botan is called FE1, and described
in the paper Format Preserving Encryption by Mihir Bellare, Thomas
Ristenpart, Phillip Rogaway, and Till Stegers. FPE is an area of
ongoing standardization and it is likely that other schemes will be
included in the future.

To encrypt an arbitrary value using FE1, you need to use a ranking
method. Basically, the idea is to assign an integer to every value
you might encrypt. For instance, a 16 digit credit card number consists
of a 15 digit code plus a 1 digit checksum. So to encrypt a credit card
number, you first remove the checksum, encrypt the 15 digit value modulo
1015, and then calculate what the checksum is for the new (ciphertext)
number. Or, if you were encrypting words in a dictionary, you could rank
the words by their lexicographical order, and choose the modulus to be
the number of words in the dictionary.
-}

{-# LANGUAGE CApiFFI #-}

module Botan.Bindings.FPE where

import Botan.Bindings.MPI
import Botan.Bindings.Prelude



-- | Opaque FPE struct
data {-# CTYPE "botan/ffi.h" "struct botan_fpe_struct" #-} BotanFPEStruct

-- | Botan FPE object
newtype {-# CTYPE "botan/ffi.h" "botan_fpe_t" #-} BotanFPE
    = MkBotanFPE { BotanFPE -> Ptr BotanFPEStruct
runBotanFPE :: Ptr BotanFPEStruct }
        deriving newtype (BotanFPE -> BotanFPE -> Bool
(BotanFPE -> BotanFPE -> Bool)
-> (BotanFPE -> BotanFPE -> Bool) -> Eq BotanFPE
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BotanFPE -> BotanFPE -> Bool
== :: BotanFPE -> BotanFPE -> Bool
$c/= :: BotanFPE -> BotanFPE -> Bool
/= :: BotanFPE -> BotanFPE -> Bool
Eq, Eq BotanFPE
Eq BotanFPE
-> (BotanFPE -> BotanFPE -> Ordering)
-> (BotanFPE -> BotanFPE -> Bool)
-> (BotanFPE -> BotanFPE -> Bool)
-> (BotanFPE -> BotanFPE -> Bool)
-> (BotanFPE -> BotanFPE -> Bool)
-> (BotanFPE -> BotanFPE -> BotanFPE)
-> (BotanFPE -> BotanFPE -> BotanFPE)
-> Ord BotanFPE
BotanFPE -> BotanFPE -> Bool
BotanFPE -> BotanFPE -> Ordering
BotanFPE -> BotanFPE -> BotanFPE
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
$ccompare :: BotanFPE -> BotanFPE -> Ordering
compare :: BotanFPE -> BotanFPE -> Ordering
$c< :: BotanFPE -> BotanFPE -> Bool
< :: BotanFPE -> BotanFPE -> Bool
$c<= :: BotanFPE -> BotanFPE -> Bool
<= :: BotanFPE -> BotanFPE -> Bool
$c> :: BotanFPE -> BotanFPE -> Bool
> :: BotanFPE -> BotanFPE -> Bool
$c>= :: BotanFPE -> BotanFPE -> Bool
>= :: BotanFPE -> BotanFPE -> Bool
$cmax :: BotanFPE -> BotanFPE -> BotanFPE
max :: BotanFPE -> BotanFPE -> BotanFPE
$cmin :: BotanFPE -> BotanFPE -> BotanFPE
min :: BotanFPE -> BotanFPE -> BotanFPE
Ord, Ptr BotanFPE -> IO BotanFPE
Ptr BotanFPE -> Int -> IO BotanFPE
Ptr BotanFPE -> Int -> BotanFPE -> IO ()
Ptr BotanFPE -> BotanFPE -> IO ()
BotanFPE -> Int
(BotanFPE -> Int)
-> (BotanFPE -> Int)
-> (Ptr BotanFPE -> Int -> IO BotanFPE)
-> (Ptr BotanFPE -> Int -> BotanFPE -> IO ())
-> (forall b. Ptr b -> Int -> IO BotanFPE)
-> (forall b. Ptr b -> Int -> BotanFPE -> IO ())
-> (Ptr BotanFPE -> IO BotanFPE)
-> (Ptr BotanFPE -> BotanFPE -> IO ())
-> Storable BotanFPE
forall b. Ptr b -> Int -> IO BotanFPE
forall b. Ptr b -> Int -> BotanFPE -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: BotanFPE -> Int
sizeOf :: BotanFPE -> Int
$calignment :: BotanFPE -> Int
alignment :: BotanFPE -> Int
$cpeekElemOff :: Ptr BotanFPE -> Int -> IO BotanFPE
peekElemOff :: Ptr BotanFPE -> Int -> IO BotanFPE
$cpokeElemOff :: Ptr BotanFPE -> Int -> BotanFPE -> IO ()
pokeElemOff :: Ptr BotanFPE -> Int -> BotanFPE -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO BotanFPE
peekByteOff :: forall b. Ptr b -> Int -> IO BotanFPE
$cpokeByteOff :: forall b. Ptr b -> Int -> BotanFPE -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> BotanFPE -> IO ()
$cpeek :: Ptr BotanFPE -> IO BotanFPE
peek :: Ptr BotanFPE -> IO BotanFPE
$cpoke :: Ptr BotanFPE -> BotanFPE -> IO ()
poke :: Ptr BotanFPE -> BotanFPE -> IO ()
Storable)

-- | Destroy the FPE object
foreign import capi safe "botan/ffi.h &botan_fpe_destroy"
    botan_fpe_destroy
        :: FinalizerPtr BotanFPEStruct

pattern BOTAN_FPE_FLAG_NONE 
    ,   BOTAN_FPE_FLAG_FE1_COMPAT_MODE
    ::  (Eq a, Num a) => a

-- Not an actual flag
pattern $mBOTAN_FPE_FLAG_NONE :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FPE_FLAG_NONE :: forall a. (Eq a, Num a) => a
BOTAN_FPE_FLAG_NONE            = 0
pattern $mBOTAN_FPE_FLAG_FE1_COMPAT_MODE :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FPE_FLAG_FE1_COMPAT_MODE :: forall a. (Eq a, Num a) => a
BOTAN_FPE_FLAG_FE1_COMPAT_MODE = 1
{-# LINE 64 "src/Botan/Bindings/FPE.hsc" #-}

foreign import capi safe "botan/ffi.h botan_fpe_fe1_init"
    botan_fpe_fe1_init
        :: Ptr BotanFPE     -- ^ __fpe__
        -> BotanMP          -- ^ __n__
        -> ConstPtr Word8   -- ^ __key[]__
        -> CSize            -- ^ __key_len__
        -> CSize            -- ^ __rounds__
        -> Word32           -- ^ __flags__
        -> IO CInt

foreign import capi safe "botan/ffi.h botan_fpe_encrypt"
    botan_fpe_encrypt
        :: BotanFPE         -- ^ __fpe__
        -> BotanMP          -- ^ __x__
        -> ConstPtr Word8   -- ^ __tweak[]__
        -> CSize            -- ^ __tweak_len__
        -> IO CInt

foreign import capi safe "botan/ffi.h botan_fpe_decrypt"
    botan_fpe_decrypt
        :: BotanFPE         -- ^ __fpe__
        -> BotanMP          -- ^ __x__
        -> ConstPtr Word8   -- ^ __tweak[]__
        -> CSize            -- ^ __tweak_len__
        -> IO CInt