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

module Botan.PubKey.Sign
(

-- * Thing
-- $introduction

-- * Usage
-- $usage

-- * Public Key Signatures

  pkSign
-- , pkSignatureLength

-- ** Data type
,  PKSign(..)

-- ** Associated types

, PKSignAlgo(..)
, signAlgoName
, PKSignatureFormat(..)
, PKSignature(..)

-- ** Destructor
, destroyPKSign

-- ** Initializers
, newPKSign

-- ** Accessors
, pkSignOutputLength

-- ** Algorithm
, pkSignUpdate
, pkSignFinish

-- PENDING REFACTOR
, SignAlgo(..)
, EMSA(..)

) where

import qualified Data.ByteString as ByteString

import Data.Bool

import qualified Botan.Low.PubKey as Low
import qualified Botan.Low.PubKey.Sign as Low

import Botan.Error
import Botan.Hash
import Botan.Prelude
import Botan.PubKey
import Botan.RNG

{- $introduction

-}

{- $usage

-}

--
-- Public Key Signatures
--

-- NOTE: Signatures are currently wicked dangerous and prone to throwing exceptions
-- which pk algorithms go with what signing algos and formats is currently not well
-- defined. Proceed with caution

pkSign
    :: (MonadRandomIO m)
    => PrivKey
    -> PKSignAlgo
    -> PKSignatureFormat
    -> ByteString
    -> m PKSignature
pkSign :: forall (m :: * -> *).
MonadRandomIO m =>
PrivKey
-> PKSignAlgo -> PKSignatureFormat -> ByteString -> m ByteString
pkSign PrivKey
pk PKSignAlgo
algo PKSignatureFormat
fmt ByteString
msg = do
    PKSign
signer <- PrivKey -> PKSignAlgo -> PKSignatureFormat -> m PKSign
forall (m :: * -> *).
MonadIO m =>
PrivKey -> PKSignAlgo -> PKSignatureFormat -> m PKSign
newPKSign PrivKey
pk PKSignAlgo
algo PKSignatureFormat
fmt
    PKSign -> ByteString -> m ()
forall (m :: * -> *). MonadIO m => PKSign -> ByteString -> m ()
pkSignUpdate PKSign
signer ByteString
msg
    PKSign -> m ByteString
forall (m :: * -> *). MonadRandomIO m => PKSign -> m ByteString
pkSignFinish PKSign
signer

-- NOTE: Needs analysis for static data, involves key algo and fmt too
-- pkSignatureLength :: PKSignAlgo -> Int
-- pkSignatureLength algo = undefined
-- {-# NOINLINE pkSignatureLength #-}

-- Data type

-- TODO:

-- Associated types

type PKSignAlgo = SignAlgo

type PKSignatureFormat = Low.SigningFlags
type PKSignature = ByteString

-- Mutable context

type PKSign = Low.Sign

-- Destructor
destroyPKSign :: (MonadIO m) => PKSign -> m ()
destroyPKSign :: forall (m :: * -> *). MonadIO m => PKSign -> m ()
destroyPKSign = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (PKSign -> IO ()) -> PKSign -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKSign -> IO ()
Low.signDestroy

-- ** Initializers

newPKSign :: (MonadIO m) => PrivKey -> PKSignAlgo -> PKSignatureFormat -> m PKSign
newPKSign :: forall (m :: * -> *).
MonadIO m =>
PrivKey -> PKSignAlgo -> PKSignatureFormat -> m PKSign
newPKSign PrivKey
pk PKSignAlgo
algo PKSignatureFormat
fmt = IO PKSign -> m PKSign
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PKSign -> m PKSign) -> IO PKSign -> m PKSign
forall a b. (a -> b) -> a -> b
$ PrivKey -> ByteString -> PKSignatureFormat -> IO PKSign
Low.signCreate PrivKey
pk (PKSignAlgo -> ByteString
signAlgoName PKSignAlgo
algo) PKSignatureFormat
fmt

-- Accessors
pkSignOutputLength :: (MonadIO m) => PKSign -> m Int
pkSignOutputLength :: forall (m :: * -> *). MonadIO m => PKSign -> m Int
pkSignOutputLength = IO Int -> m Int
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> (PKSign -> IO Int) -> PKSign -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKSign -> IO Int
Low.signOutputLength

-- Mutable Algorithm

pkSignUpdate :: (MonadIO m) => PKSign -> ByteString -> m ()
pkSignUpdate :: forall (m :: * -> *). MonadIO m => PKSign -> ByteString -> m ()
pkSignUpdate PKSign
signer ByteString
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PKSign -> ByteString -> IO ()
Low.signUpdate PKSign
signer ByteString
msg

pkSignFinish :: (MonadRandomIO m) => PKSign -> m PKSignature
pkSignFinish :: forall (m :: * -> *). MonadRandomIO m => PKSign -> m ByteString
pkSignFinish PKSign
signer = do
    RNG
