{-|
Module      : Botan.Low.Encrypt
Description : Public Key Encryption
Copyright   : (c) 2023-2024, Apotheca Labs
              (c) 2024-2025, Haskell Foundation
License     : BSD-3-Clause
Maintainer  : joris@well-typed.com, leo@apotheca.io
Stability   : experimental
Portability : POSIX
-}

module Botan.Low.PubKey.Encrypt (

  -- * Public key encryption
    Encrypt(..)
  , withEncrypt
  , encryptCreate
  , encryptDestroy
  , encryptOutputLength
  , encrypt

  ) where

import           Botan.Bindings.ConstPtr (ConstPtr (..))
import           Botan.Bindings.PubKey.Encrypt
import           Botan.Low.Error.Internal (throwBotanIfNegative_)
import           Botan.Low.Internal.ByteString
import           Botan.Low.Make
import           Botan.Low.PubKey
import           Botan.Low.Remake
import           Botan.Low.RNG
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BSI
import           Foreign.C.Types
import           Foreign.ForeignPtr
import           Foreign.Marshal.Alloc
import           Foreign.Ptr
import           Foreign.Storable

-- /*
-- * Public Key Encryption
-- */

newtype Encrypt = MkEncrypt { Encrypt -> ForeignPtr BotanPKOpEncryptStruct
foreignPtr :: ForeignPtr BotanPKOpEncryptStruct }

withEncrypt     :: Encrypt -> (BotanPKOpEncrypt -> IO a) -> IO a
encryptDestroy  :: Encrypt -> IO ()
createEncrypt   :: (Ptr BotanPKOpEncrypt -> IO CInt) -> IO Encrypt
(Encrypt -> (BotanPKOpEncrypt -> IO a) -> IO a
withEncrypt, Encrypt -> IO ()
encryptDestroy, (Ptr BotanPKOpEncrypt -> IO CInt) -> IO Encrypt
createEncrypt)
    = (Ptr BotanPKOpEncryptStruct -> BotanPKOpEncrypt)
-> (BotanPKOpEncrypt -> Ptr BotanPKOpEncryptStruct)
-> (ForeignPtr BotanPKOpEncryptStruct -> Encrypt)
-> (Encrypt -> ForeignPtr BotanPKOpEncryptStruct)
-> FinalizerPtr BotanPKOpEncryptStruct
-> (Encrypt -> (BotanPKOpEncrypt -> IO a) -> IO a,
    Encrypt -> IO (), (Ptr BotanPKOpEncrypt -> IO CInt) -> IO Encrypt)
forall botan struct object a.
Storable botan =>
(Ptr struct -> botan)
-> (botan -> Ptr struct)
-> (ForeignPtr struct -> object)
-> (object -> ForeignPtr struct)
-> FinalizerPtr struct
-> (object -> (botan -> IO a) -> IO a, object -> IO (),
    (Ptr botan -> IO CInt) -> IO object)
mkBindings
        Ptr BotanPKOpEncryptStruct -> BotanPKOpEncrypt
MkBotanPKOpEncrypt (.ptr)
        ForeignPtr BotanPKOpEncryptStruct -> Encrypt
MkEncrypt (.foreignPtr)
        FinalizerPtr BotanPKOpEncryptStruct
botan_pk_op_encrypt_destroy

encryptCreate
    :: PubKey       -- ^ __key__
    -> EMEName      -- ^ __padding__
    -> IO Encrypt   -- ^ __op__
encryptCreate :: PubKey -> EMEName -> IO Encrypt
encryptCreate PubKey
pk EMEName
padding = PubKey -> (BotanPubKey -> IO Encrypt) -> IO Encrypt
forall a. PubKey -> (BotanPubKey -> IO a) -> IO a
withPubKey PubKey
pk ((BotanPubKey -> IO Encrypt) -> IO Encrypt)
-> (BotanPubKey -> IO Encrypt) -> IO Encrypt
forall a b. (a -> b) -> a -> b
$ \ BotanPubKey
pkPtr -> do
    EMEName -> (Ptr CChar -> IO Encrypt) -> IO Encrypt
forall a. EMEName -> (Ptr CChar -> IO a) -> IO a
asCString EMEName
padding ((Ptr CChar -> IO Encrypt) -> IO Encrypt)
-> (Ptr CChar -> IO Encrypt) -> IO Encrypt
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
paddingPtr -> do
        (Ptr BotanPKOpEncrypt -> IO CInt) -> IO Encrypt
