{-|
Module      : Botan.Low.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.
-}

module Botan.Low.FPE
(

  FPE(..)
, FPEFlags(..)
, pattern FPENone
, pattern FPEFE1CompatMode
, withFPE
, fpeInitFE1
, fpeDestroy
, fpeEncrypt
, fpeDecrypt

) where

import qualified Data.ByteString as ByteString

import Botan.Bindings.FPE

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

-- NOTE: This module lacks documentation, and is not mentioned in the FFI bindings.
--  It is mentioned in the C++ docs, but the construction significantly differs.
--  I did find these functions in the actual header, and have implemented them as to my best guess
--  It is untested, pending an understanding of what the expected parameters are.
-- I think the FPE FFI is using the "original interface to FE1, first added in 1.9.17",
-- because they do not take a mac algo parameter, and may be hardcoded to "HMAC(SHA-256)"
--  SEE: https://botan.randombit.net/handbook/api_ref/fpe.html

-- NOTE: Source indicates that the FPE1 mac_algo is using the default "HMAC(SHA-256)", and
--  that the option is not exposed to FFI.

-- /**
-- * Format Preserving Encryption
-- */

newtype FPE = MkFPE { FPE -> ForeignPtr BotanFPEStruct
getFPEForeignPtr :: ForeignPtr BotanFPEStruct }

newFPE      :: BotanFPE -> IO FPE
withFPE     :: FPE -> (BotanFPE -> IO a) -> IO a
fpeDestroy  :: FPE -> IO ()
createFPE   :: (Ptr BotanFPE -> IO CInt) -> IO FPE
(BotanFPE -> IO FPE
newFPE, FPE -> (BotanFPE -> IO a) -> IO a
withFPE, FPE -> IO ()
fpeDestroy, (Ptr BotanFPE -> IO CInt) -> IO FPE
createFPE, (Ptr BotanFPE -> Ptr CSize -> IO CInt) -> IO [FPE]
_)
    = (Ptr BotanFPEStruct -> BotanFPE)
-> (BotanFPE -> Ptr BotanFPEStruct)
-> (ForeignPtr BotanFPEStruct -> FPE)
-> (FPE -> ForeignPtr BotanFPEStruct)
-> FinalizerPtr BotanFPEStruct
-> (BotanFPE -> IO FPE, FPE -> (BotanFPE -> IO a) -> IO a,
    FPE -> IO (), (Ptr BotanFPE -> IO CInt) -> IO FPE,
    (Ptr BotanFPE -> Ptr CSize -> IO CInt) -> IO [FPE])
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 BotanFPEStruct -> BotanFPE
MkBotanFPE BotanFPE -> Ptr BotanFPEStruct
runBotanFPE
        ForeignPtr BotanFPEStruct -> FPE
MkFPE FPE -> ForeignPtr BotanFPEStruct
getFPEForeignPtr
        FinalizerPtr BotanFPEStruct
botan_fpe_destroy

type FPEFlags = Word32

pattern FPENone
    ,   FPEFE1CompatMode
    ::  FPEFlags