rng <- m RNG
forall (m :: * -> *). MonadRandomIO m => m RNG
getRNG
    IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ PKSign -> RNG -> IO ByteString
Low.signFinish PKSign
signer RNG
rng




--
-- OG BELOW
--






-- NOTE: Related to pk_pad

-- NOTE: Referred to as /padding/ algo in C++ docs
--  "The proper value of padding depends on the algorithm. For many
--  signature schemes including ECDSA and DSA, simply naming a hash
--  function like “SHA-256” is all that is required."
-- Are these all EMSA?
-- TODO: REFACTOR HEAVILY?
data SignAlgo
    = EMSA EMSA
    | Ed25519Pure
    | Ed25519ph
    | Ed25519Hash Hash  -- NOTE: Ed25519 is not the only key type to accept arbitary hashes.
    | SM2SignParam ByteString Hash
    | XMSSEmptyParam
    deriving (Int -> PKSignAlgo -> ShowS
[PKSignAlgo] -> ShowS
PKSignAlgo -> String
(Int -> PKSignAlgo -> ShowS)
-> (PKSignAlgo -> String)
-> ([PKSignAlgo] -> ShowS)
-> Show PKSignAlgo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PKSignAlgo -> ShowS
showsPrec :: Int -> PKSignAlgo -> ShowS
$cshow :: PKSignAlgo -> String
show :: PKSignAlgo -> String
$cshowList :: [PKSignAlgo] -> ShowS
showList :: [PKSignAlgo] -> ShowS
Show, PKSignAlgo -> PKSignAlgo -> Bool
(PKSignAlgo -> PKSignAlgo -> Bool)
-> (PKSignAlgo -> PKSignAlgo -> Bool) -> Eq PKSignAlgo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PKSignAlgo -> PKSignAlgo -> Bool
== :: PKSignAlgo -> PKSignAlgo -> Bool
$c/= :: PKSignAlgo -> PKSignAlgo -> Bool
/= :: PKSignAlgo -> PKSignAlgo -> Bool
Eq)

{- REFACTORING STAB 1 -}

data PKSignAlgo'
    = RSASign' EMSA 
    | SM2Sign' ByteString Hash
    | DSASign' Hash
    | ECDSASign' Hash
    | ECKCDSASign' Hash
    | ECGDSASign' Hash
    | GOST_34_10Sign' Hash
    | Ed25519Sign' Ed25519Sign'
    | XMSSSign' -- NOTE: Probably has actual params
    | DilithiumSign' -- NOTE: Probably has actual params

data Ed25519Sign'
    = Ed25519Pure'
    | Ed25519ph'
    | Ed25519Hash' Hash
    | Ed25519Empty' -- NOTE: SUSPECT DEFAULTS TO ONE OF THE OTHERS

{- END REFACTORING STAB 1 -}

signAlgoName :: SignAlgo -> Low.EMSAName
signAlgoName :: PKSignAlgo -> ByteString
signAlgoName (EMSA EMSA
emsa)            = EMSA -> ByteString
emsaName EMSA
emsa
signAlgoName PKSignAlgo
Ed25519Pure            = ByteString
"Pure"
signAlgoName PKSignAlgo
Ed25519ph              = ByteString
"Ed25519ph"
signAlgoName (Ed25519Hash Hash
h)        = Hash -> ByteString
hashName Hash
h
signAlgoName (SM2SignParam ByteString
uid Hash
h)   = ByteString
uid ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Hash -> ByteString
hashName Hash
h
signAlgoName PKSignAlgo
_                      = ByteString
""

-- NOTE: Mostly straight from Z-Botan
--  Can do a lot to make more ergonomic
data EMSA
    = EMSA_Raw
    | EMSA1 Hash
    | EMSA2 Hash
    | EMSA3_Raw (Maybe Hash)
    | EMSA3 Hash
    | EMSA4_Raw Hash (Maybe Int)
    | EMSA4 Hash (Maybe Int)
    | ISO_9796_DS2 Hash Bool (Maybe Int)
    | ISO_9796_DS3 Hash Bool
    deriving (Int -> EMSA -> ShowS
[EMSA] -> ShowS
EMSA -> String
(Int -> EMSA -> ShowS)
-> (EMSA -> String) -> ([EMSA] -> ShowS) -> Show EMSA
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EMSA -> ShowS
showsPrec :: Int -> EMSA -> ShowS
$cshow :: EMSA -> String
show :: EMSA -> String
$cshowList :: [EMSA] -> ShowS
showList :: [EMSA] -> ShowS
Show, EMSA -> EMSA -> Bool
(EMSA -> EMSA -> Bool) -> (EMSA -> EMSA -> Bool) -> Eq EMSA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EMSA -> EMSA -> Bool
== :: EMSA -> EMSA -> Bool
$c/= :: EMSA -> EMSA -> Bool
/= :: EMSA -> EMSA -> Bool
Eq)

