{-|
Module      : Z.Crypto.FPE
Description : Format Preserving Encryption
Copyright   : Anjie, Dong Han, 2021
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

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 Z.Crypto.FPE ( FPE, newFPE, encryptFPE, decryptFPE ) where

import           GHC.Generics
import           Z.Botan.FFI
import           Z.Botan.Exception
import           Z.Crypto.MPI
import qualified Z.Data.Vector as V
import qualified Z.Data.Text   as T
import           Z.Foreign

newtype FPE = FPE BotanStruct
    deriving (Int -> FPE -> ShowS
[FPE] -> ShowS
FPE -> String
(Int -> FPE -> ShowS)
-> (FPE -> String) -> ([FPE] -> ShowS) -> Show FPE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FPE] -> ShowS
$cshowList :: [FPE] -> ShowS
show :: FPE -> String
$cshow :: FPE -> String
showsPrec :: Int -> FPE -> ShowS
$cshowsPrec :: Int -> FPE -> ShowS
Show, (forall x. FPE -> Rep FPE x)
-> (forall x. Rep FPE x -> FPE) -> Generic FPE
forall x. Rep FPE x -> FPE
forall x. FPE -> Rep FPE x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FPE x -> FPE
$cfrom :: forall x. FPE -> Rep FPE x
Generic)
    deriving anyclass Int -> FPE -> Builder ()
(Int -> FPE -> Builder ()) -> Print FPE
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> FPE -> Builder ()
$ctoUTF8BuilderP :: Int -> FPE -> Builder ()
T.Print

-- | Initialize an FPE operation to encrypt/decrypt integers less than n. It is
--   expected that n is trivially factorable into small integers. Common usage
--   would be n to be a power of 10.
newFPE :: HasCallStack
       => MPI     -- ^ mod (n)
       -> V.Bytes -- ^ key
       -> IO FPE
{-# INLINABLE newFPE #-}
newFPE :: MPI -> Bytes -> IO FPE
newFPE MPI
mpi Bytes
key =
    MPI -> (BotanStructT -> IO FPE) -> IO FPE
forall a. MPI -> (BotanStructT -> IO a) -> IO a
withMPI MPI
mpi ((BotanStructT -> IO FPE) -> IO FPE)
-> (BotanStructT -> IO FPE) -> IO FPE
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
mpi' ->
    Bytes -> (BA# Word8 -> Int -> Int -> IO FPE) -> IO FPE
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
key ((BA# Word8 -> Int -> Int -> IO FPE) -> IO FPE)
-> (BA# Word8 -> Int -> Int -> IO FPE) -> IO FPE
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
key' Int
keyOff Int
keyLen ->
        BotanStruct -> FPE
FPE (BotanStruct -> FPE) -> IO BotanStruct -> IO FPE
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
fpe ->
            MBA# BotanStructT
-> BotanStructT
-> BA# Word8
-> Int
-> Int
-> Int
-> Word32
-> IO CInt
hs_botan_fpe_fe1_init MBA# BotanStructT
fpe BotanStructT
mpi' BA# Word8
key' Int
keyOff Int
keyLen Int
3 Word32
1)
            FunPtr (BotanStructT -> IO ())
botan_fpe_destroy

-- | Encrypts the value x modulo the value n using the key and tweak specified. Returns an integer less than n. The tweak is a value that does not need to be secret that parameterizes the encryption function. For instance, if you were encrypting a database column with a single key, you could use a per-row-unique integer index value as the tweak. The same tweak value must be used during decryption.
encryptFPE :: HasCallStack
           =>FPE
           -> MPI
           -> V.Bytes   -- ^ tweak
           -> IO MPI
{-# INLINABLE encryptFPE #-}
encryptFPE :: FPE -> MPI -> Bytes -> IO MPI
encryptFPE (FPE BotanStruct
fpe) MPI
mpi Bytes
tweak = do
    MPI
mpi' <- MPI -> IO MPI
copyMPI MPI
mpi
    BotanStruct -> (BotanStructT -> IO ()) -> IO ()
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
fpe ((BotanStructT -> IO ()) -> IO ())
-> (BotanStructT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
fpe' ->
        MPI -> (BotanStructT -> IO ()) -> IO ()
forall a. MPI -> (BotanStructT -> IO a) -> IO a
withMPI MPI
mpi' ((BotanStructT -> IO ()) -> IO ())
-> (BotanStructT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
mpi'' ->
        Bytes -> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
tweak ((BA# Word8 -> Int -> Int -> IO ()) -> IO ())
-> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
t Int
toff Int
tlen ->
            IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT -> BotanStructT -> BA# Word8 -> Int -> Int -> IO CInt
hs_botan_fpe_encrypt BotanStructT
fpe' BotanStructT
mpi'' BA# Word8
t Int
toff Int
tlen)
    MPI -> IO MPI
forall (m :: * -> *) a. Monad m => a -> m a
return MPI
mpi'


-- | Decrypts an FE1 ciphertext. The tweak must be the same as that provided to the encryption function. Returns the plaintext integer.
-- Note that there is not any implicit authentication or checking of data in FE1, so if you provide an incorrect key or tweak the result is simply a random integer.
decryptFPE :: HasCallStack
           => FPE
           -> MPI
           -> V.Bytes   -- ^ tweak
           -> IO MPI
{-# INLINABLE decryptFPE #-}
decryptFPE :: FPE -> MPI -> Bytes -> IO MPI
decryptFPE (FPE BotanStruct
fpe) MPI
mpi Bytes
tweak = do
    MPI
mpi' <- MPI -> IO MPI
copyMPI MPI
mpi
    BotanStruct -> (BotanStructT -> IO ()) -> IO ()
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
fpe ((BotanStructT -> IO ()) -> IO ())
-> (BotanStructT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
fpe' ->
        MPI -> (BotanStructT -> IO ()) -> IO ()
forall a. MPI -> (BotanStructT -> IO a) -> IO a
withMPI MPI
mpi' ((BotanStructT -> IO ()) -> IO ())
-> (BotanStructT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
mpi'' ->
        Bytes -> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
tweak ((BA# Word8 -> Int -> Int -> IO ()) -> IO ())
-> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
t Int
toff Int
tlen ->
            IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT -> BotanStructT -> BA# Word8 -> Int -> Int -> IO CInt
hs_botan_fpe_decrypt BotanStructT
fpe' BotanStructT
mpi'' BA# Word8
t Int
toff Int
tlen)
    MPI -> IO MPI
forall (m :: * -> *) a. Monad m => a -> m a
return MPI
mpi'