pattern $mFPENone :: forall {r}. FPEFlags -> ((# #) -> r) -> ((# #) -> r) -> r
$bFPENone :: FPEFlags
FPENone          = BOTAN_FPE_FLAG_NONE
pattern $mFPEFE1CompatMode :: forall {r}. FPEFlags -> ((# #) -> r) -> ((# #) -> r) -> r
$bFPEFE1CompatMode :: FPEFlags
FPEFE1CompatMode = BOTAN_FPE_FLAG_FE1_COMPAT_MODE

-- | Initialize a FE1 FPE context
fpeInitFE1
    :: MP           -- ^ __n__
    -> ByteString   -- ^ __key[]__
    -> Int          -- ^ __rounds__
    -> FPEFlags     -- ^ __flags__
    -> IO FPE       -- ^ __fpe__
fpeInitFE1 :: MP -> ByteString -> Int -> FPEFlags -> IO FPE
fpeInitFE1 MP
n ByteString
key Int
rounds FPEFlags
flags = MP -> (BotanMP -> IO FPE) -> IO FPE
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
n ((BotanMP -> IO FPE) -> IO FPE) -> (BotanMP -> IO FPE) -> IO FPE
forall a b. (a -> b) -> a -> b
$ \ BotanMP
nPtr -> do
    ByteString -> (Ptr Word8 -> CSize -> IO FPE) -> IO FPE
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen ByteString
key ((Ptr Word8 -> CSize -> IO FPE) -> IO FPE)
-> (Ptr Word8 -> CSize -> IO FPE) -> IO FPE
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
keyPtr CSize
keyLen -> do
        (Ptr BotanFPE -> IO CInt) -> IO FPE
createFPE ((Ptr BotanFPE -> IO CInt) -> IO FPE)
-> (Ptr BotanFPE -> IO CInt) -> IO FPE
forall a b. (a -> b) -> a -> b
$ \ Ptr BotanFPE
out -> Ptr BotanFPE
-> BotanMP
-> ConstPtr Word8
-> CSize
-> CSize
-> FPEFlags
-> IO CInt
botan_fpe_fe1_init
            Ptr BotanFPE
out
            BotanMP
nPtr
            (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
keyPtr)
            CSize
keyLen
            (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rounds)
            FPEFlags
flags

-- WARNING: withFooInit-style limited lifetime functions moved to high-level botan
withFPEInitFE1 :: MP -> ByteString -> Int -> FPEFlags -> (FPE -> IO a) -> IO a
withFPEInitFE1 :: forall a.
MP -> ByteString -> Int -> FPEFlags -> (FPE -> IO a) -> IO a
withFPEInitFE1 = (MP -> ByteString -> Int -> FPEFlags -> IO FPE)
-> (FPE -> IO ())
-> MP
-> ByteString
-> Int
-> FPEFlags
-> (FPE -> IO a)
-> IO a
forall x y z w t a.
(x -> y -> z -> w -> IO t)
-> (t -> IO ()) -> x -> y -> z -> w -> (t -> IO a) -> IO a
mkWithTemp4 MP -> ByteString -> Int -> FPEFlags -> IO FPE
fpeInitFE1 FPE -> IO ()
fpeDestroy

-- -- NOTE: Referentially transparent, move to botan
-- fpeEncrypt :: FPE -> MP -> ByteString -> IO MP
-- fpeEncrypt fpe mp tweak = do
--     mp' <- mpCopy mp
--     fpeEncrypt fpe mp' tweak
--     return mp 

-- | Encrypt the 'x' value in-place
--
-- NOTE: Mutates the MP
fpeEncrypt
    :: FPE          -- ^ __fpe__
    -> MP           -- ^ __x__
    -> ByteString   -- ^ __tweak[]__
    -> IO ()
fpeEncrypt :: FPE -> MP -> ByteString -> IO ()
fpeEncrypt FPE
fpe MP
mp ByteString
tweak = do
    FPE -> (BotanFPE -> IO ()) -> IO ()
forall a. FPE -> (BotanFPE -> IO a) -> IO a
withFPE FPE
fpe ((BotanFPE -> IO ()) -> IO ()) -> (BotanFPE -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanFPE
fpePtr -> do
        MP -> (BotanMP -> IO ()) -> IO ()
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
mp ((BotanMP -> IO ()) -> IO ()) -> (BotanMP -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanMP
mpPtr -> do
            ByteString -> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen ByteString
tweak ((Ptr Word8 -> CSize -> IO ()) -> IO ())
-> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
tweakPtr CSize
tweakLen -> do
                HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanFPE -> BotanMP -> ConstPtr Word8 -> CSize -> IO CInt
botan_fpe_encrypt BotanFPE
fpePtr BotanMP
mpPtr (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
tweakPtr) CSize
tweakLen

-- -- NOTE: Referentially transparent, move to botan
-- fpeDecrypt :: FPE -> MP -> ByteString -> IO MP
-- fpeDecrypt fpe mp tweak = do
--     mp' <- mpCopy mp
--     fpeDecrypt fpe mp' tweak
--     return mp 

-- | Decrypt the 'x' value in-place
--
-- NOTE: Mutates the MP
fpeDecrypt
    :: FPE          -- ^ __fpe__
    -> MP           -- ^ __x__
    -> ByteString   -- ^ __tweak[]__
    -> IO ()
fpeDecrypt :: FPE -> MP -> ByteString -> IO ()
fpeDecrypt FPE
fpe MP
mp ByteString
tweak = do
    FPE -> (BotanFPE -> IO ()) -> IO ()
forall a. FPE -> (BotanFPE -> IO a) -> IO a
withFPE FPE
fpe ((BotanFPE -> IO ()) -> IO ()) -> (BotanFPE -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanFPE
fpePtr -> do
        MP -> (BotanMP -> IO ()) -> IO ()
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
mp ((BotanMP -> IO ()) -> IO ()) -> (BotanMP -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanMP
mpPtr -> do
            ByteString -> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen ByteString
tweak ((Ptr Word8 -> CSize -> IO ()) -> IO ())
-> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
tweakPtr CSize
tweakLen -> do
                HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanFPE -> BotanMP -> ConstPtr Word8 -> CSize -> IO CInt
botan_fpe_decrypt BotanFPE
fpePtr BotanMP
mpPtr (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
tweakPtr) CSize
tweakLen

data FE1InitFlags
    = FE1None       -- BOTAN_FPE_FLAG_NONE
    | FE1CompatMode -- BOTAN_FPE_FLAG_FE1_COMPAT_MODE