-- TODO: Use elsewhere
mkNameArgs :: ByteString -> [ByteString] -> ByteString
mkNameArgs :: ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
name [ByteString]
args = ByteString
name ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
ByteString.intercalate ByteString
"," [ByteString]
args ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")"

-- NOTE: Raw mode assumes the plaintext is already processed and just signs the plaintext
-- TODO: Split out Raw mode?
emsaName :: EMSA -> Low.EMSAName
emsaName :: EMSA -> ByteString
emsaName EMSA
EMSA_Raw                   = ByteString
"Raw"
emsaName (EMSA1 Hash
h)                  = ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
"EMSA1" [ Hash -> ByteString
hashName Hash
h ]
emsaName (EMSA2 Hash
h)                  = ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
"EMSA2" [ Hash -> ByteString
hashName Hash
h ]
emsaName (EMSA3 Hash
h)                  = ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
"EMSA3" [ Hash -> ByteString
hashName Hash
h ]
emsaName (EMSA3_Raw (Just Hash
h))       = ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
"EMSA3" [ ByteString
"Raw", Hash -> ByteString
hashName Hash
h ]
emsaName (EMSA3_Raw Maybe Hash
_)              = ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
"EMSA3" [ ByteString
"Raw" ]
emsaName (EMSA4 Hash
h (Just Int
sz))        = ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
"EMSA4" [ Hash -> ByteString
hashName Hash
h, ByteString
"MGF1", Int -> ByteString
forall a. Show a => a -> ByteString
showBytes Int
sz ]
emsaName (EMSA4 Hash
h Maybe Int
_)                = ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
"EMSA4" [ Hash -> ByteString
hashName Hash
h ]
emsaName (EMSA4_Raw Hash
h (Just Int
sz))    = ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
"EMSA4_Raw" [ Hash -> ByteString
hashName Hash
h, ByteString
"MGF1", Int -> ByteString
forall a. Show a => a -> ByteString
showBytes Int
sz ]
emsaName (EMSA4_Raw Hash
h Maybe Int
_)            = ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
"EMSA4_Raw" [ Hash -> ByteString
hashName Hash
h ]
emsaName (ISO_9796_DS2 Hash
h Bool
imp (Just Int
sz))
                                    = ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
"ISO_9796_DS2" [ Hash -> ByteString
hashName Hash
h, Bool -> ByteString
iso9796Implicit Bool
imp, Int -> ByteString
forall a. Show a => a -> ByteString
showBytes Int
sz]
emsaName (ISO_9796_DS2 Hash
h Bool
imp Maybe Int
_)     = ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
"ISO_9796_DS2" [ Hash -> ByteString
hashName Hash
h, Bool -> ByteString
iso9796Implicit Bool
imp]
emsaName (ISO_9796_DS3 Hash
h Bool
imp)       = ByteString -> [ByteString] -> ByteString
mkNameArgs ByteString
"ISO_9796_DS3" [ Hash -> ByteString
hashName Hash
h, Bool -> ByteString
iso9796Implicit Bool
imp]

iso9796Implicit :: Bool -> ByteString
iso9796Implicit :: Bool -> ByteString
iso9796Implicit = ByteString -> ByteString -> Bool -> ByteString
forall a. a -> a -> Bool -> a
bool ByteString
"exp" ByteString
"imp"

data SignatureFormat
    = StandardFormat
    | DERFormat
    deriving (Int -> SignatureFormat -> ShowS
[SignatureFormat] -> ShowS
SignatureFormat -> String
(Int -> SignatureFormat -> ShowS)
-> (SignatureFormat -> String)
-> ([SignatureFormat] -> ShowS)
-> Show SignatureFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignatureFormat -> ShowS
showsPrec :: Int -> SignatureFormat -> ShowS
$cshow :: SignatureFormat -> String
show :: SignatureFormat -> String
$cshowList :: [SignatureFormat] -> ShowS
showList :: [SignatureFormat] -> ShowS
Show, SignatureFormat -> SignatureFormat -> Bool
(SignatureFormat -> SignatureFormat -> Bool)
-> (SignatureFormat -> SignatureFormat -> Bool)
-> Eq SignatureFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignatureFormat -> SignatureFormat -> Bool
== :: SignatureFormat -> SignatureFormat -> Bool
$c/= :: SignatureFormat -> SignatureFormat -> Bool
/= :: SignatureFormat -> SignatureFormat -> Bool
Eq)

signatureFormatFlag :: SignatureFormat -> Low.SigningFlags
signatureFormatFlag :: SignatureFormat -> PKSignatureFormat
signatureFormatFlag SignatureFormat
StandardFormat    = PKSignatureFormat
Low.StandardFormatSignature -- BOTAN_PUBKEY_SIGNING_FLAGS_NONE
signatureFormatFlag SignatureFormat
DERFormat = PKSignatureFormat
Low.DERFormatSignature -- BOTAN_PUBKEY_DER_FORMAT_SIGNATURE