Sign.hs

{-|
Module      : Botan.Low.PubKey.Sign
Description : Signature Generation
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.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 { getSignForeignPtr :: ForeignPtr BotanPKOpSignStruct }

newSign      :: BotanPKOpSign -> IO Sign
withSign     :: Sign -> (BotanPKOpSign -> IO a) -> IO a
signDestroy  :: Sign -> IO ()
createSign   :: (Ptr BotanPKOpSign -> IO CInt) -> IO Sign
(newSign, withSign, signDestroy, createSign, _)
    = mkBindings
        MkBotanPKOpSign runBotanPKOpSign
        MkSign getSignForeignPtr
        botan_pk_op_sign_destroy

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

type SigningFlags = Word32

pattern StandardFormatSignature   -- ^ Not an actual flags
    ,   DERFormatSignature
    ::  SigningFlags
pattern StandardFormatSignature = BOTAN_PUBKEY_STD_FORMAT_SIGNATURE
pattern DERFormatSignature = BOTAN_PUBKEY_DER_FORMAT_SIGNATURE

signCreate
    :: PrivKey      -- ^ __key__
    -> EMSAName     -- ^ __hash_and_padding__
    -> SigningFlags -- ^ __flags__
    -> IO Sign      -- ^ __op__
signCreate sk algo flags = withPrivKey sk $ \ skPtr -> do
    asCString algo $ \ algoPtr -> do
        createSign $ \ out -> botan_pk_op_sign_create
            out
            skPtr
            (ConstPtr algoPtr)
            flags

-- WARNING: withFooInit-style limited lifetime functions moved to high-level botan
withSignCreate :: PrivKey -> EMSAName -> SigningFlags -> (Sign -> IO a) -> IO a
withSignCreate = mkWithTemp3 signCreate signDestroy

signOutputLength
    :: Sign     -- ^ __op__
    -> IO Int   -- ^ __olen__
signOutputLength = mkGetSize withSign botan_pk_op_sign_output_length

signUpdate
    :: Sign         -- ^ __op__
    -> ByteString   -- ^ __in[]__
    -> IO ()
-- signUpdate = mkSetBytesLen withSign botan_pk_op_sign_update
signUpdate = mkWithObjectSetterCBytesLen withSign botan_pk_op_sign_update

-- | Finish signing
--
-- Depending on the algorithm, signatures produced using StandardFormatSignature
-- may have trailing null bytes.
signFinish
    :: Sign             -- ^ __op__
    -> RNG              -- ^ __rng__
    -> IO ByteString    -- ^ __sig[]__
-- TODO: Signature type
-- NOTE: This function is still highly suspect
signFinish sign rng = withSign sign $ \ signPtr -> do
    withRNG rng $ \ 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.
        sz <- signOutputLength sign
        (sz',bytes) <- allocBytesWith sz $ \ sigPtr -> do
            alloca $ \ szPtr -> do
                poke szPtr (fromIntegral sz)
                throwBotanIfNegative_ $ botan_pk_op_sign_finish signPtr botanRNG sigPtr szPtr
                peek szPtr
        return $!! ByteString.take (fromIntegral sz') bytes

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

-- TODO: botan_pkcs_hash_id