{-|
Module      : Botan.Low.PubKey.Sign
Description : Signature Generation
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : leo@apotheca.io
Stability   : experimental
Portability : POSIX
-}

module Botan.Low.PubKey.Sign
(

-- * Public key signatures
  Sign(..)
, SigningFlags(..)
, pattern StandardFormatSignature
, pattern DERFormatSignature
, withSign
, signCreate
, signDestroy
, signOutputLength
, signUpdate
, signFinish

) where

import qualified Data.ByteString as ByteString

import Botan.Bindings.PubKey.Sign

import Botan.Low.Error
import Botan.Low.Make
import Botan.Low.Prelude
import Botan.Low.RNG
import Botan.Low.PubKey
import Botan.Low.Remake

-- /*
-- * Signature Generation
-- */

newtype Sign = MkSign { Sign -> ForeignPtr BotanPKOpSignStruct
getSignForeignPtr :: ForeignPtr BotanPKOpSignStruct }

newSign      :: BotanPKOpSign -> IO Sign
withSign     :: Sign -> (BotanPKOpSign -> IO a) -> IO a
signDestroy  :: Sign -> IO ()
createSign   :: (Ptr BotanPKOpSign -> IO CInt) -> IO Sign
(BotanPKOpSign -> IO Sign
newSign, Sign -> (BotanPKOpSign -> IO a) -> IO a
withSign, Sign -> IO ()
signDestroy, (Ptr BotanPKOpSign -> IO CInt) -> IO Sign
createSign, (Ptr BotanPKOpSign -> Ptr CSize -> IO CInt) -> IO [Sign]
_)
    = (Ptr BotanPKOpSignStruct -> BotanPKOpSign)
-> (BotanPKOpSign -> Ptr BotanPKOpSignStruct)
-> (ForeignPtr BotanPKOpSignStruct -> Sign)
-> (Sign -> ForeignPtr BotanPKOpSignStruct)
-> FinalizerPtr BotanPKOpSignStruct
-> (BotanPKOpSign -> IO Sign,
    Sign -> (BotanPKOpSign -> IO a) -> IO a, Sign -> IO (),
    (Ptr BotanPKOpSign -> IO CInt) -> IO Sign,
    (Ptr BotanPKOpSign -> Ptr CSize -> IO CInt) -> IO [Sign])
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 BotanPKOpSignStruct -> BotanPKOpSign
MkBotanPKOpSign BotanPKOpSign -> Ptr BotanPKOpSignStruct
runBotanPKOpSign
        ForeignPtr BotanPKOpSignStruct -> Sign
MkSign Sign -> ForeignPtr BotanPKOpSignStruct
getSignForeignPtr
        FinalizerPtr BotanPKOpSignStruct
botan_pk_op_sign_destroy

-- TODO: Rename SignAlgoParams / SigningParams
type SignAlgoName = ByteString

type SigningFlags = Word32

pattern StandardFormatSignature   -- ^ Not an actual flags
    ,   DERFormatSignature
    ::  SigningFlags