createEncrypt ((Ptr BotanPKOpEncrypt -> IO CInt) -> IO Encrypt)
-> (Ptr BotanPKOpEncrypt -> IO CInt) -> IO Encrypt
forall a b. (a -> b) -> a -> b
$ \ Ptr BotanPKOpEncrypt
out -> Ptr BotanPKOpEncrypt
-> BotanPubKey -> ConstPtr CChar -> Word32 -> IO CInt
botan_pk_op_encrypt_create
            Ptr BotanPKOpEncrypt
out
            BotanPubKey
pkPtr
            (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
paddingPtr)
            Word32
0

encryptOutputLength
    :: Encrypt  -- ^ __op__
    -> Int      -- ^ __ptext_len__
    -> IO Int   -- ^ __ctext_len__
encryptOutputLength :: Encrypt -> Int -> IO Int
encryptOutputLength = WithPtr Encrypt BotanPKOpEncrypt
-> GetSize_csize BotanPKOpEncrypt -> Encrypt -> Int -> IO Int
forall typ ptr.
WithPtr typ ptr -> GetSize_csize ptr -> typ -> Int -> IO Int
mkGetSize_csize Encrypt -> (BotanPKOpEncrypt -> IO a) -> IO a
WithPtr Encrypt BotanPKOpEncrypt
withEncrypt GetSize_csize BotanPKOpEncrypt
botan_pk_op_encrypt_output_length

encrypt ::
     Encrypt          -- ^ __op__
  -> RNG              -- ^ __rng__
  -> ByteString       -- ^ __plaintext[]__
  -> IO ByteString    -- ^ __ciphertext[]__
encrypt :: Encrypt -> RNG -> EMEName -> IO EMEName
encrypt Encrypt
enc RNG
rng EMEName
ptext =
    Encrypt -> (BotanPKOpEncrypt -> IO EMEName) -> IO EMEName
WithPtr Encrypt BotanPKOpEncrypt
withEncrypt Encrypt
enc ((BotanPKOpEncrypt -> IO EMEName) -> IO EMEName)
-> (BotanPKOpEncrypt -> IO EMEName) -> IO EMEName
forall a b. (a -> b) -> a -> b
$ \ BotanPKOpEncrypt
encPtr ->
    RNG -> (BotanRNG -> IO EMEName) -> IO EMEName
forall a. RNG -> (BotanRNG -> IO a) -> IO a
withRNG RNG
rng ((BotanRNG -> IO EMEName) -> IO EMEName)
-> (BotanRNG -> IO EMEName) -> IO EMEName
forall a b. (a -> b) -> a -> b
$ \ BotanRNG
botanRNG ->
    EMEName -> (Ptr Word8 -> CSize -> IO EMEName) -> IO EMEName
forall byte a. EMEName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen EMEName
ptext ((Ptr Word8 -> CSize -> IO EMEName) -> IO EMEName)
-> (Ptr Word8 -> CSize -> IO EMEName) -> IO EMEName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
ptextPtr CSize
ptextLen ->
    (Ptr CSize -> IO EMEName) -> IO EMEName
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO EMEName) -> IO EMEName)
-> (Ptr CSize -> IO EMEName) -> IO EMEName
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
szPtr -> do
      Int
sz <- Encrypt -> Int -> IO Int
encryptOutputLength Encrypt
enc (EMEName -> Int
BS.length EMEName
ptext)
      Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
szPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
      Int -> (Ptr Word8 -> IO Int) -> IO EMEName
BSI.createAndTrim Int
sz ((Ptr Word8 -> IO Int) -> IO EMEName)
-> (Ptr Word8 -> IO Int) -> IO EMEName
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
          BotanPKOpEncrypt
-> BotanRNG
-> Ptr Word8
-> Ptr CSize
-> Ptr Word8
-> CSize
-> IO CInt
botan_pk_op_encrypt
            BotanPKOpEncrypt
encPtr
            BotanRNG
botanRNG
            Ptr Word8
outPtr
            Ptr CSize
szPtr
            Ptr Word8
ptextPtr
            CSize
ptextLen
        CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
szPtr