{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{- | High-level signing monad transformer for OpenPGP.

'SigningT' wraps a 'TK' 'SecretTK' and provides a
unified interface for creating signatures with any
signing-capable subkey or the primary key.

It handles key selection, payload construction
and signature generation.
-}
module Codec.Encryption.OpenPGP.Signing
    ( -- * SigningT transformer
      SigningT
    , runSigningT

      -- * Signing target selection
    , SigningTarget (..)
    , AvailableSigner (..)
    , listAvailableSigners
    , filterSigningCapable
    , filterByKeyId
    , filterByFingerprint

      -- * Signing payloads
    , SigningPayload (..)

      -- * Low-level signing
    , signWith

      -- * High-level signing operations
    , signUserId
    , signUat

      -- * Timestamp control
    , getCurrentTimestamp
    , setCurrentTimestamp
    , withTimestamp
    ) where

import Control.Monad (guard)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
import Control.Monad.Trans.RWS
    ( RWST (..)
    , ask
    , get
    , put
    , runRWST
    )
import Crypto.Error (eitherCryptoError)
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.Ed448 as Ed448
import qualified Crypto.PubKey.RSA.Types as RSATypes
import Crypto.Random.Types (MonadRandom)
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.List (find)
import Data.Maybe (listToMaybe)
import qualified Data.Set as Set
import Data.Text (Text)

import Codec.Encryption.OpenPGP.Fingerprint
    ( eightOctetKeyID
    , fingerprint
    )
import Codec.Encryption.OpenPGP.SignatureQualities
    ( signatureHashedSubpacketsKnown
    )
import Codec.Encryption.OpenPGP.Signatures
    ( payloadForCertRevocation
    , payloadForDirectKey
    , payloadForSubkeyBinding
    , payloadForSubkeyRevocation
    , payloadForUat
    , payloadForUserId
    , randomSignatureSalt
    , signDataWithEd25519
    , signDataWithEd25519V6
    , signDataWithEd448
    , signDataWithEd448V6
    , signDataWithRSA
    , signDataWithRSAV6
    )
import Codec.Encryption.OpenPGP.Types
import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA

-- | The signing monad transformer.
newtype SigningT (tk :: TKKind) m a = SigningT
    { forall (tk :: TKKind) (m :: * -> *) a.
SigningT tk m a
-> ExceptT
     SigningError (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m) a
unSigningT
        :: ExceptT
            SigningError
            ( RWST
                (TK 'SecretTK)
                [Text]
                ThirtyTwoBitTimeStamp
                m
            )
            a
    }
    deriving newtype (Functor (SigningT tk m)
Functor (SigningT tk m) =>
(forall a. a -> SigningT tk m a)
-> (forall a b.
    SigningT tk m (a -> b) -> SigningT tk m a -> SigningT tk m b)
-> (forall a b c.
    (a -> b -> c)
    -> SigningT tk m a -> SigningT tk m b -> SigningT tk m c)
-> (forall a b.
    SigningT tk m a -> SigningT tk m b -> SigningT tk m b)
-> (forall a b.
    SigningT tk m a -> SigningT tk m b -> SigningT tk m a)
-> Applicative (SigningT tk m)
forall a. a -> SigningT tk m a
forall a b. SigningT tk m a -> SigningT tk m b -> SigningT tk m a
forall a b. SigningT tk m a -> SigningT tk m b -> SigningT tk m b
forall a b.
SigningT tk m (a -> b) -> SigningT tk m a -> SigningT tk m b
forall a b c.
(a -> b -> c)
-> SigningT tk m a -> SigningT tk m b -> SigningT tk m c
forall (tk :: TKKind) (m :: * -> *).
Monad m =>
Functor (SigningT tk m)
forall (tk :: TKKind) (m :: * -> *) a.
Monad m =>
a -> SigningT tk m a
forall (tk :: TKKind) (m :: * -> *) a b.
Monad m =>
SigningT tk m a -> SigningT tk m b -> SigningT tk m a
forall (tk :: TKKind) (m :: * -> *) a b.
Monad m =>
SigningT tk m a -> SigningT tk m b -> SigningT tk m b
forall (tk :: TKKind) (m :: * -> *) a b.
Monad m =>
SigningT tk m (a -> b) -> SigningT tk m a -> SigningT tk m b
forall (tk :: TKKind) (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> SigningT tk m a -> SigningT tk m b -> SigningT tk m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (tk :: TKKind) (m :: * -> *) a.
Monad m =>
a -> SigningT tk m a
pure :: forall a. a -> SigningT tk m a
$c<*> :: forall (tk :: TKKind) (m :: * -> *) a b.
Monad m =>
SigningT tk m (a -> b) -> SigningT tk m a -> SigningT tk m b
<*> :: forall a b.
SigningT tk m (a -> b) -> SigningT tk m a -> SigningT tk m b
$cliftA2 :: forall (tk :: TKKind) (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> SigningT tk m a -> SigningT tk m b -> SigningT tk m c
liftA2 :: forall a b c.
(a -> b -> c)
-> SigningT tk m a -> SigningT tk m b -> SigningT tk m c
$c*> :: forall (tk :: TKKind) (m :: * -> *) a b.
Monad m =>
SigningT tk m a -> SigningT tk m b -> SigningT tk m b
*> :: forall a b. SigningT tk m a -> SigningT tk m b -> SigningT tk m b
$c<* :: forall (tk :: TKKind) (m :: * -> *) a b.
Monad m =>
SigningT tk m a -> SigningT tk m b -> SigningT tk m a
<* :: forall a b. SigningT tk m a -> SigningT tk m b -> SigningT tk m a
Applicative, (forall a b. (a -> b) -> SigningT tk m a -> SigningT tk m b)
-> (forall a b. a -> SigningT tk m b -> SigningT tk m a)
-> Functor (SigningT tk m)
forall a b. a -> SigningT tk m b -> SigningT tk m a
forall a b. (a -> b) -> SigningT tk m a -> SigningT tk m b
forall (tk :: TKKind) (m :: * -> *) a b.
Functor m =>
a -> SigningT tk m b -> SigningT tk m a
forall (tk :: TKKind) (m :: * -> *) a b.
Functor m =>
(a -> b) -> SigningT tk m a -> SigningT tk m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (tk :: TKKind) (m :: * -> *) a b.
Functor m =>
(a -> b) -> SigningT tk m a -> SigningT tk m b
fmap :: forall a b. (a -> b) -> SigningT tk m a -> SigningT tk m b
$c<$ :: forall (tk :: TKKind) (m :: * -> *) a b.
Functor m =>
a -> SigningT tk m b -> SigningT tk m a
<$ :: forall a b. a -> SigningT tk m b -> SigningT tk m a
Functor, Applicative (SigningT tk m)
Applicative (SigningT tk m) =>
(forall a b.
 SigningT tk m a -> (a -> SigningT tk m b) -> SigningT tk m b)
-> (forall a b.
    SigningT tk m a -> SigningT tk m b -> SigningT tk m b)
-> (forall a. a -> SigningT tk m a)
-> Monad (SigningT tk m)
forall a. a -> SigningT tk m a
forall a b. SigningT tk m a -> SigningT tk m b -> SigningT tk m b
forall a b.
SigningT tk m a -> (a -> SigningT tk m b) -> SigningT tk m b
forall (tk :: TKKind) (m :: * -> *).
Monad m =>
Applicative (SigningT tk m)
forall (tk :: TKKind) (m :: * -> *) a.
Monad m =>
a -> SigningT tk m a
forall (tk :: TKKind) (m :: * -> *) a b.
Monad m =>
SigningT tk m a -> SigningT tk m b -> SigningT tk m b
forall (tk :: TKKind) (m :: * -> *) a b.
Monad m =>
SigningT tk m a -> (a -> SigningT tk m b) -> SigningT tk m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (tk :: TKKind) (m :: * -> *) a b.
Monad m =>
SigningT tk m a -> (a -> SigningT tk m b) -> SigningT tk m b
>>= :: forall a b.
SigningT tk m a -> (a -> SigningT tk m b) -> SigningT tk m b
$c>> :: forall (tk :: TKKind) (m :: * -> *) a b.
Monad m =>
SigningT tk m a -> SigningT tk m b -> SigningT tk m b
>> :: forall a b. SigningT tk m a -> SigningT tk m b -> SigningT tk m b
$creturn :: forall (tk :: TKKind) (m :: * -> *) a.
Monad m =>
a -> SigningT tk m a
return :: forall a. a -> SigningT tk m a
Monad)

-- | Run a 'SigningT' action.
runSigningT
    :: Monad m
    => TK 'SecretTK
    -- ^ The secret transferable key to sign with
    -> ThirtyTwoBitTimeStamp
    -- ^ Initial timestamp
    -> SigningT 'SecretTK m a
    -- ^ Action to run
    -> m (Either SigningError a)
runSigningT :: forall (m :: * -> *) a.
Monad m =>
TK 'SecretTK
-> ThirtyTwoBitTimeStamp
-> SigningT 'SecretTK m a
-> m (Either SigningError a)
runSigningT TK 'SecretTK
tk ThirtyTwoBitTimeStamp
ts (SigningT ExceptT
  SigningError (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m) a
action) =
    (RWST
  (TK 'SecretTK)
  [Text]
  ThirtyTwoBitTimeStamp
  m
  (Either SigningError a)
-> TK 'SecretTK
-> ThirtyTwoBitTimeStamp
-> m (Either SigningError a, ThirtyTwoBitTimeStamp, [Text])
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (ExceptT
  SigningError (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m) a
-> RWST
     (TK 'SecretTK)
     [Text]
     ThirtyTwoBitTimeStamp
     m
     (Either SigningError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT
  SigningError (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m) a
action) TK 'SecretTK
tk) ThirtyTwoBitTimeStamp
ts m (Either SigningError a, ThirtyTwoBitTimeStamp, [Text])
-> ((Either SigningError a, ThirtyTwoBitTimeStamp, [Text])
    -> m (Either SigningError a))
-> m (Either SigningError a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Either SigningError a
e, ThirtyTwoBitTimeStamp
_, [Text]
_) -> Either SigningError a -> m (Either SigningError a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Either SigningError a
e

-- | Which key to sign with.
data SigningTarget
    = SignWithPrimary
    | SignWithKey !PKA.EightOctetKeyId
    | SignWithBest
    | SignWithBestFilter !(AvailableSigner -> Bool)

-- | A signing-capable key extracted from a 'TK'.
data AvailableSigner = AvailableSigner
    { AvailableSigner -> EightOctetKeyId
asKeyId :: !PKA.EightOctetKeyId
    , AvailableSigner -> Fingerprint
asFingerprint :: !PKA.Fingerprint
    , AvailableSigner -> KeyPkt 'SecretPkt
asKeyPacket :: !(KeyPkt 'SecretPkt)
    , AvailableSigner -> SKey
asSKey :: !SKey
    , AvailableSigner -> Bool
asIsPrimary :: !Bool
    , AvailableSigner -> Set KeyFlag
asUsage :: !(Set.Set KeyFlag)
    }

signingCapableFlags :: Set.Set KeyFlag
signingCapableFlags :: Set KeyFlag
signingCapableFlags = [KeyFlag] -> Set KeyFlag
forall a. Ord a => [a] -> Set a
Set.fromList [KeyFlag
SignDataKey, KeyFlag
CertifyKeysKey, KeyFlag
AuthKey]

isSigningCapable :: Set.Set KeyFlag -> Bool
isSigningCapable :: Set KeyFlag -> Bool
isSigningCapable Set KeyFlag
usage = Bool -> Bool
not (Set KeyFlag -> Bool
forall a. Set a -> Bool
Set.null (Set KeyFlag -> Set KeyFlag -> Set KeyFlag
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set KeyFlag
usage Set KeyFlag
signingCapableFlags))

-- | List all signing-capable keys from a 'TK' 'SecretTK'.
listAvailableSigners :: TK 'SecretTK -> [AvailableSigner]
listAvailableSigners :: TK 'SecretTK -> [AvailableSigner]
listAvailableSigners TK 'SecretTK
tk =
    AvailableSigner
primary AvailableSigner -> [AvailableSigner] -> [AvailableSigner]
forall a. a -> [a] -> [a]
: [AvailableSigner]
subs
  where
    primaryKp :: KeyPkt (TKKindToKeyPktKind 'SecretTK)
primaryKp = TK 'SecretTK -> KeyPkt (TKKindToKeyPktKind 'SecretTK)
forall (k :: TKKind). TK k -> KeyPkt (TKKindToKeyPktKind k)
_tkPrimaryKey TK 'SecretTK
tk
    primaryPkp :: SomePKPayload
primaryPkp = KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'SecretPkt
KeyPkt (TKKindToKeyPktKind 'SecretTK)
primaryKp
    primarySka :: SKAddendum
primarySka = KeyPkt 'SecretPkt -> SKAddendum
secretKeyPktSKAddendum KeyPkt 'SecretPkt
KeyPkt (TKKindToKeyPktKind 'SecretTK)
primaryKp
    primaryUsage :: Set KeyFlag
primaryUsage =
        (Set KeyFlag -> Set KeyFlag -> Set KeyFlag)
-> Set KeyFlag -> [Set KeyFlag] -> Set KeyFlag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            Set KeyFlag -> Set KeyFlag -> Set KeyFlag
forall a. Ord a => Set a -> Set a -> Set a
Set.union
            Set KeyFlag
forall a. Set a
Set.empty
            ((SignaturePayload -> Set KeyFlag)
-> [SignaturePayload] -> [Set KeyFlag]
forall a b. (a -> b) -> [a] -> [b]
map SignaturePayload -> Set KeyFlag
sigFlags (TK 'SecretTK -> [SignaturePayload]
forall (k :: TKKind). TK k -> [SignaturePayload]
_tkDirectKeySigs TK 'SecretTK
tk [SignaturePayload] -> [SignaturePayload] -> [SignaturePayload]
forall a. [a] -> [a] -> [a]
++ TK 'SecretTK -> [SignaturePayload]
forall (k :: TKKind). TK k -> [SignaturePayload]
_tkRevs TK 'SecretTK
tk))
    primary :: AvailableSigner
primary =
        AvailableSigner
            { asKeyId :: EightOctetKeyId
asKeyId = (KeyIdError -> EightOctetKeyId)
-> (EightOctetKeyId -> EightOctetKeyId)
-> Either KeyIdError EightOctetKeyId
-> EightOctetKeyId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> EightOctetKeyId
forall a. HasCallStack => [Char] -> a
error ([Char] -> EightOctetKeyId)
-> (KeyIdError -> [Char]) -> KeyIdError -> EightOctetKeyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyIdError -> [Char]
forall a. Show a => a -> [Char]
show) EightOctetKeyId -> EightOctetKeyId
forall a. a -> a
id (SomePKPayload -> Either KeyIdError EightOctetKeyId
eightOctetKeyID SomePKPayload
primaryPkp)
            , asFingerprint :: Fingerprint
asFingerprint = SomePKPayload -> Fingerprint
fingerprint SomePKPayload
primaryPkp
            , asKeyPacket :: KeyPkt 'SecretPkt
asKeyPacket = KeyPkt 'SecretPkt
KeyPkt (TKKindToKeyPktKind 'SecretTK)
primaryKp
            , asSKey :: SKey
asSKey = case SKAddendum
primarySka of
                SUSUnprotected SKey
sk Word16
_ -> SKey
sk
                SKAddendum
_ -> [Char] -> SKey
forall a. HasCallStack => [Char] -> a
error [Char]
"encrypted secret key not supported in SigningT"
            , asIsPrimary :: Bool
asIsPrimary = Bool
True
            , asUsage :: Set KeyFlag
asUsage = Set KeyFlag
primaryUsage
            }
    subs :: [AvailableSigner]
subs = do
        (subKp, subSigs) <- TK 'SecretTK
-> [(KeyPkt (TKKindToKeyPktKind 'SecretTK), [SignaturePayload])]
forall (k :: TKKind).
TK k -> [(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])]
_tkSubs TK 'SecretTK
tk
        let subPkp = KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'SecretPkt
subKp
            subSka = KeyPkt 'SecretPkt -> SKAddendum
secretKeyPktSKAddendum KeyPkt 'SecretPkt
subKp
            subUsage = (Set KeyFlag -> Set KeyFlag -> Set KeyFlag)
-> Set KeyFlag -> [Set KeyFlag] -> Set KeyFlag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set KeyFlag -> Set KeyFlag -> Set KeyFlag
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set KeyFlag
forall a. Set a
Set.empty ((SignaturePayload -> Set KeyFlag)
-> [SignaturePayload] -> [Set KeyFlag]
forall a b. (a -> b) -> [a] -> [b]
map SignaturePayload -> Set KeyFlag
sigFlags [SignaturePayload]
subSigs)
        guard (isSigningCapable subUsage)
        pure
            AvailableSigner
                { asKeyId = either (error . show) id (eightOctetKeyID subPkp)
                , asFingerprint = fingerprint subPkp
                , asKeyPacket = subKp
                , asSKey = case subSka of
                    SUSUnprotected SKey
sk Word16
_ -> SKey
sk
                    SKAddendum
_ -> [Char] -> SKey
forall a. HasCallStack => [Char] -> a
error [Char]
"encrypted secret key not supported in SigningT"
                , asIsPrimary = False
                , asUsage = subUsage
                }
    sigFlags :: SignaturePayload -> Set KeyFlag
sigFlags SignaturePayload
sig = case SignaturePayload -> Maybe [SigSubPacket]
signatureHashedSubpacketsKnown SignaturePayload
sig of
        Maybe [SigSubPacket]
Nothing -> Set KeyFlag
forall a. Set a
Set.empty
        Just [SigSubPacket]
hs -> (Set KeyFlag -> Set KeyFlag -> Set KeyFlag)
-> Set KeyFlag -> [Set KeyFlag] -> Set KeyFlag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set KeyFlag -> Set KeyFlag -> Set KeyFlag
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set KeyFlag
forall a. Set a
Set.empty ((SigSubPacket -> Set KeyFlag) -> [SigSubPacket] -> [Set KeyFlag]
forall a b. (a -> b) -> [a] -> [b]
map SigSubPacket -> Set KeyFlag
goSub [SigSubPacket]
hs)
    goSub :: SigSubPacket -> Set KeyFlag
goSub (SigSubPacket Bool
_ (KeyFlags Set KeyFlag
flags)) = Set KeyFlag
flags
    goSub SigSubPacket
_ = Set KeyFlag
forall a. Set a
Set.empty

-- | A typed signing payload.
data SigningPayload
    = SPUserId !SigType !UserId
    | SPUat !SigType !UserAttribute
    | SPDirectKey
    | SPKeyRevocation
    | SPSubkeyRevocation !(KeyPkt 'PublicPkt)
    | SPCertRevocation !UserId
    | SPSignSubkeyBinding !(KeyPkt 'PublicPkt)
    | SPPrimaryKeyBinding !(KeyPkt 'PublicPkt)
    | SPRaw !SigType !ByteString
    deriving (SigningPayload -> SigningPayload -> Bool
(SigningPayload -> SigningPayload -> Bool)
-> (SigningPayload -> SigningPayload -> Bool) -> Eq SigningPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigningPayload -> SigningPayload -> Bool
== :: SigningPayload -> SigningPayload -> Bool
$c/= :: SigningPayload -> SigningPayload -> Bool
/= :: SigningPayload -> SigningPayload -> Bool
Eq, Int -> SigningPayload -> ShowS
[SigningPayload] -> ShowS
SigningPayload -> [Char]
(Int -> SigningPayload -> ShowS)
-> (SigningPayload -> [Char])
-> ([SigningPayload] -> ShowS)
-> Show SigningPayload
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningPayload -> ShowS
showsPrec :: Int -> SigningPayload -> ShowS
$cshow :: SigningPayload -> [Char]
show :: SigningPayload -> [Char]
$cshowList :: [SigningPayload] -> ShowS
showList :: [SigningPayload] -> ShowS
Show)

-- | Sign an arbitrary payload with a selected key.
signWith
    :: forall m
     . MonadRandom m
    => SigningTarget
    -> SigningPayload
    -> SigningT 'SecretTK m (Either SigningError SignaturePayload)
signWith :: forall (m :: * -> *).
MonadRandom m =>
SigningTarget
-> SigningPayload
-> SigningT 'SecretTK m (Either SigningError SignaturePayload)
signWith SigningTarget
target SigningPayload
payload = do
    tk <- ExceptT
  SigningError
  (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
  (TK 'SecretTK)
-> SigningT 'SecretTK m (TK 'SecretTK)
forall (tk :: TKKind) (m :: * -> *) a.
ExceptT
  SigningError (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m) a
-> SigningT tk m a
SigningT (ExceptT
   SigningError
   (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
   (TK 'SecretTK)
 -> SigningT 'SecretTK m (TK 'SecretTK))
-> (RWST
      (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m (TK 'SecretTK)
    -> ExceptT
         SigningError
         (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
         (TK 'SecretTK))
-> RWST
     (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m (TK 'SecretTK)
-> SigningT 'SecretTK m (TK 'SecretTK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m (TK 'SecretTK)
-> ExceptT
     SigningError
     (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
     (TK 'SecretTK)
forall (m :: * -> *) a. Monad m => m a -> ExceptT SigningError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m (TK 'SecretTK)
 -> SigningT 'SecretTK m (TK 'SecretTK))
-> RWST
     (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m (TK 'SecretTK)
-> SigningT 'SecretTK m (TK 'SecretTK)
forall a b. (a -> b) -> a -> b
$ RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m (TK 'SecretTK)
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
ask
    ts <- SigningT . lift $ get
    let signers = TK 'SecretTK -> [AvailableSigner]
listAvailableSigners TK 'SecretTK
tk
        selected = SigningTarget -> [AvailableSigner] -> Maybe AvailableSigner
resolveTarget SigningTarget
target [AvailableSigner]
signers
    case selected of
        Maybe AvailableSigner
Nothing -> Either SigningError SignaturePayload
-> SigningT 'SecretTK m (Either SigningError SignaturePayload)
forall a. a -> SigningT 'SecretTK m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SigningError SignaturePayload
 -> SigningT 'SecretTK m (Either SigningError SignaturePayload))
-> Either SigningError SignaturePayload
-> SigningT 'SecretTK m (Either SigningError SignaturePayload)
forall a b. (a -> b) -> a -> b
$ SigningError -> Either SigningError SignaturePayload
forall a b. a -> Either a b
Left (SigningTarget -> SigningError
signingErrorFromTarget SigningTarget
target)
        Just AvailableSigner
signer -> do
            let kp :: KeyPkt 'SecretPkt
kp = AvailableSigner -> KeyPkt 'SecretPkt
asKeyPacket AvailableSigner
signer
                ska :: SKey
ska = AvailableSigner -> SKey
asSKey AvailableSigner
signer
            ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> SKey
-> SigningPayload
-> SigningT 'SecretTK m (Either SigningError SignaturePayload)
forall (m :: * -> *).
(Monad m, MonadRandom m) =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> SKey
-> SigningPayload
-> SigningT 'SecretTK m (Either SigningError SignaturePayload)
signWithPayload ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp SKey
ska SigningPayload
payload

signWithPayload
    :: (Monad m, MonadRandom m)
    => ThirtyTwoBitTimeStamp
    -> KeyPkt 'SecretPkt
    -> SKey
    -> SigningPayload
    -> SigningT 'SecretTK m (Either SigningError SignaturePayload)
signWithPayload :: forall (m :: * -> *).
(Monad m, MonadRandom m) =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> SKey
-> SigningPayload
-> SigningT 'SecretTK m (Either SigningError SignaturePayload)
signWithPayload ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp SKey
ska SigningPayload
payload = do
    result <- ExceptT
  SigningError
  (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
  (Either SignError SignaturePayload)
-> SigningT 'SecretTK m (Either SignError SignaturePayload)
forall (tk :: TKKind) (m :: * -> *) a.
ExceptT
  SigningError (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m) a
-> SigningT tk m a
SigningT (ExceptT
   SigningError
   (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
   (Either SignError SignaturePayload)
 -> SigningT 'SecretTK m (Either SignError SignaturePayload))
-> ExceptT
     SigningError
     (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
     (Either SignError SignaturePayload)
-> SigningT 'SecretTK m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$ RWST
  (TK 'SecretTK)
  [Text]
  ThirtyTwoBitTimeStamp
  m
  (Either SignError SignaturePayload)
-> ExceptT
     SigningError
     (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
     (Either SignError SignaturePayload)
forall (m :: * -> *) a. Monad m => m a -> ExceptT SigningError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RWST
   (TK 'SecretTK)
   [Text]
   ThirtyTwoBitTimeStamp
   m
   (Either SignError SignaturePayload)
 -> ExceptT
      SigningError
      (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
      (Either SignError SignaturePayload))
-> RWST
     (TK 'SecretTK)
     [Text]
     ThirtyTwoBitTimeStamp
     m
     (Either SignError SignaturePayload)
-> ExceptT
     SigningError
     (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
     (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$ m (Either SignError SignaturePayload)
-> RWST
     (TK 'SecretTK)
     [Text]
     ThirtyTwoBitTimeStamp
     m
     (Either SignError SignaturePayload)
forall (m :: * -> *) a.
Monad m =>
m a -> RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either SignError SignaturePayload)
 -> RWST
      (TK 'SecretTK)
      [Text]
      ThirtyTwoBitTimeStamp
      m
      (Either SignError SignaturePayload))
-> m (Either SignError SignaturePayload)
-> RWST
     (TK 'SecretTK)
     [Text]
     ThirtyTwoBitTimeStamp
     m
     (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$ SKey -> m (Either SignError SignaturePayload)
go SKey
ska
    pure $ first SigningSignError result
  where
    go :: SKey -> m (Either SignError SignaturePayload)
go SKey
_ska = case KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'SecretPkt
kp of
        PKPayload KeyVersion
V4 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
pka PKey
_ -> PubKeyAlgorithm -> m (Either SignError SignaturePayload)
goV4 PubKeyAlgorithm
pka
        PKPayload KeyVersion
V6 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
pka PKey
_ -> PubKeyAlgorithm -> m (Either SignError SignaturePayload)
goV6 PubKeyAlgorithm
pka
        PKPayload KeyVersion
DeprecatedV3 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
pka PKey
_ -> PubKeyAlgorithm -> m (Either SignError SignaturePayload)
goV4 PubKeyAlgorithm
pka
    goV4 :: PubKeyAlgorithm -> m (Either SignError SignaturePayload)
goV4 PubKeyAlgorithm
pka = case (PubKeyAlgorithm
pka, SKey
ska) of
        (PubKeyAlgorithm
RSA, RSAPrivateKey RSA_PrivateKey
rsaPriv) -> ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> PrivateKey
-> SigningPayload
-> m (Either SignError SignaturePayload)
forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> PrivateKey
-> SigningPayload
-> m (Either SignError SignaturePayload)
signRSA ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp (RSA_PrivateKey -> PrivateKey
unRSA_PrivateKey RSA_PrivateKey
rsaPriv) SigningPayload
payload
        (PubKeyAlgorithm
EdDSALegacy, EdDSAPrivateKey EdSigningCurve
EdSigningCurve25519 ByteString
bs) ->
            ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
signEd25519V4 ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp ByteString
bs SigningPayload
payload
        (PubKeyAlgorithm
EdDSALegacy, Ed25519PrivateKey ByteString
bs) ->
            ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
signEd25519V4 ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp ByteString
bs SigningPayload
payload
        (PubKeyAlgorithm
Ed448, EdDSAPrivateKey EdSigningCurve
EdSigningCurve448 ByteString
bs) ->
            ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
signEd448V4 ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp ByteString
bs SigningPayload
payload
        (PubKeyAlgorithm
Ed448, Ed448PrivateKey ByteString
bs) ->
            ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
signEd448V4 ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp ByteString
bs SigningPayload
payload
        (PubKeyAlgorithm, SKey)
_ ->
            Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> m (Either SignError SignaturePayload))
-> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$
                SignError -> Either SignError SignaturePayload
forall a b. a -> Either a b
Left (PubKeyAlgorithm -> SignError
SignBackendErrorUnsupportedKeyTypeV4 PubKeyAlgorithm
pka)
    goV6 :: PubKeyAlgorithm -> m (Either SignError SignaturePayload)
goV6 PubKeyAlgorithm
pka = case (PubKeyAlgorithm
pka, SKey
ska) of
        (PubKeyAlgorithm
RSA, RSAPrivateKey RSA_PrivateKey
rsaPriv) -> ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> PrivateKey
-> SigningPayload
-> m (Either SignError SignaturePayload)
forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> PrivateKey
-> SigningPayload
-> m (Either SignError SignaturePayload)
signRSA ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp (RSA_PrivateKey -> PrivateKey
unRSA_PrivateKey RSA_PrivateKey
rsaPriv) SigningPayload
payload
        (PubKeyAlgorithm
Ed25519, EdDSAPrivateKey EdSigningCurve
EdSigningCurve25519 ByteString
bs) ->
            ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
signEd25519V6 ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp ByteString
bs SigningPayload
payload
        (PubKeyAlgorithm
Ed25519, Ed25519PrivateKey ByteString
bs) ->
            ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
signEd25519V6 ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp ByteString
bs SigningPayload
payload
        (PubKeyAlgorithm
Ed448, EdDSAPrivateKey EdSigningCurve
EdSigningCurve448 ByteString
bs) ->
            ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
signEd448V6 ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp ByteString
bs SigningPayload
payload
        (PubKeyAlgorithm
Ed448, Ed448PrivateKey ByteString
bs) ->
            ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
signEd448V6 ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp ByteString
bs SigningPayload
payload
        (PubKeyAlgorithm, SKey)
_ ->
            Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> m (Either SignError SignaturePayload))
-> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$
                SignError -> Either SignError SignaturePayload
forall a b. a -> Either a b
Left (PubKeyAlgorithm -> SignError
SignBackendErrorUnsupportedKeyTypeV6 PubKeyAlgorithm
pka)

signRSA
    :: MonadRandom m
    => ThirtyTwoBitTimeStamp
    -> KeyPkt 'SecretPkt
    -> RSATypes.PrivateKey
    -> SigningPayload
    -> m (Either SignError SignaturePayload)
signRSA :: forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> PrivateKey
-> SigningPayload
-> m (Either SignError SignaturePayload)
signRSA ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp PrivateKey
p SigningPayload
payload =
    case KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'SecretPkt
kp of
        PKPayload KeyVersion
V4 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
_ PKey
_ -> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> m (Either SignError SignaturePayload))
-> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$ SigningPayload -> Either SignError SignaturePayload
goV4 SigningPayload
payload
        PKPayload KeyVersion
V6 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
_ PKey
_ -> do
            salt <- HashAlgorithm -> m SignatureSalt
forall (m :: * -> *).
MonadRandom m =>
HashAlgorithm -> m SignatureSalt
randomSignatureSalt HashAlgorithm
ha
            pure $ goV6 salt payload
        PKPayload KeyVersion
DeprecatedV3 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
_ PKey
_ -> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> m (Either SignError SignaturePayload))
-> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$ SigningPayload -> Either SignError SignaturePayload
goV4 SigningPayload
payload
  where
    ha :: HashAlgorithm
ha = HashAlgorithm
SHA512
    hashed :: [SigSubPacket]
hashed = [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True (ThirtyTwoBitTimeStamp -> SigSubPacketPayload
SigCreationTime ThirtyTwoBitTimeStamp
ts)]
    unhashed :: [a]
unhashed = []
    goV4 :: SigningPayload -> Either SignError SignaturePayload
goV4 = KeyPkt 'SecretPkt
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> SigningPayload
-> Either SignError SignaturePayload
signPayloadWithRSA KeyPkt 'SecretPkt
kp HashAlgorithm
ha [SigSubPacket]
hashed [SigSubPacket]
forall a. [a]
unhashed PrivateKey
p
    goV6 :: SignatureSalt
-> SigningPayload -> Either SignError SignaturePayload
goV6 SignatureSalt
salt = KeyPkt 'SecretPkt
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> SigningPayload
-> Either SignError SignaturePayload
signPayloadWithRSAV6 KeyPkt 'SecretPkt
kp HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
hashed [SigSubPacket]
forall a. [a]
unhashed PrivateKey
p

signEd25519V4
    :: MonadRandom m
    => ThirtyTwoBitTimeStamp
    -> KeyPkt 'SecretPkt
    -> ByteString
    -> SigningPayload
    -> m (Either SignError SignaturePayload)
signEd25519V4 :: forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
signEd25519V4 ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp ByteString
bs SigningPayload
payload =
    case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError (ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ByteString
bs) of
        Left CryptoError
err -> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> m (Either SignError SignaturePayload))
-> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$ SignError -> Either SignError SignaturePayload
forall a b. a -> Either a b
Left (CryptoError -> SignError
SignBackendErrorCrypto CryptoError
err)
        Right SecretKey
sk ->
            let ha :: HashAlgorithm
ha = HashAlgorithm
SHA512
                hashed :: [SigSubPacket]
hashed = [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True (ThirtyTwoBitTimeStamp -> SigSubPacketPayload
SigCreationTime ThirtyTwoBitTimeStamp
ts)]
                unhashed :: [a]
unhashed = []
             in Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> m (Either SignError SignaturePayload))
-> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$ KeyPkt 'SecretPkt
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> SecretKey
-> SigningPayload
-> Either SignError SignaturePayload
signPayloadWithEd25519 KeyPkt 'SecretPkt
kp HashAlgorithm
ha [SigSubPacket]
hashed [SigSubPacket]
forall a. [a]
unhashed SecretKey
sk SigningPayload
payload

signEd25519V6
    :: MonadRandom m
    => ThirtyTwoBitTimeStamp
    -> KeyPkt 'SecretPkt
    -> ByteString
    -> SigningPayload
    -> m (Either SignError SignaturePayload)
signEd25519V6 :: forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
signEd25519V6 ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp ByteString
bs SigningPayload
payload = do
    let ha :: HashAlgorithm
ha = HashAlgorithm
SHA512
    salt <- HashAlgorithm -> m SignatureSalt
forall (m :: * -> *).
MonadRandom m =>
HashAlgorithm -> m SignatureSalt
randomSignatureSalt HashAlgorithm
ha
    case eitherCryptoError (Ed25519.secretKey bs) of
        Left CryptoError
err -> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> m (Either SignError SignaturePayload))
-> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$ SignError -> Either SignError SignaturePayload
forall a b. a -> Either a b
Left (CryptoError -> SignError
SignBackendErrorCrypto CryptoError
err)
        Right SecretKey
sk ->
            let hashed :: [SigSubPacket]
hashed = [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True (ThirtyTwoBitTimeStamp -> SigSubPacketPayload
SigCreationTime ThirtyTwoBitTimeStamp
ts)]
                unhashed :: [a]
unhashed = []
             in Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> m (Either SignError SignaturePayload))
-> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$
                    KeyPkt 'SecretPkt
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> SecretKey
-> SigningPayload
-> Either SignError SignaturePayload
signPayloadWithEd25519V6 KeyPkt 'SecretPkt
kp HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
hashed [SigSubPacket]
forall a. [a]
unhashed SecretKey
sk SigningPayload
payload

signEd448V4
    :: MonadRandom m
    => ThirtyTwoBitTimeStamp
    -> KeyPkt 'SecretPkt
    -> ByteString
    -> SigningPayload
    -> m (Either SignError SignaturePayload)
signEd448V4 :: forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
signEd448V4 ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp ByteString
bs SigningPayload
payload =
    case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError (ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey ByteString
bs) of
        Left CryptoError
err -> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> m (Either SignError SignaturePayload))
-> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$ SignError -> Either SignError SignaturePayload
forall a b. a -> Either a b
Left (CryptoError -> SignError
SignBackendErrorCrypto CryptoError
err)
        Right SecretKey
sk ->
            let ha :: HashAlgorithm
ha = HashAlgorithm
SHA512
                hashed :: [SigSubPacket]
hashed = [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True (ThirtyTwoBitTimeStamp -> SigSubPacketPayload
SigCreationTime ThirtyTwoBitTimeStamp
ts)]
                unhashed :: [a]
unhashed = []
             in Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> m (Either SignError SignaturePayload))
-> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$ KeyPkt 'SecretPkt
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> SecretKey
-> SigningPayload
-> Either SignError SignaturePayload
signPayloadWithEd448 KeyPkt 'SecretPkt
kp HashAlgorithm
ha [SigSubPacket]
hashed [SigSubPacket]
forall a. [a]
unhashed SecretKey
sk SigningPayload
payload

signEd448V6
    :: MonadRandom m
    => ThirtyTwoBitTimeStamp
    -> KeyPkt 'SecretPkt
    -> ByteString
    -> SigningPayload
    -> m (Either SignError SignaturePayload)
signEd448V6 :: forall (m :: * -> *).
MonadRandom m =>
ThirtyTwoBitTimeStamp
-> KeyPkt 'SecretPkt
-> ByteString
-> SigningPayload
-> m (Either SignError SignaturePayload)
signEd448V6 ThirtyTwoBitTimeStamp
ts KeyPkt 'SecretPkt
kp ByteString
bs SigningPayload
payload = do
    let ha :: HashAlgorithm
ha = HashAlgorithm
SHA512
    salt <- HashAlgorithm -> m SignatureSalt
forall (m :: * -> *).
MonadRandom m =>
HashAlgorithm -> m SignatureSalt
randomSignatureSalt HashAlgorithm
ha
    case eitherCryptoError (Ed448.secretKey bs) of
        Left CryptoError
err -> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> m (Either SignError SignaturePayload))
-> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$ SignError -> Either SignError SignaturePayload
forall a b. a -> Either a b
Left (CryptoError -> SignError
SignBackendErrorCrypto CryptoError
err)
        Right SecretKey
sk ->
            let hashed :: [SigSubPacket]
hashed = [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True (ThirtyTwoBitTimeStamp -> SigSubPacketPayload
SigCreationTime ThirtyTwoBitTimeStamp
ts)]
                unhashed :: [a]
unhashed = []
             in Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> m (Either SignError SignaturePayload))
-> Either SignError SignaturePayload
-> m (Either SignError SignaturePayload)
forall a b. (a -> b) -> a -> b
$
                    KeyPkt 'SecretPkt
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> SecretKey
-> SigningPayload
-> Either SignError SignaturePayload
signPayloadWithEd448V6 KeyPkt 'SecretPkt
kp HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
hashed [SigSubPacket]
forall a. [a]
unhashed SecretKey
sk SigningPayload
payload

signPayloadWithRSA
    :: KeyPkt 'SecretPkt
    -> HashAlgorithm
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> RSATypes.PrivateKey
    -> SigningPayload
    -> Either SignError SignaturePayload
signPayloadWithRSA :: KeyPkt 'SecretPkt
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> SigningPayload
-> Either SignError SignaturePayload
signPayloadWithRSA KeyPkt 'SecretPkt
kp HashAlgorithm
ha [SigSubPacket]
hs [SigSubPacket]
us PrivateKey
p SigningPayload
payload =
    case SigningPayload
payload of
        SPUserId SigType
st UserId
uid -> HashAlgorithm
-> SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA HashAlgorithm
ha SigType
st PrivateKey
p [SigSubPacket]
hs [SigSubPacket]
us (SomePKPayload -> UserId -> ByteString
payloadForUserId SomePKPayload
pkp UserId
uid)
        SPUat SigType
st UserAttribute
uat -> HashAlgorithm
-> SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA HashAlgorithm
ha SigType
st PrivateKey
p [SigSubPacket]
hs [SigSubPacket]
us (SomePKPayload -> UserAttribute -> ByteString
payloadForUat SomePKPayload
pkp UserAttribute
uat)
        SigningPayload
SPDirectKey ->
            HashAlgorithm
-> SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA
                HashAlgorithm
ha
                SigType
DirectKeySignature
                PrivateKey
p
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> ByteString
payloadForDirectKey SomePKPayload
pkp)
        SigningPayload
SPKeyRevocation ->
            HashAlgorithm
-> SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA
                HashAlgorithm
ha
                SigType
KeyRevocationSig
                PrivateKey
p
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> ByteString
payloadForDirectKey SomePKPayload
pkp)
        SPSubkeyRevocation KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA
                HashAlgorithm
ha
                SigType
SubkeyRevocationSig
                PrivateKey
p
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyRevocation SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPCertRevocation UserId
uid ->
            HashAlgorithm
-> SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA
                HashAlgorithm
ha
                SigType
CertRevocationSig
                PrivateKey
p
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> UserId -> ByteString
payloadForCertRevocation SomePKPayload
pkp UserId
uid)
        SPSignSubkeyBinding KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA
                HashAlgorithm
ha
                SigType
SubkeyBindingSig
                PrivateKey
p
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyBinding SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPPrimaryKeyBinding KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA
                HashAlgorithm
ha
                SigType
PrimaryKeyBindingSig
                PrivateKey
p
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyBinding SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPRaw SigType
st ByteString
raw -> HashAlgorithm
-> SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA HashAlgorithm
ha SigType
st PrivateKey
p [SigSubPacket]
hs [SigSubPacket]
us (ByteString -> ByteString
BL.fromStrict ByteString
raw)
  where
    pkp :: SomePKPayload
pkp = KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'SecretPkt
kp

signPayloadWithRSAV6
    :: KeyPkt 'SecretPkt
    -> HashAlgorithm
    -> SignatureSalt
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> RSATypes.PrivateKey
    -> SigningPayload
    -> Either SignError SignaturePayload
signPayloadWithRSAV6 :: KeyPkt 'SecretPkt
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> SigningPayload
-> Either SignError SignaturePayload
signPayloadWithRSAV6 KeyPkt 'SecretPkt
kp HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
hs [SigSubPacket]
us PrivateKey
p SigningPayload
payload =
    case SigningPayload
payload of
        SPUserId SigType
st UserId
uid ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSAV6 HashAlgorithm
ha SigType
st SignatureSalt
salt PrivateKey
p [SigSubPacket]
hs [SigSubPacket]
us (SomePKPayload -> UserId -> ByteString
payloadForUserId SomePKPayload
pkp UserId
uid)
        SPUat SigType
st UserAttribute
uat -> HashAlgorithm
-> SigType
-> SignatureSalt
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSAV6 HashAlgorithm
ha SigType
st SignatureSalt
salt PrivateKey
p [SigSubPacket]
hs [SigSubPacket]
us (SomePKPayload -> UserAttribute -> ByteString
payloadForUat SomePKPayload
pkp UserAttribute
uat)
        SigningPayload
SPDirectKey ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSAV6
                HashAlgorithm
ha
                SigType
DirectKeySignature
                SignatureSalt
salt
                PrivateKey
p
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> ByteString
payloadForDirectKey SomePKPayload
pkp)
        SigningPayload
SPKeyRevocation ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSAV6
                HashAlgorithm
ha
                SigType
KeyRevocationSig
                SignatureSalt
salt
                PrivateKey
p
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> ByteString
payloadForDirectKey SomePKPayload
pkp)
        SPSubkeyRevocation KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSAV6
                HashAlgorithm
ha
                SigType
SubkeyRevocationSig
                SignatureSalt
salt
                PrivateKey
p
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyRevocation SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPCertRevocation UserId
uid ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSAV6
                HashAlgorithm
ha
                SigType
CertRevocationSig
                SignatureSalt
salt
                PrivateKey
p
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> UserId -> ByteString
payloadForCertRevocation SomePKPayload
pkp UserId
uid)
        SPSignSubkeyBinding KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSAV6
                HashAlgorithm
ha
                SigType
SubkeyBindingSig
                SignatureSalt
salt
                PrivateKey
p
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyBinding SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPPrimaryKeyBinding KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSAV6
                HashAlgorithm
ha
                SigType
PrimaryKeyBindingSig
                SignatureSalt
salt
                PrivateKey
p
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyBinding SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPRaw SigType
st ByteString
raw -> HashAlgorithm
-> SigType
-> SignatureSalt
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSAV6 HashAlgorithm
ha SigType
st SignatureSalt
salt PrivateKey
p [SigSubPacket]
hs [SigSubPacket]
us (ByteString -> ByteString
BL.fromStrict ByteString
raw)
  where
    pkp :: SomePKPayload
pkp = KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'SecretPkt
kp

signPayloadWithEd25519
    :: KeyPkt 'SecretPkt
    -> HashAlgorithm
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> Ed25519.SecretKey
    -> SigningPayload
    -> Either SignError SignaturePayload
signPayloadWithEd25519 :: KeyPkt 'SecretPkt
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> SecretKey
-> SigningPayload
-> Either SignError SignaturePayload
signPayloadWithEd25519 KeyPkt 'SecretPkt
kp HashAlgorithm
ha [SigSubPacket]
hs [SigSubPacket]
us SecretKey
sk SigningPayload
payload =
    case SigningPayload
payload of
        SPUserId SigType
st UserId
uid -> HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519 HashAlgorithm
ha SigType
st SecretKey
sk [SigSubPacket]
hs [SigSubPacket]
us (SomePKPayload -> UserId -> ByteString
payloadForUserId SomePKPayload
pkp UserId
uid)
        SPUat SigType
st UserAttribute
uat -> HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519 HashAlgorithm
ha SigType
st SecretKey
sk [SigSubPacket]
hs [SigSubPacket]
us (SomePKPayload -> UserAttribute -> ByteString
payloadForUat SomePKPayload
pkp UserAttribute
uat)
        SigningPayload
SPDirectKey ->
            HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519
                HashAlgorithm
ha
                SigType
DirectKeySignature
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> ByteString
payloadForDirectKey SomePKPayload
pkp)
        SigningPayload
SPKeyRevocation ->
            HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519
                HashAlgorithm
ha
                SigType
KeyRevocationSig
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> ByteString
payloadForDirectKey SomePKPayload
pkp)
        SPSubkeyRevocation KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519
                HashAlgorithm
ha
                SigType
SubkeyRevocationSig
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyRevocation SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPCertRevocation UserId
uid ->
            HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519
                HashAlgorithm
ha
                SigType
CertRevocationSig
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> UserId -> ByteString
payloadForCertRevocation SomePKPayload
pkp UserId
uid)
        SPSignSubkeyBinding KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519
                HashAlgorithm
ha
                SigType
SubkeyBindingSig
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyBinding SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPPrimaryKeyBinding KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519
                HashAlgorithm
ha
                SigType
PrimaryKeyBindingSig
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyBinding SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPRaw SigType
st ByteString
raw -> HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519 HashAlgorithm
ha SigType
st SecretKey
sk [SigSubPacket]
hs [SigSubPacket]
us (ByteString -> ByteString
BL.fromStrict ByteString
raw)
  where
    pkp :: SomePKPayload
pkp = KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'SecretPkt
kp

signPayloadWithEd25519V6
    :: KeyPkt 'SecretPkt
    -> HashAlgorithm
    -> SignatureSalt
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> Ed25519.SecretKey
    -> SigningPayload
    -> Either SignError SignaturePayload
signPayloadWithEd25519V6 :: KeyPkt 'SecretPkt
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> SecretKey
-> SigningPayload
-> Either SignError SignaturePayload
signPayloadWithEd25519V6 KeyPkt 'SecretPkt
kp HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
hs [SigSubPacket]
us SecretKey
sk SigningPayload
payload =
    case SigningPayload
payload of
        SPUserId SigType
st UserId
uid ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519V6
                HashAlgorithm
ha
                SigType
st
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> UserId -> ByteString
payloadForUserId SomePKPayload
pkp UserId
uid)
        SPUat SigType
st UserAttribute
uat ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519V6 HashAlgorithm
ha SigType
st SignatureSalt
salt SecretKey
sk [SigSubPacket]
hs [SigSubPacket]
us (SomePKPayload -> UserAttribute -> ByteString
payloadForUat SomePKPayload
pkp UserAttribute
uat)
        SigningPayload
SPDirectKey ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519V6
                HashAlgorithm
ha
                SigType
DirectKeySignature
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> ByteString
payloadForDirectKey SomePKPayload
pkp)
        SigningPayload
SPKeyRevocation ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519V6
                HashAlgorithm
ha
                SigType
KeyRevocationSig
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> ByteString
payloadForDirectKey SomePKPayload
pkp)
        SPSubkeyRevocation KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519V6
                HashAlgorithm
ha
                SigType
SubkeyRevocationSig
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyRevocation SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPCertRevocation UserId
uid ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519V6
                HashAlgorithm
ha
                SigType
CertRevocationSig
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> UserId -> ByteString
payloadForCertRevocation SomePKPayload
pkp UserId
uid)
        SPSignSubkeyBinding KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519V6
                HashAlgorithm
ha
                SigType
SubkeyBindingSig
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyBinding SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPPrimaryKeyBinding KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519V6
                HashAlgorithm
ha
                SigType
PrimaryKeyBindingSig
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyBinding SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPRaw SigType
st ByteString
raw -> HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519V6 HashAlgorithm
ha SigType
st SignatureSalt
salt SecretKey
sk [SigSubPacket]
hs [SigSubPacket]
us (ByteString -> ByteString
BL.fromStrict ByteString
raw)
  where
    pkp :: SomePKPayload
pkp = KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'SecretPkt
kp

signPayloadWithEd448
    :: KeyPkt 'SecretPkt
    -> HashAlgorithm
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> Ed448.SecretKey
    -> SigningPayload
    -> Either SignError SignaturePayload
signPayloadWithEd448 :: KeyPkt 'SecretPkt
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> SecretKey
-> SigningPayload
-> Either SignError SignaturePayload
signPayloadWithEd448 KeyPkt 'SecretPkt
kp HashAlgorithm
ha [SigSubPacket]
hs [SigSubPacket]
us SecretKey
sk SigningPayload
payload =
    case SigningPayload
payload of
        SPUserId SigType
st UserId
uid -> HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448 HashAlgorithm
ha SigType
st SecretKey
sk [SigSubPacket]
hs [SigSubPacket]
us (SomePKPayload -> UserId -> ByteString
payloadForUserId SomePKPayload
pkp UserId
uid)
        SPUat SigType
st UserAttribute
uat -> HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448 HashAlgorithm
ha SigType
st SecretKey
sk [SigSubPacket]
hs [SigSubPacket]
us (SomePKPayload -> UserAttribute -> ByteString
payloadForUat SomePKPayload
pkp UserAttribute
uat)
        SigningPayload
SPDirectKey ->
            HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448
                HashAlgorithm
ha
                SigType
DirectKeySignature
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> ByteString
payloadForDirectKey SomePKPayload
pkp)
        SigningPayload
SPKeyRevocation ->
            HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448
                HashAlgorithm
ha
                SigType
KeyRevocationSig
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> ByteString
payloadForDirectKey SomePKPayload
pkp)
        SPSubkeyRevocation KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448
                HashAlgorithm
ha
                SigType
SubkeyRevocationSig
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyRevocation SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPCertRevocation UserId
uid ->
            HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448
                HashAlgorithm
ha
                SigType
CertRevocationSig
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> UserId -> ByteString
payloadForCertRevocation SomePKPayload
pkp UserId
uid)
        SPSignSubkeyBinding KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448
                HashAlgorithm
ha
                SigType
SubkeyBindingSig
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyBinding SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPPrimaryKeyBinding KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448
                HashAlgorithm
ha
                SigType
PrimaryKeyBindingSig
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyBinding SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPRaw SigType
st ByteString
raw -> HashAlgorithm
-> SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448 HashAlgorithm
ha SigType
st SecretKey
sk [SigSubPacket]
hs [SigSubPacket]
us (ByteString -> ByteString
BL.fromStrict ByteString
raw)
  where
    pkp :: SomePKPayload
pkp = KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'SecretPkt
kp

signPayloadWithEd448V6
    :: KeyPkt 'SecretPkt
    -> HashAlgorithm
    -> SignatureSalt
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> Ed448.SecretKey
    -> SigningPayload
    -> Either SignError SignaturePayload
signPayloadWithEd448V6 :: KeyPkt 'SecretPkt
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> SecretKey
-> SigningPayload
-> Either SignError SignaturePayload
signPayloadWithEd448V6 KeyPkt 'SecretPkt
kp HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
hs [SigSubPacket]
us SecretKey
sk SigningPayload
payload =
    case SigningPayload
payload of
        SPUserId SigType
st UserId
uid ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448V6
                HashAlgorithm
ha
                SigType
st
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> UserId -> ByteString
payloadForUserId SomePKPayload
pkp UserId
uid)
        SPUat SigType
st UserAttribute
uat ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448V6 HashAlgorithm
ha SigType
st SignatureSalt
salt SecretKey
sk [SigSubPacket]
hs [SigSubPacket]
us (SomePKPayload -> UserAttribute -> ByteString
payloadForUat SomePKPayload
pkp UserAttribute
uat)
        SigningPayload
SPDirectKey ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448V6
                HashAlgorithm
ha
                SigType
DirectKeySignature
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> ByteString
payloadForDirectKey SomePKPayload
pkp)
        SigningPayload
SPKeyRevocation ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448V6
                HashAlgorithm
ha
                SigType
KeyRevocationSig
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> ByteString
payloadForDirectKey SomePKPayload
pkp)
        SPSubkeyRevocation KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448V6
                HashAlgorithm
ha
                SigType
SubkeyRevocationSig
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyRevocation SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPCertRevocation UserId
uid ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448V6
                HashAlgorithm
ha
                SigType
CertRevocationSig
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> UserId -> ByteString
payloadForCertRevocation SomePKPayload
pkp UserId
uid)
        SPSignSubkeyBinding KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448V6
                HashAlgorithm
ha
                SigType
SubkeyBindingSig
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyBinding SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPPrimaryKeyBinding KeyPkt 'PublicPkt
subKp ->
            HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448V6
                HashAlgorithm
ha
                SigType
PrimaryKeyBindingSig
                SignatureSalt
salt
                SecretKey
sk
                [SigSubPacket]
hs
                [SigSubPacket]
us
                (SomePKPayload -> SomePKPayload -> ByteString
payloadForSubkeyBinding SomePKPayload
pkp (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'PublicPkt
subKp))
        SPRaw SigType
st ByteString
raw -> HashAlgorithm
-> SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448V6 HashAlgorithm
ha SigType
st SignatureSalt
salt SecretKey
sk [SigSubPacket]
hs [SigSubPacket]
us (ByteString -> ByteString
BL.fromStrict ByteString
raw)
  where
    pkp :: SomePKPayload
pkp = KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'SecretPkt
kp

signingErrorFromTarget :: SigningTarget -> SigningError
signingErrorFromTarget :: SigningTarget -> SigningError
signingErrorFromTarget SigningTarget
SignWithPrimary = SigningError
SigningNoSignersAvailable
signingErrorFromTarget (SignWithKey EightOctetKeyId
kid) = ByteString -> SigningError
SigningInvalidTarget (EightOctetKeyId -> ByteString
PKA.unEOKI EightOctetKeyId
kid)
signingErrorFromTarget SigningTarget
SignWithBest = SigningError
SigningNoSignersAvailable
signingErrorFromTarget (SignWithBestFilter AvailableSigner -> Bool
_) = SigningError
SigningNoSignersAvailable

resolveTarget
    :: SigningTarget -> [AvailableSigner] -> Maybe AvailableSigner
resolveTarget :: SigningTarget -> [AvailableSigner] -> Maybe AvailableSigner
resolveTarget SigningTarget
SignWithPrimary [AvailableSigner]
signers = [AvailableSigner] -> Maybe AvailableSigner
forall a. [a] -> Maybe a
listToMaybe ((AvailableSigner -> Bool) -> [AvailableSigner] -> [AvailableSigner]
forall a. (a -> Bool) -> [a] -> [a]
filter AvailableSigner -> Bool
asIsPrimary [AvailableSigner]
signers)
resolveTarget (SignWithKey EightOctetKeyId
kid) [AvailableSigner]
signers = (AvailableSigner -> Bool)
-> [AvailableSigner] -> Maybe AvailableSigner
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\AvailableSigner
s -> AvailableSigner -> EightOctetKeyId
asKeyId AvailableSigner
s EightOctetKeyId -> EightOctetKeyId -> Bool
forall a. Eq a => a -> a -> Bool
== EightOctetKeyId
kid) [AvailableSigner]
signers
resolveTarget SigningTarget
SignWithBest [AvailableSigner]
signers = [AvailableSigner] -> Maybe AvailableSigner
forall a. [a] -> Maybe a
listToMaybe [AvailableSigner]
signers
resolveTarget (SignWithBestFilter AvailableSigner -> Bool
p) [AvailableSigner]
signers = (AvailableSigner -> Bool)
-> [AvailableSigner] -> Maybe AvailableSigner
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find AvailableSigner -> Bool
p [AvailableSigner]
signers

-- | Sign a user ID with the primary key.
signUserId
    :: (MonadRandom m)
    => SigType
    -> UserId
    -> SigningT 'SecretTK m (Either SigningError SignaturePayload)
signUserId :: forall (m :: * -> *).
MonadRandom m =>
SigType
-> UserId
-> SigningT 'SecretTK m (Either SigningError SignaturePayload)
signUserId SigType
st UserId
uid = do
    result <- SigningTarget
-> SigningPayload
-> SigningT 'SecretTK m (Either SigningError SignaturePayload)
forall (m :: * -> *).
MonadRandom m =>
SigningTarget
-> SigningPayload
-> SigningT 'SecretTK m (Either SigningError SignaturePayload)
signWith SigningTarget
SignWithPrimary (SigType -> UserId -> SigningPayload
SPUserId SigType
st UserId
uid)
    pure result

-- | Sign a user attribute with the primary key.
signUat
    :: (MonadRandom m)
    => SigType
    -> UserAttribute
    -> SigningT 'SecretTK m (Either SigningError SignaturePayload)
signUat :: forall (m :: * -> *).
MonadRandom m =>
SigType
-> UserAttribute
-> SigningT 'SecretTK m (Either SigningError SignaturePayload)
signUat SigType
st UserAttribute
uat = do
    result <- SigningTarget
-> SigningPayload
-> SigningT 'SecretTK m (Either SigningError SignaturePayload)
forall (m :: * -> *).
MonadRandom m =>
SigningTarget
-> SigningPayload
-> SigningT 'SecretTK m (Either SigningError SignaturePayload)
signWith SigningTarget
SignWithPrimary (SigType -> UserAttribute -> SigningPayload
SPUat SigType
st UserAttribute
uat)
    pure result

-- | Get the current signing timestamp.
getCurrentTimestamp
    :: Monad m => SigningT tk m ThirtyTwoBitTimeStamp
getCurrentTimestamp :: forall (m :: * -> *) (tk :: TKKind).
Monad m =>
SigningT tk m ThirtyTwoBitTimeStamp
getCurrentTimestamp = ExceptT
  SigningError
  (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
  ThirtyTwoBitTimeStamp
-> SigningT tk m ThirtyTwoBitTimeStamp
forall (tk :: TKKind) (m :: * -> *) a.
ExceptT
  SigningError (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m) a
-> SigningT tk m a
SigningT (ExceptT
   SigningError
   (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
   ThirtyTwoBitTimeStamp
 -> SigningT tk m ThirtyTwoBitTimeStamp)
-> ExceptT
     SigningError
     (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
     ThirtyTwoBitTimeStamp
-> SigningT tk m ThirtyTwoBitTimeStamp
forall a b. (a -> b) -> a -> b
$ RWST
  (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m ThirtyTwoBitTimeStamp
-> ExceptT
     SigningError
     (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
     ThirtyTwoBitTimeStamp
forall (m :: * -> *) a. Monad m => m a -> ExceptT SigningError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift RWST
  (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m ThirtyTwoBitTimeStamp
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
get

-- | Set the current signing timestamp.
setCurrentTimestamp
    :: Monad m => ThirtyTwoBitTimeStamp -> SigningT tk m ()
setCurrentTimestamp :: forall (m :: * -> *) (tk :: TKKind).
Monad m =>
ThirtyTwoBitTimeStamp -> SigningT tk m ()
setCurrentTimestamp ThirtyTwoBitTimeStamp
ts = ExceptT
  SigningError
  (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
  ()
-> SigningT tk m ()
forall (tk :: TKKind) (m :: * -> *) a.
ExceptT
  SigningError (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m) a
-> SigningT tk m a
SigningT (ExceptT
   SigningError
   (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
   ()
 -> SigningT tk m ())
-> ExceptT
     SigningError
     (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
     ()
-> SigningT tk m ()
forall a b. (a -> b) -> a -> b
$ RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m ()
-> ExceptT
     SigningError
     (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
     ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT SigningError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m ()
 -> ExceptT
      SigningError
      (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
      ())
-> RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m ()
-> ExceptT
     SigningError
     (RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m)
     ()
forall a b. (a -> b) -> a -> b
$ ThirtyTwoBitTimeStamp
-> RWST (TK 'SecretTK) [Text] ThirtyTwoBitTimeStamp m ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
s -> RWST r w s m ()
put ThirtyTwoBitTimeStamp
ts

-- | Execute an action with a specific timestamp.
withTimestamp
    :: Monad m
    => ThirtyTwoBitTimeStamp -> SigningT tk m a -> SigningT tk m a
withTimestamp :: forall (m :: * -> *) (tk :: TKKind) a.
Monad m =>
ThirtyTwoBitTimeStamp -> SigningT tk m a -> SigningT tk m a
withTimestamp ThirtyTwoBitTimeStamp
ts SigningT tk m a
action = do
    old <- SigningT tk m ThirtyTwoBitTimeStamp
forall (m :: * -> *) (tk :: TKKind).
Monad m =>
SigningT tk m ThirtyTwoBitTimeStamp
getCurrentTimestamp
    setCurrentTimestamp ts
    result <- action
    setCurrentTimestamp old
    pure result

-- | Filter to only signing-capable keys.
filterSigningCapable :: [AvailableSigner] -> [AvailableSigner]
filterSigningCapable :: [AvailableSigner] -> [AvailableSigner]
filterSigningCapable = (AvailableSigner -> Bool) -> [AvailableSigner] -> [AvailableSigner]
forall a. (a -> Bool) -> [a] -> [a]
filter (\AvailableSigner
s -> Set KeyFlag -> Bool
isSigningCapable (AvailableSigner -> Set KeyFlag
asUsage AvailableSigner
s))

-- | Filter by key ID.
filterByKeyId
    :: PKA.EightOctetKeyId -> [AvailableSigner] -> [AvailableSigner]
filterByKeyId :: EightOctetKeyId -> [AvailableSigner] -> [AvailableSigner]
filterByKeyId EightOctetKeyId
kid = (AvailableSigner -> Bool) -> [AvailableSigner] -> [AvailableSigner]
forall a. (a -> Bool) -> [a] -> [a]
filter (\AvailableSigner
s -> AvailableSigner -> EightOctetKeyId
asKeyId AvailableSigner
s EightOctetKeyId -> EightOctetKeyId -> Bool
forall a. Eq a => a -> a -> Bool
== EightOctetKeyId
kid)

-- | Filter by fingerprint.
filterByFingerprint
    :: PKA.Fingerprint -> [AvailableSigner] -> [AvailableSigner]
filterByFingerprint :: Fingerprint -> [AvailableSigner] -> [AvailableSigner]
filterByFingerprint Fingerprint
fp = (AvailableSigner -> Bool) -> [AvailableSigner] -> [AvailableSigner]
forall a. (a -> Bool) -> [a] -> [a]
filter (\AvailableSigner
s -> AvailableSigner -> Fingerprint
asFingerprint AvailableSigner
s Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== Fingerprint
fp)