pattern $mStandardFormatSignature :: forall {r}. SigningFlags -> ((# #) -> r) -> ((# #) -> r) -> r
$bStandardFormatSignature :: SigningFlags
StandardFormatSignature = BOTAN_PUBKEY_STD_FORMAT_SIGNATURE
pattern $mDERFormatSignature :: forall {r}. SigningFlags -> ((# #) -> r) -> ((# #) -> r) -> r
$bDERFormatSignature :: SigningFlags
DERFormatSignature = BOTAN_PUBKEY_DER_FORMAT_SIGNATURE

signCreate
    :: PrivKey      -- ^ __key__
    -> EMSAName     -- ^ __hash_and_padding__
    -> SigningFlags -- ^ __flags__
    -> IO Sign      -- ^ __op__
signCreate :: PrivKey -> ByteString -> SigningFlags -> IO Sign
signCreate PrivKey
sk ByteString
algo SigningFlags
flags = PrivKey -> (BotanPrivKey -> IO Sign) -> IO Sign
forall a. PrivKey -> (BotanPrivKey -> IO a) -> IO a
withPrivKey PrivKey
sk ((BotanPrivKey -> IO Sign) -> IO Sign)
-> (BotanPrivKey -> IO Sign) -> IO Sign
forall a b. (a -> b) -> a -> b
$ \ BotanPrivKey
skPtr -> do
    ByteString -> (Ptr CChar -> IO Sign) -> IO Sign
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
algo ((Ptr CChar -> IO Sign) -> IO Sign)
-> (Ptr CChar -> IO Sign) -> IO Sign
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
algoPtr -> do
        (Ptr BotanPKOpSign -> IO CInt) -> IO Sign
createSign ((Ptr BotanPKOpSign -> IO CInt) -> IO Sign)
-> (Ptr BotanPKOpSign -> IO CInt) -> IO Sign
forall a b. (a -> b) -> a -> b
$ \ Ptr BotanPKOpSign
out -> Ptr BotanPKOpSign
-> BotanPrivKey -> ConstPtr CChar -> SigningFlags -> IO CInt
botan_pk_op_sign_create
            Ptr BotanPKOpSign
out
            BotanPrivKey
skPtr
            (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
algoPtr)
            SigningFlags
flags

-- WARNING: withFooInit-style limited lifetime functions moved to high-level botan
withSignCreate :: PrivKey -> EMSAName -> SigningFlags -> (Sign -> IO a) -> IO a
withSignCreate :: forall a.
PrivKey -> ByteString -> SigningFlags -> (Sign -> IO a) -> IO a
withSignCreate = (PrivKey -> ByteString -> SigningFlags -> IO Sign)
-> (Sign -> IO ())
-> PrivKey
-> ByteString
-> SigningFlags
-> (Sign -> IO a)
-> IO a
forall x y z t a.
(x -> y -> z -> IO t)
-> (t -> IO ()) -> x -> y -> z -> (t -> IO a) -> IO a
mkWithTemp3 PrivKey -> ByteString -> SigningFlags -> IO Sign
signCreate Sign -> IO ()
signDestroy

signOutputLength
    :: Sign     -- ^ __op__
    -> IO Int   -- ^ __olen__
signOutputLength :: Sign -> IO Int
signOutputLength = WithPtr Sign BotanPKOpSign
-> GetSize BotanPKOpSign -> Sign -> IO Int
forall typ ptr. WithPtr typ ptr -> GetSize ptr -> typ -> IO Int
mkGetSize Sign -> (BotanPKOpSign -> IO a) -> IO a
WithPtr Sign BotanPKOpSign
withSign GetSize BotanPKOpSign
botan_pk_op_sign_output_length

signUpdate
    :: Sign         -- ^ __op__
    -> ByteString   -- ^ __in[]__
    -> IO ()
-- signUpdate = mkSetBytesLen withSign botan_pk_op_sign_update
signUpdate :: Sign -> ByteString -> IO ()
signUpdate = WithPtr Sign BotanPKOpSign
-> (BotanPKOpSign -> ConstPtr Word8 -> CSize -> IO CInt)
-> Sign
-> ByteString
-> IO ()
forall object botan.
(forall a. object -> (botan -> IO a) -> IO a)
-> (botan -> ConstPtr Word8 -> CSize -> IO CInt)
-> object
-> ByteString
-> IO ()
mkWithObjectSetterCBytesLen Sign -> (BotanPKOpSign -> IO a) -> IO a
WithPtr Sign BotanPKOpSign
withSign BotanPKOpSign -> ConstPtr Word8 -> CSize -> IO CInt
botan_pk_op_sign_update

-- TODO: Signature type
-- NOTE: This function is still highly suspect
signFinish
    :: Sign             -- ^ __op__
    -> RNG              -- ^ __rng__
    -> IO ByteString    -- ^ __sig[]__
signFinish :: Sign -> RNG -> IO ByteString
signFinish Sign
sign RNG
rng = Sign -> (BotanPKOpSign -> IO ByteString) -> IO ByteString
WithPtr Sign BotanPKOpSign
withSign Sign
sign ((BotanPKOpSign -> IO ByteString) -> IO ByteString)
-> (BotanPKOpSign -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ BotanPKOpSign
signPtr -> do
    RNG -> (BotanRNG -> IO ByteString) -> IO ByteString
forall a. RNG -> (BotanRNG -> IO a) -> IO a
withRNG RNG
rng ((BotanRNG -> IO ByteString) -> IO ByteString)
-> (BotanRNG -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ BotanRNG
botanRNG -> do
        -- NOTE: Investigation into DER format shows lots of trailing nulls that may need to be trimmed
        --  using the output of szPtr if sz is just an upper-bound estimate
        -- sz <- signOutputLength sign
        -- allocBytes sz $ \ sigPtr -> do
        --     alloca $ \ szPtr -> do
        --         poke szPtr (fromIntegral sz)
        --         throwBotanIfNegative_ $ botan_pk_op_sign_finish signPtr botanRNG sigPtr szPtr
        -- NOTE: This doesn't work, I think the output length poke is necessary
        -- allocBytesQuerying $ \ sigPtr szPtr -> do
        --     botan_pk_op_sign_finish signPtr botanRNG sigPtr szPtr
        -- NOTE: Trying combo, this should be packaged as allocBytesUpperBound or something
        --  We get an upper bound, allocate at least that many, poke the size, perform the
        --  op, read the actual size, and trim.
        Int
sz <- Sign -> IO Int
signOutputLength Sign
sign
        (CSize
sz',ByteString
bytes) <- Int -> (Ptr Word8 -> IO CSize) -> IO (CSize, ByteString)
forall byte a. Int -> (Ptr byte -> IO a) -> IO (a, ByteString)
allocBytesWith Int
sz ((Ptr Word8 -> IO CSize) -> IO (CSize, ByteString))
-> (Ptr Word8 -> IO CSize) -> IO (CSize, ByteString)
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
sigPtr -> do
            (Ptr CSize -> IO CSize) -> IO CSize
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO CSize) -> IO CSize)
-> (Ptr CSize -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtr -> do
                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)
                HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanPKOpSign -> BotanRNG -> Ptr Word8 -> Ptr CSize -> IO CInt
botan_pk_op_sign_finish BotanPKOpSign
signPtr BotanRNG
botanRNG Ptr Word8
sigPtr Ptr CSize
szPtr
                Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
szPtr
        ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. NFData a => (a -> b) -> a -> b
$!! Int -> ByteString -> ByteString
ByteString.take (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
sz') ByteString
bytes
{-# WARNING signFinish "Depending on the algorithm, signatures produced using StandardFormatSignature may have trailing null bytes." #-}

-- /**
-- * Signature Scheme Utility Functions
-- */

-- TODO: botan_pkcs_hash_id