{-|
Module      : Botan.Low.RSA
Description : Algorithm specific key operations: RSA
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : leo@apotheca.io
Stability   : experimental
Portability : POSIX
-}

module Botan.Low.PubKey.RSA where

import qualified Data.ByteString as ByteString

import Botan.Bindings.PubKey.RSA

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

-- /*
-- * Algorithm specific key operations: RSA
-- */

privKeyLoadRSA
    :: MP           -- ^ __p__
    -> MP           -- ^ __q__
    -> MP           -- ^ __e__
    -> IO PrivKey   -- ^ __key__
privKeyLoadRSA :: MP -> MP -> MP -> IO PrivKey
privKeyLoadRSA = (Ptr BotanPrivKey
 -> BotanMP -> BotanMP -> BotanMP -> IO BotanErrorCode)
-> MP -> MP -> MP -> IO PrivKey
mkPrivKeyLoad3 Ptr BotanPrivKey
-> BotanMP -> BotanMP -> BotanMP -> IO BotanErrorCode
botan_privkey_load_rsa

privKeyLoadRSA_PKCS1
    :: ByteString   -- ^ __bits__
    -> IO PrivKey   -- ^ __key__
privKeyLoadRSA_PKCS1 :: ByteString -> IO PrivKey
privKeyLoadRSA_PKCS1 = ((Ptr BotanPrivKey -> IO BotanErrorCode) -> IO PrivKey)
-> (Ptr BotanPrivKey
    -> ConstPtr Word8 -> CSize -> IO BotanErrorCode)
-> ByteString
-> IO PrivKey
forall botan object.
((Ptr botan -> IO BotanErrorCode) -> IO object)
-> (Ptr botan -> ConstPtr Word8 -> CSize -> IO BotanErrorCode)
-> ByteString
-> IO object
mkCreateObjectCBytesLen (Ptr BotanPrivKey -> IO BotanErrorCode) -> IO PrivKey
createPrivKey Ptr BotanPrivKey -> ConstPtr Word8 -> CSize -> IO BotanErrorCode
botan_privkey_load_rsa_pkcs1

privKeyRSAGetPrivKey
    :: PrivKey          -- ^ __rsa_key__
    -> Word32           -- ^ __flags__
    -> IO ByteString    -- ^ __out__
-- WRONG: privKeyRSAGetPrivKey = mkCreateObjectCBytesLen1 botan_privkey_rsa_get_privkey
privKeyRSAGetPrivKey :: PrivKey -> Word32 -> IO ByteString
privKeyRSAGetPrivKey = (forall a1. PrivKey -> (BotanPrivKey -> IO a1) -> IO a1)
-> (BotanPrivKey
    -> Word32 -> Ptr Word8 -> Ptr CSize -> IO BotanErrorCode)
-> PrivKey
-> Word32
-> IO ByteString
forall object botan a.
(forall a1. object -> (botan -> IO a1) -> IO a1)
-> (botan -> a -> Ptr Word8 -> Ptr CSize -> IO BotanErrorCode)
-> object
-> a
-> IO ByteString
mkWithObjectGetterCBytesLen1 PrivKey -> (BotanPrivKey -> IO a1) -> IO a1
forall a1. PrivKey -> (BotanPrivKey -> IO a1) -> IO a1
withPrivKey
    ((BotanPrivKey
  -> Word32 -> Ptr Word8 -> Ptr CSize -> IO BotanErrorCode)
 -> PrivKey -> Word32 -> IO ByteString)
-> (BotanPrivKey
    -> Word32 -> Ptr Word8 -> Ptr CSize -> IO BotanErrorCode)
-> PrivKey
-> Word32
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ BotanPrivKey
rsa_key Word32
flags Ptr Word8
out Ptr CSize
out_len -> BotanPrivKey
-> Ptr Word8 -> Ptr CSize -> Word32 -> IO BotanErrorCode
botan_privkey_rsa_get_privkey BotanPrivKey
rsa_key Ptr Word8
out Ptr CSize
out_len Word32
flags

pubKeyLoadRSA
    :: MP           -- ^ __n__
    -> MP           -- ^ __e__
    -> IO PubKey    -- ^ __key__
pubKeyLoadRSA :: MP -> MP -> IO PubKey
pubKeyLoadRSA = (Ptr BotanPubKey -> BotanMP -> BotanMP -> IO BotanErrorCode)
-> MP -> MP -> IO PubKey
mkPubKeyLoad2 Ptr BotanPubKey -> BotanMP -> BotanMP -> IO BotanErrorCode
botan_pubkey_load_rsa