-- KeyGeneration.hs: OpenPGP (RFC9580) key generation and DSL
-- Copyright © 2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

module Codec.Encryption.OpenPGP.KeyGeneration
    ( -- * Legacy API (backward compatible)
      KeyGenSpec (..)
    , generateSecretKey

      -- * Duration DSL
    , Duration
    , seconds
    , minutes
    , hours
    , days
    , weeks
    , years

      -- * TK Generation DSL
    , TKGen
    , TKGenState
    , SubkeySpec
    , SignatureSpec
    , TKGenError (..)
    , newKey
    , addUID
    , addUIDWith
    , addSubkey
    , setKeySize
    , setExpiration
    , setSEIPDv1SymmetricPreferences
    , setHashPreferences
    , setCompressionPreferences
    , setAEADPreferences
    , setKeyServerPreferences
    , setFeatures
    , runTKGen
    , runTKGenWithSeed
    , withKeyVersionAndTimestamp
    ) where

import Control.Applicative (Alternative (..))
import Control.Monad (unless)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except
    ( ExceptT (..)
    , runExceptT
    , throwE
    )
import Control.Monad.Trans.RWS.Strict
    ( RWST (..)
    , ask
    , gets
    , modify
    , runRWST
    )
import qualified Crypto.Error as CE
import Crypto.Number.Serialize (os2ip)
import qualified Crypto.PubKey.Curve25519 as C25519
import qualified Crypto.PubKey.Curve448 as C448
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.Ed448 as Ed448
import qualified Crypto.PubKey.RSA as RSA
import Crypto.Random
    ( ChaChaDRG
    , MonadPseudoRandom
    , drgNewSeed
    , seedFromBinary
    , withDRG
    )
import Crypto.Random.Types (MonadRandom, getRandomBytes)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import Data.Data (Data)
import Data.Kind (Type)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Data.Typeable (Typeable)
import Data.Word (Word32)
import GHC.Generics (Generic)

import Codec.Encryption.OpenPGP.Fingerprint
    ( eightOctetKeyID
    , fingerprint
    )
import Codec.Encryption.OpenPGP.Internal
    ( PktStreamContext (..)
    , emptyPSC
    )
import Codec.Encryption.OpenPGP.SerializeForSigs
    ( payloadForSig
    )
import Codec.Encryption.OpenPGP.Signatures
    ( signDataWithEd25519Builder
    , signDataWithEd25519V6Builder
    , signDataWithEd448Builder
    , signDataWithEd448V6Builder
    , signDataWithRSABuilder
    , signDataWithRSAV6Builder
    )
import Codec.Encryption.OpenPGP.Subpackets
    ( addHashedSubs
    , addUnhashedSubs
    , listToHashedSubs
    , listToUnhashedSubs
    , sigBuilderInit
    , sigBuilderInitV6
    )
import Codec.Encryption.OpenPGP.Types

-- -----------------------------------------------------------------------------
-- V4/V6 algorithm mapping
-- -----------------------------------------------------------------------------

{- | Map a user-facing algorithm to the correct 'PubKeyAlgorithm' identifier
for the given key version.  This ensures that V4 keys use the legacy
algorithm identifiers (e.g. 'EdDSALegacy' instead of 'Ed25519') while
V6 keys use the modern identifiers.
-}
algorithmForVersion
    :: KeyVersion -> PubKeyAlgorithm -> PubKeyAlgorithm
algorithmForVersion :: KeyVersion -> PubKeyAlgorithm -> PubKeyAlgorithm
algorithmForVersion KeyVersion
V4 PubKeyAlgorithm
Ed25519 = PubKeyAlgorithm
EdDSALegacy
algorithmForVersion KeyVersion
V6 PubKeyAlgorithm
Ed25519 = PubKeyAlgorithm
Ed25519
algorithmForVersion KeyVersion
V4 PubKeyAlgorithm
X25519 = PubKeyAlgorithm
ECDH
algorithmForVersion KeyVersion
V6 PubKeyAlgorithm
X25519 = PubKeyAlgorithm
X25519
algorithmForVersion KeyVersion
_ PubKeyAlgorithm
algo = PubKeyAlgorithm
algo

{- | Return the signing parameters (name, signature length, limb length, PKA)
for a given key version and algorithm.  Used by the builder-based signing
functions in "Codec.Encryption.OpenPGP.Signatures".
-}
signingParams
    :: KeyVersion
    -> PubKeyAlgorithm
    -> (String, Int, Int, PubKeyAlgorithm)
signingParams :: KeyVersion
-> PubKeyAlgorithm -> ([Char], Int, Int, PubKeyAlgorithm)
signingParams KeyVersion
V4 PubKeyAlgorithm
Ed25519 = ([Char]
"Ed25519", Int
64, Int
32, PubKeyAlgorithm
EdDSALegacy)
signingParams KeyVersion
V6 PubKeyAlgorithm
Ed25519 = ([Char]
"Ed25519", Int
64, Int
32, PubKeyAlgorithm
Ed25519)
signingParams KeyVersion
_ PubKeyAlgorithm
algo = [Char] -> ([Char], Int, Int, PubKeyAlgorithm)
forall a. HasCallStack => [Char] -> a
error ([Char]
"unsupported signing algorithm: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PubKeyAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show PubKeyAlgorithm
algo)

-- -----------------------------------------------------------------------------
-- Legacy API
-- -----------------------------------------------------------------------------

class RSAKeyVersion (v :: KeyVersion) where
    rsaKeyVersion :: KeyVersion

instance RSAKeyVersion 'V4 where
    rsaKeyVersion :: KeyVersion
rsaKeyVersion = KeyVersion
V4

instance RSAKeyVersion 'V6 where
    rsaKeyVersion :: KeyVersion
rsaKeyVersion = KeyVersion
V6

data KeyGenSpec (v :: KeyVersion) where
    KeyGenRSA
        :: RSAKeyVersion v => ThirtyTwoBitTimeStamp -> Int -> KeyGenSpec v
    KeyGenEd25519 :: ThirtyTwoBitTimeStamp -> KeyGenSpec 'V6
    KeyGenEd448 :: ThirtyTwoBitTimeStamp -> KeyGenSpec 'V6
    KeyGenX25519 :: ThirtyTwoBitTimeStamp -> KeyGenSpec 'V6
    KeyGenX448 :: ThirtyTwoBitTimeStamp -> KeyGenSpec 'V6

generateSecretKey
    :: forall v m
     . MonadRandom m
    => KeyGenSpec v
    -> ExceptT String m (SomePKPayload, SKey)
generateSecretKey :: forall (v :: KeyVersion) (m :: * -> *).
MonadRandom m =>
KeyGenSpec v -> ExceptT [Char] m (SomePKPayload, SKey)
generateSecretKey KeyGenSpec v
spec = case KeyGenSpec v
spec of
    KeyGenRSA ThirtyTwoBitTimeStamp
ts Int
keySizeBits -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> Int
-> ExceptT [Char] m (SomePKPayload, SKey)
forall {m :: * -> *} {e}.
(IsString e, MonadRandom m) =>
KeyVersion
-> ThirtyTwoBitTimeStamp
-> Int
-> ExceptT e m (SomePKPayload, SKey)
rsaGenerate (forall (v :: KeyVersion). RSAKeyVersion v => KeyVersion
rsaKeyVersion @v) ThirtyTwoBitTimeStamp
ts Int
keySizeBits
    KeyGenEd25519 ThirtyTwoBitTimeStamp
ts -> KeyVersion
-> ThirtyTwoBitTimeStamp -> ExceptT [Char] m (SomePKPayload, SKey)
forall {m :: * -> *} {p}.
MonadRandom m =>
p
-> ThirtyTwoBitTimeStamp -> ExceptT [Char] m (SomePKPayload, SKey)
ed25519Generate KeyVersion
V6 ThirtyTwoBitTimeStamp
ts
    KeyGenEd448 ThirtyTwoBitTimeStamp
ts -> KeyVersion
-> ThirtyTwoBitTimeStamp -> ExceptT [Char] m (SomePKPayload, SKey)
forall {m :: * -> *} {p}.
MonadRandom m =>
p
-> ThirtyTwoBitTimeStamp -> ExceptT [Char] m (SomePKPayload, SKey)
ed448Generate KeyVersion
V6 ThirtyTwoBitTimeStamp
ts
    KeyGenX25519 ThirtyTwoBitTimeStamp
ts -> KeyVersion
-> ThirtyTwoBitTimeStamp -> ExceptT [Char] m (SomePKPayload, SKey)
forall {m :: * -> *} {p}.
MonadRandom m =>
p
-> ThirtyTwoBitTimeStamp -> ExceptT [Char] m (SomePKPayload, SKey)
x25519Generate KeyVersion
V6 ThirtyTwoBitTimeStamp
ts
    KeyGenX448 ThirtyTwoBitTimeStamp
ts -> KeyVersion
-> ThirtyTwoBitTimeStamp -> ExceptT [Char] m (SomePKPayload, SKey)
forall {m :: * -> *} {p}.
MonadRandom m =>
p
-> ThirtyTwoBitTimeStamp -> ExceptT [Char] m (SomePKPayload, SKey)
x448Generate KeyVersion
V6 ThirtyTwoBitTimeStamp
ts
  where
    rsaGenerate :: KeyVersion
-> ThirtyTwoBitTimeStamp
-> Int
-> ExceptT e m (SomePKPayload, SKey)
rsaGenerate KeyVersion
kv ThirtyTwoBitTimeStamp
ts Int
keySizeBits = do
        Bool -> ExceptT e m () -> ExceptT e m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
keySizeBits Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (ExceptT e m () -> ExceptT e m ())
-> ExceptT e m () -> ExceptT e m ()
forall a b. (a -> b) -> a -> b
$
            e -> ExceptT e m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
"RSA key size must be a multiple of 8"
        let keySizeBytes :: Int
keySizeBytes = Int
keySizeBits Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
        (publicKey, privateKey) <- m (PublicKey, PrivateKey) -> ExceptT e m (PublicKey, PrivateKey)
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (PublicKey, PrivateKey) -> ExceptT e m (PublicKey, PrivateKey))
-> m (PublicKey, PrivateKey) -> ExceptT e m (PublicKey, PrivateKey)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> m (PublicKey, PrivateKey)
forall (m :: * -> *).
MonadRandom m =>
Int -> Integer -> m (PublicKey, PrivateKey)
RSA.generate Int
keySizeBytes Integer
65537
        let pkey = RSA_PublicKey -> PKey
RSAPubKey (PublicKey -> RSA_PublicKey
RSA_PublicKey PublicKey
publicKey)
            skey = RSA_PrivateKey -> SKey
RSAPrivateKey (PrivateKey -> RSA_PrivateKey
RSA_PrivateKey PrivateKey
privateKey)
            pkp = case KeyVersion
kv of
                KeyVersion
DeprecatedV3 -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> V3Expiration
-> PubKeyAlgorithm
-> PKey
-> SomePKPayload
PKPayload KeyVersion
DeprecatedV3 ThirtyTwoBitTimeStamp
ts V3Expiration
0 PubKeyAlgorithm
RSA PKey
pkey
                KeyVersion
V4 -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> V3Expiration
-> PubKeyAlgorithm
-> PKey
-> SomePKPayload
PKPayload KeyVersion
V4 ThirtyTwoBitTimeStamp
ts V3Expiration
0 PubKeyAlgorithm
RSA PKey
pkey
                KeyVersion
V6 -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> V3Expiration
-> PubKeyAlgorithm
-> PKey
-> SomePKPayload
PKPayload KeyVersion
V6 ThirtyTwoBitTimeStamp
ts V3Expiration
0 PubKeyAlgorithm
RSA PKey
pkey
        pure (pkp, skey)
    ed25519Generate :: p
-> ThirtyTwoBitTimeStamp -> ExceptT [Char] m (SomePKPayload, SKey)
ed25519Generate p
_kv ThirtyTwoBitTimeStamp
ts = do
        seed <- m ByteString -> ExceptT [Char] m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT [Char] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT [Char] m ByteString)
-> m ByteString -> ExceptT [Char] m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
        secretKey <-
            either
                (throwE . ("Ed25519 key generation failed: " ++) . show)
                pure
                (CE.eitherCryptoError (Ed25519.secretKey seed))
        let pubBytes = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SecretKey -> PublicKey
Ed25519.toPublic SecretKey
secretKey) :: B.ByteString
            pkey =
                EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey
                    EdSigningCurve
EdSigningCurve25519
                    (EPoint -> EdPoint
NativeEPoint (Integer -> EPoint
EPoint (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
pubBytes)))
            skey = ByteString -> SKey
Ed25519PrivateKey ByteString
seed
            pkp = KeyVersion
-> ThirtyTwoBitTimeStamp
-> V3Expiration
-> PubKeyAlgorithm
-> PKey
-> SomePKPayload
PKPayload KeyVersion
V6 ThirtyTwoBitTimeStamp
ts V3Expiration
0 PubKeyAlgorithm
Ed25519 PKey
pkey
        pure (pkp, skey)
    ed448Generate :: p
-> ThirtyTwoBitTimeStamp -> ExceptT [Char] m (SomePKPayload, SKey)
ed448Generate p
_ ThirtyTwoBitTimeStamp
ts = do
        seed <- m ByteString -> ExceptT [Char] m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT [Char] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT [Char] m ByteString)
-> m ByteString -> ExceptT [Char] m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
57
        secretKey <-
            either
                (throwE . ("Ed448 key generation failed: " ++) . show)
                pure
                (CE.eitherCryptoError (Ed448.secretKey seed))
        let pubBytes = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SecretKey -> PublicKey
Ed448.toPublic SecretKey
secretKey) :: B.ByteString
            pkey =
                EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey
                    EdSigningCurve
EdSigningCurve448
                    (EPoint -> EdPoint
NativeEPoint (Integer -> EPoint
EPoint (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
pubBytes)))
            skey = ByteString -> SKey
Ed448PrivateKey ByteString
seed
            pkp = KeyVersion
-> ThirtyTwoBitTimeStamp
-> V3Expiration
-> PubKeyAlgorithm
-> PKey
-> SomePKPayload
PKPayload KeyVersion
V6 ThirtyTwoBitTimeStamp
ts V3Expiration
0 PubKeyAlgorithm
Ed448 PKey
pkey
        pure (pkp, skey)
    x25519Generate :: p
-> ThirtyTwoBitTimeStamp -> ExceptT [Char] m (SomePKPayload, SKey)
x25519Generate p
_kv ThirtyTwoBitTimeStamp
ts = do
        secretRaw <- m ByteString -> ExceptT [Char] m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT [Char] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT [Char] m ByteString)
-> m ByteString -> ExceptT [Char] m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
        secretKey <-
            either
                (throwE . ("X25519 key generation failed: " ++) . show)
                pure
                (CE.eitherCryptoError (C25519.secretKey secretRaw))
        let pubRaw = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SecretKey -> PublicKey
C25519.toPublic SecretKey
secretKey) :: B.ByteString
            pkey =
                EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey
                    EdSigningCurve
EdSigningCurve25519
                    (EPoint -> EdPoint
NativeEPoint (Integer -> EPoint
EPoint (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
pubRaw)))
            skey = ByteString -> SKey
X25519PrivateKey ByteString
secretRaw
            pkp = KeyVersion
-> ThirtyTwoBitTimeStamp
-> V3Expiration
-> PubKeyAlgorithm
-> PKey
-> SomePKPayload
PKPayload KeyVersion
V6 ThirtyTwoBitTimeStamp
ts V3Expiration
0 PubKeyAlgorithm
X25519 PKey
pkey
        pure (pkp, skey)
    x448Generate :: p
-> ThirtyTwoBitTimeStamp -> ExceptT [Char] m (SomePKPayload, SKey)
x448Generate p
_ ThirtyTwoBitTimeStamp
ts = do
        secretRaw <- m ByteString -> ExceptT [Char] m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT [Char] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT [Char] m ByteString)
-> m ByteString -> ExceptT [Char] m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
56
        secretKey <-
            either
                (throwE . ("X448 key generation failed: " ++) . show)
                pure
                (CE.eitherCryptoError (C448.secretKey secretRaw))
        let pubRaw = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SecretKey -> PublicKey
C448.toPublic SecretKey
secretKey) :: B.ByteString
            pkey =
                EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey
                    EdSigningCurve
EdSigningCurve448
                    (EPoint -> EdPoint
NativeEPoint (Integer -> EPoint
EPoint (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
pubRaw)))
            skey = ByteString -> SKey
X448PrivateKey ByteString
secretRaw
            pkp = KeyVersion
-> ThirtyTwoBitTimeStamp
-> V3Expiration
-> PubKeyAlgorithm
-> PKey
-> SomePKPayload
PKPayload KeyVersion
V6 ThirtyTwoBitTimeStamp
ts V3Expiration
0 PubKeyAlgorithm
X448 PKey
pkey
        pure (pkp, skey)

-- -----------------------------------------------------------------------------
-- Duration DSL
-- -----------------------------------------------------------------------------

newtype Duration = Duration
    { Duration -> ThirtyTwoBitDuration
toThirtyTwoBitDuration :: ThirtyTwoBitDuration
    }
    deriving (Typeable Duration
Typeable Duration =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Duration -> c Duration)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Duration)
-> (Duration -> Constr)
-> (Duration -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Duration))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Duration))
-> ((forall b. Data b => b -> b) -> Duration -> Duration)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Duration -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Duration -> r)
-> (forall u. (forall d. Data d => d -> u) -> Duration -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Duration -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Duration -> m Duration)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Duration -> m Duration)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Duration -> m Duration)
-> Data Duration
Duration -> Constr
Duration -> DataType
(forall b. Data b => b -> b) -> Duration -> Duration
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Duration -> u
forall u. (forall d. Data d => d -> u) -> Duration -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Duration -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Duration -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Duration
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Duration -> c Duration
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Duration)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Duration)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Duration -> c Duration
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Duration -> c Duration
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Duration
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Duration
$ctoConstr :: Duration -> Constr
toConstr :: Duration -> Constr
$cdataTypeOf :: Duration -> DataType
dataTypeOf :: Duration -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Duration)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Duration)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Duration)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Duration)
$cgmapT :: (forall b. Data b => b -> b) -> Duration -> Duration
gmapT :: (forall b. Data b => b -> b) -> Duration -> Duration
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Duration -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Duration -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Duration -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Duration -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Duration -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Duration -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Duration -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Duration -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Duration -> m Duration
Data, Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
/= :: Duration -> Duration -> Bool
Eq, (forall x. Duration -> Rep Duration x)
-> (forall x. Rep Duration x -> Duration) -> Generic Duration
forall x. Rep Duration x -> Duration
forall x. Duration -> Rep Duration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Duration -> Rep Duration x
from :: forall x. Duration -> Rep Duration x
$cto :: forall x. Rep Duration x -> Duration
to :: forall x. Rep Duration x -> Duration
Generic, Eq Duration
Eq Duration =>
(Duration -> Duration -> Ordering)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> Ord Duration
Duration -> Duration -> Bool
Duration -> Duration -> Ordering
Duration -> Duration -> Duration
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Duration -> Duration -> Ordering
compare :: Duration -> Duration -> Ordering
$c< :: Duration -> Duration -> Bool
< :: Duration -> Duration -> Bool
$c<= :: Duration -> Duration -> Bool
<= :: Duration -> Duration -> Bool
$c> :: Duration -> Duration -> Bool
> :: Duration -> Duration -> Bool
$c>= :: Duration -> Duration -> Bool
>= :: Duration -> Duration -> Bool
$cmax :: Duration -> Duration -> Duration
max :: Duration -> Duration -> Duration
$cmin :: Duration -> Duration -> Duration
min :: Duration -> Duration -> Duration
Ord, Int -> Duration -> [Char] -> [Char]
[Duration] -> [Char] -> [Char]
Duration -> [Char]
(Int -> Duration -> [Char] -> [Char])
-> (Duration -> [Char])
-> ([Duration] -> [Char] -> [Char])
-> Show Duration
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Duration -> [Char] -> [Char]
showsPrec :: Int -> Duration -> [Char] -> [Char]
$cshow :: Duration -> [Char]
show :: Duration -> [Char]
$cshowList :: [Duration] -> [Char] -> [Char]
showList :: [Duration] -> [Char] -> [Char]
Show, Typeable)

seconds :: Word32 -> Duration
seconds :: Word32 -> Duration
seconds Word32
n = ThirtyTwoBitDuration -> Duration
Duration (Word32 -> ThirtyTwoBitDuration
ThirtyTwoBitDuration Word32
n)

minutes :: Word32 -> Duration
minutes :: Word32 -> Duration
minutes Word32
n = ThirtyTwoBitDuration -> Duration
Duration (Word32 -> ThirtyTwoBitDuration
ThirtyTwoBitDuration (Word32
n Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
60))

hours :: Word32 -> Duration
hours :: Word32 -> Duration
hours Word32
n = ThirtyTwoBitDuration -> Duration
Duration (Word32 -> ThirtyTwoBitDuration
ThirtyTwoBitDuration (Word32
n Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
3600))

days :: Word32 -> Duration
days :: Word32 -> Duration
days Word32
n = ThirtyTwoBitDuration -> Duration
Duration (Word32 -> ThirtyTwoBitDuration
ThirtyTwoBitDuration (Word32
n Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
86400))

weeks :: Word32 -> Duration
weeks :: Word32 -> Duration
weeks Word32
n = ThirtyTwoBitDuration -> Duration
Duration (Word32 -> ThirtyTwoBitDuration
ThirtyTwoBitDuration (Word32
n Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
604800))

years :: Word32 -> Duration
years :: Word32 -> Duration
years Word32
n = ThirtyTwoBitDuration -> Duration
Duration (Word32 -> ThirtyTwoBitDuration
ThirtyTwoBitDuration (Word32
n Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
31536000))

-- 365 days per year, no leap seconds

instance Semigroup Duration where
    Duration (ThirtyTwoBitDuration Word32
a) <> :: Duration -> Duration -> Duration
<> Duration (ThirtyTwoBitDuration Word32
b) =
        ThirtyTwoBitDuration -> Duration
Duration (Word32 -> ThirtyTwoBitDuration
ThirtyTwoBitDuration (Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
b))

-- -----------------------------------------------------------------------------
-- TK Generation DSL
-- -----------------------------------------------------------------------------

newtype TKGen (m :: Type -> Type) (v :: TKKind) a = TKGen
    { forall (m :: * -> *) (v :: TKKind) a.
TKGen m v a
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     a
unTKGen
        :: RWST
            (KeyVersion, ThirtyTwoBitTimeStamp)
            [String]
            TKGenState
            (ExceptT TKGenError m)
            a
    }
    deriving newtype (Functor (TKGen m v)
Functor (TKGen m v) =>
(forall a. a -> TKGen m v a)
-> (forall a b. TKGen m v (a -> b) -> TKGen m v a -> TKGen m v b)
-> (forall a b c.
    (a -> b -> c) -> TKGen m v a -> TKGen m v b -> TKGen m v c)
-> (forall a b. TKGen m v a -> TKGen m v b -> TKGen m v b)
-> (forall a b. TKGen m v a -> TKGen m v b -> TKGen m v a)
-> Applicative (TKGen m v)
forall a. a -> TKGen m v a
forall a b. TKGen m v a -> TKGen m v b -> TKGen m v a
forall a b. TKGen m v a -> TKGen m v b -> TKGen m v b
forall a b. TKGen m v (a -> b) -> TKGen m v a -> TKGen m v b
forall a b c.
(a -> b -> c) -> TKGen m v a -> TKGen m v b -> TKGen m v 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
forall (m :: * -> *) (v :: TKKind). Monad m => Functor (TKGen m v)
forall (m :: * -> *) (v :: TKKind) a. Monad m => a -> TKGen m v a
forall (m :: * -> *) (v :: TKKind) a b.
Monad m =>
TKGen m v a -> TKGen m v b -> TKGen m v a
forall (m :: * -> *) (v :: TKKind) a b.
Monad m =>
TKGen m v a -> TKGen m v b -> TKGen m v b
forall (m :: * -> *) (v :: TKKind) a b.
Monad m =>
TKGen m v (a -> b) -> TKGen m v a -> TKGen m v b
forall (m :: * -> *) (v :: TKKind) a b c.
Monad m =>
(a -> b -> c) -> TKGen m v a -> TKGen m v b -> TKGen m v c
$cpure :: forall (m :: * -> *) (v :: TKKind) a. Monad m => a -> TKGen m v a
pure :: forall a. a -> TKGen m v a
$c<*> :: forall (m :: * -> *) (v :: TKKind) a b.
Monad m =>
TKGen m v (a -> b) -> TKGen m v a -> TKGen m v b
<*> :: forall a b. TKGen m v (a -> b) -> TKGen m v a -> TKGen m v b
$cliftA2 :: forall (m :: * -> *) (v :: TKKind) a b c.
Monad m =>
(a -> b -> c) -> TKGen m v a -> TKGen m v b -> TKGen m v c
liftA2 :: forall a b c.
(a -> b -> c) -> TKGen m v a -> TKGen m v b -> TKGen m v c
$c*> :: forall (m :: * -> *) (v :: TKKind) a b.
Monad m =>
TKGen m v a -> TKGen m v b -> TKGen m v b
*> :: forall a b. TKGen m v a -> TKGen m v b -> TKGen m v b
$c<* :: forall (m :: * -> *) (v :: TKKind) a b.
Monad m =>
TKGen m v a -> TKGen m v b -> TKGen m v a
<* :: forall a b. TKGen m v a -> TKGen m v b -> TKGen m v a
Applicative, (forall a b. (a -> b) -> TKGen m v a -> TKGen m v b)
-> (forall a b. a -> TKGen m v b -> TKGen m v a)
-> Functor (TKGen m v)
forall a b. a -> TKGen m v b -> TKGen m v a
forall a b. (a -> b) -> TKGen m v a -> TKGen m v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) (v :: TKKind) a b.
Functor m =>
a -> TKGen m v b -> TKGen m v a
forall (m :: * -> *) (v :: TKKind) a b.
Functor m =>
(a -> b) -> TKGen m v a -> TKGen m v b
$cfmap :: forall (m :: * -> *) (v :: TKKind) a b.
Functor m =>
(a -> b) -> TKGen m v a -> TKGen m v b
fmap :: forall a b. (a -> b) -> TKGen m v a -> TKGen m v b
$c<$ :: forall (m :: * -> *) (v :: TKKind) a b.
Functor m =>
a -> TKGen m v b -> TKGen m v a
<$ :: forall a b. a -> TKGen m v b -> TKGen m v a
Functor, Applicative (TKGen m v)
Applicative (TKGen m v) =>
(forall a b. TKGen m v a -> (a -> TKGen m v b) -> TKGen m v b)
-> (forall a b. TKGen m v a -> TKGen m v b -> TKGen m v b)
-> (forall a. a -> TKGen m v a)
-> Monad (TKGen m v)
forall a. a -> TKGen m v a
forall a b. TKGen m v a -> TKGen m v b -> TKGen m v b
forall a b. TKGen m v a -> (a -> TKGen m v b) -> TKGen m v 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
forall (m :: * -> *) (v :: TKKind).
Monad m =>
Applicative (TKGen m v)
forall (m :: * -> *) (v :: TKKind) a. Monad m => a -> TKGen m v a
forall (m :: * -> *) (v :: TKKind) a b.
Monad m =>
TKGen m v a -> TKGen m v b -> TKGen m v b
forall (m :: * -> *) (v :: TKKind) a b.
Monad m =>
TKGen m v a -> (a -> TKGen m v b) -> TKGen m v b
$c>>= :: forall (m :: * -> *) (v :: TKKind) a b.
Monad m =>
TKGen m v a -> (a -> TKGen m v b) -> TKGen m v b
>>= :: forall a b. TKGen m v a -> (a -> TKGen m v b) -> TKGen m v b
$c>> :: forall (m :: * -> *) (v :: TKKind) a b.
Monad m =>
TKGen m v a -> TKGen m v b -> TKGen m v b
>> :: forall a b. TKGen m v a -> TKGen m v b -> TKGen m v b
$creturn :: forall (m :: * -> *) (v :: TKKind) a. Monad m => a -> TKGen m v a
return :: forall a. a -> TKGen m v a
Monad)

data TKGenState = TKGenState
    { TKGenState -> Maybe (SomePKPayload, SKey)
_tkGenPrimary :: Maybe (SomePKPayload, SKey)
    , TKGenState -> [Text]
_tkGenUIDs :: [Text]
    , TKGenState -> [SubkeySpec]
_tkGenSubkeys :: [SubkeySpec]
    , TKGenState -> Maybe ThirtyTwoBitDuration
_tkGenExpiration :: Maybe ThirtyTwoBitDuration
    , TKGenState -> Preferences
_tkGenPrefs :: Preferences
    , TKGenState -> [[Char]]
_tkGenLog :: [String]
    , TKGenState -> Map PubKeyAlgorithm Int
_tkGenKeySizes :: Map PubKeyAlgorithm Int
    }
    deriving (Typeable TKGenState
Typeable TKGenState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> TKGenState -> c TKGenState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TKGenState)
-> (TKGenState -> Constr)
-> (TKGenState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TKGenState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TKGenState))
-> ((forall b. Data b => b -> b) -> TKGenState -> TKGenState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TKGenState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TKGenState -> r)
-> (forall u. (forall d. Data d => d -> u) -> TKGenState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TKGenState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TKGenState -> m TKGenState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TKGenState -> m TKGenState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TKGenState -> m TKGenState)
-> Data TKGenState
TKGenState -> Constr
TKGenState -> DataType
(forall b. Data b => b -> b) -> TKGenState -> TKGenState
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TKGenState -> u
forall u. (forall d. Data d => d -> u) -> TKGenState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TKGenState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TKGenState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TKGenState -> m TKGenState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TKGenState -> m TKGenState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TKGenState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TKGenState -> c TKGenState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TKGenState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TKGenState)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TKGenState -> c TKGenState
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TKGenState -> c TKGenState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TKGenState
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TKGenState
$ctoConstr :: TKGenState -> Constr
toConstr :: TKGenState -> Constr
$cdataTypeOf :: TKGenState -> DataType
dataTypeOf :: TKGenState -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TKGenState)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TKGenState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TKGenState)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TKGenState)
$cgmapT :: (forall b. Data b => b -> b) -> TKGenState -> TKGenState
gmapT :: (forall b. Data b => b -> b) -> TKGenState -> TKGenState
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TKGenState -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TKGenState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TKGenState -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TKGenState -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TKGenState -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TKGenState -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TKGenState -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TKGenState -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TKGenState -> m TKGenState
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TKGenState -> m TKGenState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TKGenState -> m TKGenState
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TKGenState -> m TKGenState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TKGenState -> m TKGenState
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TKGenState -> m TKGenState
Data, TKGenState -> TKGenState -> Bool
(TKGenState -> TKGenState -> Bool)
-> (TKGenState -> TKGenState -> Bool) -> Eq TKGenState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TKGenState -> TKGenState -> Bool
== :: TKGenState -> TKGenState -> Bool
$c/= :: TKGenState -> TKGenState -> Bool
/= :: TKGenState -> TKGenState -> Bool
Eq, (forall x. TKGenState -> Rep TKGenState x)
-> (forall x. Rep TKGenState x -> TKGenState) -> Generic TKGenState
forall x. Rep TKGenState x -> TKGenState
forall x. TKGenState -> Rep TKGenState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TKGenState -> Rep TKGenState x
from :: forall x. TKGenState -> Rep TKGenState x
$cto :: forall x. Rep TKGenState x -> TKGenState
to :: forall x. Rep TKGenState x -> TKGenState
Generic, Eq TKGenState
Eq TKGenState =>
(TKGenState -> TKGenState -> Ordering)
-> (TKGenState -> TKGenState -> Bool)
-> (TKGenState -> TKGenState -> Bool)
-> (TKGenState -> TKGenState -> Bool)
-> (TKGenState -> TKGenState -> Bool)
-> (TKGenState -> TKGenState -> TKGenState)
-> (TKGenState -> TKGenState -> TKGenState)
-> Ord TKGenState
TKGenState -> TKGenState -> Bool
TKGenState -> TKGenState -> Ordering
TKGenState -> TKGenState -> TKGenState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TKGenState -> TKGenState -> Ordering
compare :: TKGenState -> TKGenState -> Ordering
$c< :: TKGenState -> TKGenState -> Bool
< :: TKGenState -> TKGenState -> Bool
$c<= :: TKGenState -> TKGenState -> Bool
<= :: TKGenState -> TKGenState -> Bool
$c> :: TKGenState -> TKGenState -> Bool
> :: TKGenState -> TKGenState -> Bool
$c>= :: TKGenState -> TKGenState -> Bool
>= :: TKGenState -> TKGenState -> Bool
$cmax :: TKGenState -> TKGenState -> TKGenState
max :: TKGenState -> TKGenState -> TKGenState
$cmin :: TKGenState -> TKGenState -> TKGenState
min :: TKGenState -> TKGenState -> TKGenState
Ord, Int -> TKGenState -> [Char] -> [Char]
[TKGenState] -> [Char] -> [Char]
TKGenState -> [Char]
(Int -> TKGenState -> [Char] -> [Char])
-> (TKGenState -> [Char])
-> ([TKGenState] -> [Char] -> [Char])
-> Show TKGenState
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> TKGenState -> [Char] -> [Char]
showsPrec :: Int -> TKGenState -> [Char] -> [Char]
$cshow :: TKGenState -> [Char]
show :: TKGenState -> [Char]
$cshowList :: [TKGenState] -> [Char] -> [Char]
showList :: [TKGenState] -> [Char] -> [Char]
Show, Typeable)

instance Semigroup TKGenState where
    TKGenState
a <> :: TKGenState -> TKGenState -> TKGenState
<> TKGenState
b =
        TKGenState
            { _tkGenPrimary :: Maybe (SomePKPayload, SKey)
_tkGenPrimary = case TKGenState -> Maybe (SomePKPayload, SKey)
_tkGenPrimary TKGenState
a of
                Maybe (SomePKPayload, SKey)
Nothing -> TKGenState -> Maybe (SomePKPayload, SKey)
_tkGenPrimary TKGenState
b
                Just (SomePKPayload, SKey)
_ -> TKGenState -> Maybe (SomePKPayload, SKey)
_tkGenPrimary TKGenState
a
            , _tkGenUIDs :: [Text]
_tkGenUIDs = TKGenState -> [Text]
_tkGenUIDs TKGenState
a [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> TKGenState -> [Text]
_tkGenUIDs TKGenState
b
            , _tkGenSubkeys :: [SubkeySpec]
_tkGenSubkeys = TKGenState -> [SubkeySpec]
_tkGenSubkeys TKGenState
a [SubkeySpec] -> [SubkeySpec] -> [SubkeySpec]
forall a. Semigroup a => a -> a -> a
<> TKGenState -> [SubkeySpec]
_tkGenSubkeys TKGenState
b
            , _tkGenExpiration :: Maybe ThirtyTwoBitDuration
_tkGenExpiration = TKGenState -> Maybe ThirtyTwoBitDuration
_tkGenExpiration TKGenState
a Maybe ThirtyTwoBitDuration
-> Maybe ThirtyTwoBitDuration -> Maybe ThirtyTwoBitDuration
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TKGenState -> Maybe ThirtyTwoBitDuration
_tkGenExpiration TKGenState
b
            , _tkGenPrefs :: Preferences
_tkGenPrefs = TKGenState -> Preferences
_tkGenPrefs TKGenState
a Preferences -> Preferences -> Preferences
forall a. Semigroup a => a -> a -> a
<> TKGenState -> Preferences
_tkGenPrefs TKGenState
b
            , _tkGenLog :: [[Char]]
_tkGenLog = TKGenState -> [[Char]]
_tkGenLog TKGenState
a [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> TKGenState -> [[Char]]
_tkGenLog TKGenState
b
            , _tkGenKeySizes :: Map PubKeyAlgorithm Int
_tkGenKeySizes = TKGenState -> Map PubKeyAlgorithm Int
_tkGenKeySizes TKGenState
a Map PubKeyAlgorithm Int
-> Map PubKeyAlgorithm Int -> Map PubKeyAlgorithm Int
forall a. Semigroup a => a -> a -> a
<> TKGenState -> Map PubKeyAlgorithm Int
_tkGenKeySizes TKGenState
b
            }

instance Monoid TKGenState where
    mempty :: TKGenState
mempty =
        TKGenState
            { _tkGenPrimary :: Maybe (SomePKPayload, SKey)
_tkGenPrimary = Maybe (SomePKPayload, SKey)
forall a. Maybe a
Nothing
            , _tkGenUIDs :: [Text]
_tkGenUIDs = [Text]
forall a. Monoid a => a
mempty
            , _tkGenSubkeys :: [SubkeySpec]
_tkGenSubkeys = [SubkeySpec]
forall a. Monoid a => a
mempty
            , _tkGenExpiration :: Maybe ThirtyTwoBitDuration
_tkGenExpiration = Maybe ThirtyTwoBitDuration
forall a. Maybe a
Nothing
            , _tkGenPrefs :: Preferences
_tkGenPrefs = Preferences
forall a. Monoid a => a
mempty
            , _tkGenLog :: [[Char]]
_tkGenLog = [[Char]]
forall a. Monoid a => a
mempty
            , _tkGenKeySizes :: Map PubKeyAlgorithm Int
_tkGenKeySizes = Map PubKeyAlgorithm Int
forall a. Monoid a => a
mempty
            }

data Preferences = Preferences
    { Preferences -> [SymmetricAlgorithm]
_prefSymmetric :: [SymmetricAlgorithm]
    , Preferences -> [HashAlgorithm]
_prefHash :: [HashAlgorithm]
    , Preferences -> [CompressionAlgorithm]
_prefCompress :: [CompressionAlgorithm]
    , Preferences -> [(SymmetricAlgorithm, AEADAlgorithm)]
_prefAEAD :: [(SymmetricAlgorithm, AEADAlgorithm)]
    , Preferences -> Set KSPFlag
_prefKeyServer :: Set KSPFlag
    , Preferences -> Set FeatureFlag
_prefFeatures :: Set FeatureFlag
    }
    deriving (Typeable Preferences
Typeable Preferences =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Preferences -> c Preferences)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Preferences)
-> (Preferences -> Constr)
-> (Preferences -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Preferences))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Preferences))
-> ((forall b. Data b => b -> b) -> Preferences -> Preferences)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Preferences -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Preferences -> r)
-> (forall u. (forall d. Data d => d -> u) -> Preferences -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Preferences -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Preferences -> m Preferences)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Preferences -> m Preferences)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Preferences -> m Preferences)
-> Data Preferences
Preferences -> Constr
Preferences -> DataType
(forall b. Data b => b -> b) -> Preferences -> Preferences
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Preferences -> u
forall u. (forall d. Data d => d -> u) -> Preferences -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Preferences -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Preferences -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Preferences -> m Preferences
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Preferences -> m Preferences
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Preferences
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Preferences -> c Preferences
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Preferences)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Preferences)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Preferences -> c Preferences
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Preferences -> c Preferences
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Preferences
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Preferences
$ctoConstr :: Preferences -> Constr
toConstr :: Preferences -> Constr
$cdataTypeOf :: Preferences -> DataType
dataTypeOf :: Preferences -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Preferences)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Preferences)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Preferences)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Preferences)
$cgmapT :: (forall b. Data b => b -> b) -> Preferences -> Preferences
gmapT :: (forall b. Data b => b -> b) -> Preferences -> Preferences
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Preferences -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Preferences -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Preferences -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Preferences -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Preferences -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Preferences -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Preferences -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Preferences -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Preferences -> m Preferences
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Preferences -> m Preferences
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Preferences -> m Preferences
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Preferences -> m Preferences
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Preferences -> m Preferences
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Preferences -> m Preferences
Data, Preferences -> Preferences -> Bool
(Preferences -> Preferences -> Bool)
-> (Preferences -> Preferences -> Bool) -> Eq Preferences
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Preferences -> Preferences -> Bool
== :: Preferences -> Preferences -> Bool
$c/= :: Preferences -> Preferences -> Bool
/= :: Preferences -> Preferences -> Bool
Eq, (forall x. Preferences -> Rep Preferences x)
-> (forall x. Rep Preferences x -> Preferences)
-> Generic Preferences
forall x. Rep Preferences x -> Preferences
forall x. Preferences -> Rep Preferences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Preferences -> Rep Preferences x
from :: forall x. Preferences -> Rep Preferences x
$cto :: forall x. Rep Preferences x -> Preferences
to :: forall x. Rep Preferences x -> Preferences
Generic, Eq Preferences
Eq Preferences =>
(Preferences -> Preferences -> Ordering)
-> (Preferences -> Preferences -> Bool)
-> (Preferences -> Preferences -> Bool)
-> (Preferences -> Preferences -> Bool)
-> (Preferences -> Preferences -> Bool)
-> (Preferences -> Preferences -> Preferences)
-> (Preferences -> Preferences -> Preferences)
-> Ord Preferences
Preferences -> Preferences -> Bool
Preferences -> Preferences -> Ordering
Preferences -> Preferences -> Preferences
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Preferences -> Preferences -> Ordering
compare :: Preferences -> Preferences -> Ordering
$c< :: Preferences -> Preferences -> Bool
< :: Preferences -> Preferences -> Bool
$c<= :: Preferences -> Preferences -> Bool
<= :: Preferences -> Preferences -> Bool
$c> :: Preferences -> Preferences -> Bool
> :: Preferences -> Preferences -> Bool
$c>= :: Preferences -> Preferences -> Bool
>= :: Preferences -> Preferences -> Bool
$cmax :: Preferences -> Preferences -> Preferences
max :: Preferences -> Preferences -> Preferences
$cmin :: Preferences -> Preferences -> Preferences
min :: Preferences -> Preferences -> Preferences
Ord, Int -> Preferences -> [Char] -> [Char]
[Preferences] -> [Char] -> [Char]
Preferences -> [Char]
(Int -> Preferences -> [Char] -> [Char])
-> (Preferences -> [Char])
-> ([Preferences] -> [Char] -> [Char])
-> Show Preferences
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Preferences -> [Char] -> [Char]
showsPrec :: Int -> Preferences -> [Char] -> [Char]
$cshow :: Preferences -> [Char]
show :: Preferences -> [Char]
$cshowList :: [Preferences] -> [Char] -> [Char]
showList :: [Preferences] -> [Char] -> [Char]
Show, Typeable)

instance Semigroup Preferences where
    Preferences
a <> :: Preferences -> Preferences -> Preferences
<> Preferences
b =
        Preferences
            { _prefSymmetric :: [SymmetricAlgorithm]
_prefSymmetric = Preferences -> [SymmetricAlgorithm]
_prefSymmetric Preferences
a [SymmetricAlgorithm]
-> [SymmetricAlgorithm] -> [SymmetricAlgorithm]
forall a. Semigroup a => a -> a -> a
<> Preferences -> [SymmetricAlgorithm]
_prefSymmetric Preferences
b
            , _prefHash :: [HashAlgorithm]
_prefHash = Preferences -> [HashAlgorithm]
_prefHash Preferences
a [HashAlgorithm] -> [HashAlgorithm] -> [HashAlgorithm]
forall a. Semigroup a => a -> a -> a
<> Preferences -> [HashAlgorithm]
_prefHash Preferences
b
            , _prefCompress :: [CompressionAlgorithm]
_prefCompress = Preferences -> [CompressionAlgorithm]
_prefCompress Preferences
a [CompressionAlgorithm]
-> [CompressionAlgorithm] -> [CompressionAlgorithm]
forall a. Semigroup a => a -> a -> a
<> Preferences -> [CompressionAlgorithm]
_prefCompress Preferences
b
            , _prefAEAD :: [(SymmetricAlgorithm, AEADAlgorithm)]
_prefAEAD = Preferences -> [(SymmetricAlgorithm, AEADAlgorithm)]
_prefAEAD Preferences
a [(SymmetricAlgorithm, AEADAlgorithm)]
-> [(SymmetricAlgorithm, AEADAlgorithm)]
-> [(SymmetricAlgorithm, AEADAlgorithm)]
forall a. Semigroup a => a -> a -> a
<> Preferences -> [(SymmetricAlgorithm, AEADAlgorithm)]
_prefAEAD Preferences
b
            , _prefKeyServer :: Set KSPFlag
_prefKeyServer = Preferences -> Set KSPFlag
_prefKeyServer Preferences
a Set KSPFlag -> Set KSPFlag -> Set KSPFlag
forall a. Semigroup a => a -> a -> a
<> Preferences -> Set KSPFlag
_prefKeyServer Preferences
b
            , _prefFeatures :: Set FeatureFlag
_prefFeatures = Preferences -> Set FeatureFlag
_prefFeatures Preferences
a Set FeatureFlag -> Set FeatureFlag -> Set FeatureFlag
forall a. Semigroup a => a -> a -> a
<> Preferences -> Set FeatureFlag
_prefFeatures Preferences
b
            }

instance Monoid Preferences where
    mempty :: Preferences
mempty =
        Preferences
            { _prefSymmetric :: [SymmetricAlgorithm]
_prefSymmetric = [SymmetricAlgorithm]
forall a. Monoid a => a
mempty
            , _prefHash :: [HashAlgorithm]
_prefHash = [HashAlgorithm]
forall a. Monoid a => a
mempty
            , _prefCompress :: [CompressionAlgorithm]
_prefCompress = [CompressionAlgorithm]
forall a. Monoid a => a
mempty
            , _prefAEAD :: [(SymmetricAlgorithm, AEADAlgorithm)]
_prefAEAD = [(SymmetricAlgorithm, AEADAlgorithm)]
forall a. Monoid a => a
mempty
            , _prefKeyServer :: Set KSPFlag
_prefKeyServer = Set KSPFlag
forall a. Monoid a => a
mempty
            , _prefFeatures :: Set FeatureFlag
_prefFeatures = Set FeatureFlag
forall a. Monoid a => a
mempty
            }

data SubkeySpec = SubkeySpec
    { SubkeySpec -> SomePKPayload
_subkeyPayload :: SomePKPayload
    , SubkeySpec -> SKey
_subkeySKey :: SKey
    , SubkeySpec -> Set KeyFlag
_subkeyUsage :: Set KeyFlag
    , SubkeySpec -> Maybe ThirtyTwoBitTimeStamp
_subkeyTimestamp :: Maybe ThirtyTwoBitTimeStamp
    }
    deriving (Typeable SubkeySpec
Typeable SubkeySpec =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SubkeySpec -> c SubkeySpec)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SubkeySpec)
-> (SubkeySpec -> Constr)
-> (SubkeySpec -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SubkeySpec))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SubkeySpec))
-> ((forall b. Data b => b -> b) -> SubkeySpec -> SubkeySpec)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SubkeySpec -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SubkeySpec -> r)
-> (forall u. (forall d. Data d => d -> u) -> SubkeySpec -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SubkeySpec -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SubkeySpec -> m SubkeySpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SubkeySpec -> m SubkeySpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SubkeySpec -> m SubkeySpec)
-> Data SubkeySpec
SubkeySpec -> Constr
SubkeySpec -> DataType
(forall b. Data b => b -> b) -> SubkeySpec -> SubkeySpec
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SubkeySpec -> u
forall u. (forall d. Data d => d -> u) -> SubkeySpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SubkeySpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SubkeySpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SubkeySpec -> m SubkeySpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SubkeySpec -> m SubkeySpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubkeySpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SubkeySpec -> c SubkeySpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SubkeySpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SubkeySpec)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SubkeySpec -> c SubkeySpec
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SubkeySpec -> c SubkeySpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubkeySpec
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubkeySpec
$ctoConstr :: SubkeySpec -> Constr
toConstr :: SubkeySpec -> Constr
$cdataTypeOf :: SubkeySpec -> DataType
dataTypeOf :: SubkeySpec -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SubkeySpec)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SubkeySpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SubkeySpec)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SubkeySpec)
$cgmapT :: (forall b. Data b => b -> b) -> SubkeySpec -> SubkeySpec
gmapT :: (forall b. Data b => b -> b) -> SubkeySpec -> SubkeySpec
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SubkeySpec -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SubkeySpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SubkeySpec -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SubkeySpec -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SubkeySpec -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SubkeySpec -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SubkeySpec -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SubkeySpec -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SubkeySpec -> m SubkeySpec
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SubkeySpec -> m SubkeySpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SubkeySpec -> m SubkeySpec
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SubkeySpec -> m SubkeySpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SubkeySpec -> m SubkeySpec
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SubkeySpec -> m SubkeySpec
Data, SubkeySpec -> SubkeySpec -> Bool
(SubkeySpec -> SubkeySpec -> Bool)
-> (SubkeySpec -> SubkeySpec -> Bool) -> Eq SubkeySpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubkeySpec -> SubkeySpec -> Bool
== :: SubkeySpec -> SubkeySpec -> Bool
$c/= :: SubkeySpec -> SubkeySpec -> Bool
/= :: SubkeySpec -> SubkeySpec -> Bool
Eq, (forall x. SubkeySpec -> Rep SubkeySpec x)
-> (forall x. Rep SubkeySpec x -> SubkeySpec) -> Generic SubkeySpec
forall x. Rep SubkeySpec x -> SubkeySpec
forall x. SubkeySpec -> Rep SubkeySpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SubkeySpec -> Rep SubkeySpec x
from :: forall x. SubkeySpec -> Rep SubkeySpec x
$cto :: forall x. Rep SubkeySpec x -> SubkeySpec
to :: forall x. Rep SubkeySpec x -> SubkeySpec
Generic, Eq SubkeySpec
Eq SubkeySpec =>
(SubkeySpec -> SubkeySpec -> Ordering)
-> (SubkeySpec -> SubkeySpec -> Bool)
-> (SubkeySpec -> SubkeySpec -> Bool)
-> (SubkeySpec -> SubkeySpec -> Bool)
-> (SubkeySpec -> SubkeySpec -> Bool)
-> (SubkeySpec -> SubkeySpec -> SubkeySpec)
-> (SubkeySpec -> SubkeySpec -> SubkeySpec)
-> Ord SubkeySpec
SubkeySpec -> SubkeySpec -> Bool
SubkeySpec -> SubkeySpec -> Ordering
SubkeySpec -> SubkeySpec -> SubkeySpec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SubkeySpec -> SubkeySpec -> Ordering
compare :: SubkeySpec -> SubkeySpec -> Ordering
$c< :: SubkeySpec -> SubkeySpec -> Bool
< :: SubkeySpec -> SubkeySpec -> Bool
$c<= :: SubkeySpec -> SubkeySpec -> Bool
<= :: SubkeySpec -> SubkeySpec -> Bool
$c> :: SubkeySpec -> SubkeySpec -> Bool
> :: SubkeySpec -> SubkeySpec -> Bool
$c>= :: SubkeySpec -> SubkeySpec -> Bool
>= :: SubkeySpec -> SubkeySpec -> Bool
$cmax :: SubkeySpec -> SubkeySpec -> SubkeySpec
max :: SubkeySpec -> SubkeySpec -> SubkeySpec
$cmin :: SubkeySpec -> SubkeySpec -> SubkeySpec
min :: SubkeySpec -> SubkeySpec -> SubkeySpec
Ord, Int -> SubkeySpec -> [Char] -> [Char]
[SubkeySpec] -> [Char] -> [Char]
SubkeySpec -> [Char]
(Int -> SubkeySpec -> [Char] -> [Char])
-> (SubkeySpec -> [Char])
-> ([SubkeySpec] -> [Char] -> [Char])
-> Show SubkeySpec
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> SubkeySpec -> [Char] -> [Char]
showsPrec :: Int -> SubkeySpec -> [Char] -> [Char]
$cshow :: SubkeySpec -> [Char]
show :: SubkeySpec -> [Char]
$cshowList :: [SubkeySpec] -> [Char] -> [Char]
showList :: [SubkeySpec] -> [Char] -> [Char]
Show, Typeable)

data TKGenError
    = NoPrimaryKey
    | KeyGenFailed String
    | SignatureFailed String
    | SerializationFailed String
    | InvalidConfiguration String
    deriving (TKGenError -> TKGenError -> Bool
(TKGenError -> TKGenError -> Bool)
-> (TKGenError -> TKGenError -> Bool) -> Eq TKGenError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TKGenError -> TKGenError -> Bool
== :: TKGenError -> TKGenError -> Bool
$c/= :: TKGenError -> TKGenError -> Bool
/= :: TKGenError -> TKGenError -> Bool
Eq, Int -> TKGenError -> [Char] -> [Char]
[TKGenError] -> [Char] -> [Char]
TKGenError -> [Char]
(Int -> TKGenError -> [Char] -> [Char])
-> (TKGenError -> [Char])
-> ([TKGenError] -> [Char] -> [Char])
-> Show TKGenError
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> TKGenError -> [Char] -> [Char]
showsPrec :: Int -> TKGenError -> [Char] -> [Char]
$cshow :: TKGenError -> [Char]
show :: TKGenError -> [Char]
$cshowList :: [TKGenError] -> [Char] -> [Char]
showList :: [TKGenError] -> [Char] -> [Char]
Show)

data SignatureSpec = SignatureSpec
    { SignatureSpec -> Maybe Duration
_sigSpecExpiration :: Maybe Duration
    , SignatureSpec -> Maybe (Set KeyFlag)
_sigSpecKeyFlags :: Maybe (Set KeyFlag)
    }
    deriving (Typeable SignatureSpec
Typeable SignatureSpec =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SignatureSpec -> c SignatureSpec)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SignatureSpec)
-> (SignatureSpec -> Constr)
-> (SignatureSpec -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SignatureSpec))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SignatureSpec))
-> ((forall b. Data b => b -> b) -> SignatureSpec -> SignatureSpec)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SignatureSpec -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SignatureSpec -> r)
-> (forall u. (forall d. Data d => d -> u) -> SignatureSpec -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SignatureSpec -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SignatureSpec -> m SignatureSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SignatureSpec -> m SignatureSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SignatureSpec -> m SignatureSpec)
-> Data SignatureSpec
SignatureSpec -> Constr
SignatureSpec -> DataType
(forall b. Data b => b -> b) -> SignatureSpec -> SignatureSpec
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SignatureSpec -> u
forall u. (forall d. Data d => d -> u) -> SignatureSpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignatureSpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignatureSpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SignatureSpec -> m SignatureSpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignatureSpec -> m SignatureSpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignatureSpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignatureSpec -> c SignatureSpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignatureSpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SignatureSpec)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignatureSpec -> c SignatureSpec
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignatureSpec -> c SignatureSpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignatureSpec
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignatureSpec
$ctoConstr :: SignatureSpec -> Constr
toConstr :: SignatureSpec -> Constr
$cdataTypeOf :: SignatureSpec -> DataType
dataTypeOf :: SignatureSpec -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignatureSpec)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignatureSpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SignatureSpec)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SignatureSpec)
$cgmapT :: (forall b. Data b => b -> b) -> SignatureSpec -> SignatureSpec
gmapT :: (forall b. Data b => b -> b) -> SignatureSpec -> SignatureSpec
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignatureSpec -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignatureSpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignatureSpec -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignatureSpec -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SignatureSpec -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SignatureSpec -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SignatureSpec -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SignatureSpec -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SignatureSpec -> m SignatureSpec
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SignatureSpec -> m SignatureSpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignatureSpec -> m SignatureSpec
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignatureSpec -> m SignatureSpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignatureSpec -> m SignatureSpec
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignatureSpec -> m SignatureSpec
Data, SignatureSpec -> SignatureSpec -> Bool
(SignatureSpec -> SignatureSpec -> Bool)
-> (SignatureSpec -> SignatureSpec -> Bool) -> Eq SignatureSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignatureSpec -> SignatureSpec -> Bool
== :: SignatureSpec -> SignatureSpec -> Bool
$c/= :: SignatureSpec -> SignatureSpec -> Bool
/= :: SignatureSpec -> SignatureSpec -> Bool
Eq, (forall x. SignatureSpec -> Rep SignatureSpec x)
-> (forall x. Rep SignatureSpec x -> SignatureSpec)
-> Generic SignatureSpec
forall x. Rep SignatureSpec x -> SignatureSpec
forall x. SignatureSpec -> Rep SignatureSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SignatureSpec -> Rep SignatureSpec x
from :: forall x. SignatureSpec -> Rep SignatureSpec x
$cto :: forall x. Rep SignatureSpec x -> SignatureSpec
to :: forall x. Rep SignatureSpec x -> SignatureSpec
Generic, Eq SignatureSpec
Eq SignatureSpec =>
(SignatureSpec -> SignatureSpec -> Ordering)
-> (SignatureSpec -> SignatureSpec -> Bool)
-> (SignatureSpec -> SignatureSpec -> Bool)
-> (SignatureSpec -> SignatureSpec -> Bool)
-> (SignatureSpec -> SignatureSpec -> Bool)
-> (SignatureSpec -> SignatureSpec -> SignatureSpec)
-> (SignatureSpec -> SignatureSpec -> SignatureSpec)
-> Ord SignatureSpec
SignatureSpec -> SignatureSpec -> Bool
SignatureSpec -> SignatureSpec -> Ordering
SignatureSpec -> SignatureSpec -> SignatureSpec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SignatureSpec -> SignatureSpec -> Ordering
compare :: SignatureSpec -> SignatureSpec -> Ordering
$c< :: SignatureSpec -> SignatureSpec -> Bool
< :: SignatureSpec -> SignatureSpec -> Bool
$c<= :: SignatureSpec -> SignatureSpec -> Bool
<= :: SignatureSpec -> SignatureSpec -> Bool
$c> :: SignatureSpec -> SignatureSpec -> Bool
> :: SignatureSpec -> SignatureSpec -> Bool
$c>= :: SignatureSpec -> SignatureSpec -> Bool
>= :: SignatureSpec -> SignatureSpec -> Bool
$cmax :: SignatureSpec -> SignatureSpec -> SignatureSpec
max :: SignatureSpec -> SignatureSpec -> SignatureSpec
$cmin :: SignatureSpec -> SignatureSpec -> SignatureSpec
min :: SignatureSpec -> SignatureSpec -> SignatureSpec
Ord, Int -> SignatureSpec -> [Char] -> [Char]
[SignatureSpec] -> [Char] -> [Char]
SignatureSpec -> [Char]
(Int -> SignatureSpec -> [Char] -> [Char])
-> (SignatureSpec -> [Char])
-> ([SignatureSpec] -> [Char] -> [Char])
-> Show SignatureSpec
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> SignatureSpec -> [Char] -> [Char]
showsPrec :: Int -> SignatureSpec -> [Char] -> [Char]
$cshow :: SignatureSpec -> [Char]
show :: SignatureSpec -> [Char]
$cshowList :: [SignatureSpec] -> [Char] -> [Char]
showList :: [SignatureSpec] -> [Char] -> [Char]
Show, Typeable)

{- | Run a key-generation action with the given key version and timestamp.

The base monad @m@ must satisfy 'MonadRandom' because key material and
signature salts are drawn from it.  No explicit seed is required; the
caller is responsible for providing a suitable random source (e.g. 'IO').
-}
runTKGen
    :: MonadRandom m
    => (KeyVersion, ThirtyTwoBitTimeStamp)
    -> TKGen m 'SecretTK a
    -> m (Either TKGenError (a, TK 'SecretTK))
runTKGen :: forall (m :: * -> *) a.
MonadRandom m =>
(KeyVersion, ThirtyTwoBitTimeStamp)
-> TKGen m 'SecretTK a -> m (Either TKGenError (a, TK 'SecretTK))
runTKGen (KeyVersion, ThirtyTwoBitTimeStamp)
kvts (TKGen {unTKGen :: forall (m :: * -> *) (v :: TKKind) a.
TKGen m v a
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     a
unTKGen = RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
action}) = do
    result <- ExceptT TKGenError m (a, TK 'SecretTK)
-> m (Either TKGenError (a, TK 'SecretTK))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT TKGenError m (a, TK 'SecretTK)
 -> m (Either TKGenError (a, TK 'SecretTK)))
-> ExceptT TKGenError m (a, TK 'SecretTK)
-> m (Either TKGenError (a, TK 'SecretTK))
forall a b. (a -> b) -> a -> b
$ do
        (a, state, _log) <- RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> (KeyVersion, ThirtyTwoBitTimeStamp)
-> TKGenState
-> ExceptT TKGenError m (a, TKGenState, [[Char]])
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
action (KeyVersion, ThirtyTwoBitTimeStamp)
kvts TKGenState
forall a. Monoid a => a
mempty
        tk <- finalize state
        pure (a, tk)
    pure result

{- | Run a key-generation action with a deterministic seed.

This is useful for testing, where reproducible key material is required.
The seed is used to initialize a 'ChaChaDRG', and the final DRG state
is returned alongside the result so that the random sequence can be
continued if needed.
-}
runTKGenWithSeed
    :: B.ByteString
    -> (KeyVersion, ThirtyTwoBitTimeStamp)
    -> TKGen (MonadPseudoRandom ChaChaDRG) 'SecretTK a
    -> (Either TKGenError (a, TK 'SecretTK), ChaChaDRG)
runTKGenWithSeed :: forall a.
ByteString
-> (KeyVersion, ThirtyTwoBitTimeStamp)
-> TKGen (MonadPseudoRandom ChaChaDRG) 'SecretTK a
-> (Either TKGenError (a, TK 'SecretTK), ChaChaDRG)
runTKGenWithSeed ByteString
seedBytes (KeyVersion, ThirtyTwoBitTimeStamp)
kvts (TKGen {unTKGen :: forall (m :: * -> *) (v :: TKKind) a.
TKGen m v a
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     a
unTKGen = RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError (MonadPseudoRandom ChaChaDRG))
  a
action}) =
    case CryptoFailable Seed -> Either CryptoError Seed
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ByteString -> CryptoFailable Seed
forall b. ByteArrayAccess b => b -> CryptoFailable Seed
seedFromBinary ByteString
seedBytes) of
        Left CryptoError
err -> [Char] -> (Either TKGenError (a, TK 'SecretTK), ChaChaDRG)
forall a. HasCallStack => [Char] -> a
error ([Char]
"invalid seed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err)
        Right Seed
seed' ->
            let drg :: ChaChaDRG
drg = Seed -> ChaChaDRG
drgNewSeed Seed
seed'
             in ChaChaDRG
-> MonadPseudoRandom
     ChaChaDRG (Either TKGenError (a, TK 'SecretTK))
-> (Either TKGenError (a, TK 'SecretTK), ChaChaDRG)
forall gen a. DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
withDRG ChaChaDRG
drg (MonadPseudoRandom ChaChaDRG (Either TKGenError (a, TK 'SecretTK))
 -> (Either TKGenError (a, TK 'SecretTK), ChaChaDRG))
-> MonadPseudoRandom
     ChaChaDRG (Either TKGenError (a, TK 'SecretTK))
-> (Either TKGenError (a, TK 'SecretTK), ChaChaDRG)
forall a b. (a -> b) -> a -> b
$ ExceptT TKGenError (MonadPseudoRandom ChaChaDRG) (a, TK 'SecretTK)
-> MonadPseudoRandom
     ChaChaDRG (Either TKGenError (a, TK 'SecretTK))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT TKGenError (MonadPseudoRandom ChaChaDRG) (a, TK 'SecretTK)
 -> MonadPseudoRandom
      ChaChaDRG (Either TKGenError (a, TK 'SecretTK)))
-> ExceptT
     TKGenError (MonadPseudoRandom ChaChaDRG) (a, TK 'SecretTK)
-> MonadPseudoRandom
     ChaChaDRG (Either TKGenError (a, TK 'SecretTK))
forall a b. (a -> b) -> a -> b
$ do
                    (a, state, _log) <- RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError (MonadPseudoRandom ChaChaDRG))
  a
-> (KeyVersion, ThirtyTwoBitTimeStamp)
-> TKGenState
-> ExceptT
     TKGenError (MonadPseudoRandom ChaChaDRG) (a, TKGenState, [[Char]])
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError (MonadPseudoRandom ChaChaDRG))
  a
action (KeyVersion, ThirtyTwoBitTimeStamp)
kvts TKGenState
forall a. Monoid a => a
mempty
                    tk <- finalize state
                    pure (a, tk)

{- | Obtain the current creation time paired with a chosen 'KeyVersion'.

Call this at the application boundary before 'runTKGen'.
-}
withKeyVersionAndTimestamp
    :: KeyVersion -> IO (KeyVersion, ThirtyTwoBitTimeStamp)
withKeyVersionAndTimestamp :: KeyVersion -> IO (KeyVersion, ThirtyTwoBitTimeStamp)
withKeyVersionAndTimestamp KeyVersion
kv = do
    posix <- IO POSIXTime
getPOSIXTime
    let ts = Word32 -> ThirtyTwoBitTimeStamp
ThirtyTwoBitTimeStamp (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (POSIXTime -> Word32
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor POSIXTime
posix :: Word32))
    pure (kv, ts)

{- | Generate the primary key pair using the key version and timestamp from
the Reader.  Uses a default RSA key size of 4096 bits for RSA keys.
-}
newKey
    :: forall m
     . MonadRandom m
    => PubKeyAlgorithm
    -> TKGen m 'SecretTK (SomePKPayload, SKey)
newKey :: forall (m :: * -> *).
MonadRandom m =>
PubKeyAlgorithm -> TKGen m 'SecretTK (SomePKPayload, SKey)
newKey PubKeyAlgorithm
algo = do
    (kv, ct) <- RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  (KeyVersion, ThirtyTwoBitTimeStamp)
-> TKGen m 'SecretTK (KeyVersion, ThirtyTwoBitTimeStamp)
forall (m :: * -> *) (v :: TKKind) a.
RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> TKGen m v a
TKGen RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  (KeyVersion, ThirtyTwoBitTimeStamp)
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
ask
    msize <- TKGen $ gets (Map.lookup algo . _tkGenKeySizes)
    let rsaSize = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
4096 Maybe Int
msize
    (pkp, skey) <- TKGen $ lift $ generateKey kv ct algo rsaSize
    TKGen $ modify $ \TKGenState
s -> TKGenState
s {_tkGenPrimary = Just (pkp, skey)}
    pure (pkp, skey)

{- | Set the key size for a variable-size algorithm (currently only RSA).
Calling this for a fixed-size algorithm (Ed25519, X25519, Ed448, X448,
etc.) will fail with 'InvalidConfiguration'.
-}
setKeySize
    :: forall m
     . Monad m
    => PubKeyAlgorithm
    -> Int
    -> TKGen m 'SecretTK ()
setKeySize :: forall (m :: * -> *).
Monad m =>
PubKeyAlgorithm -> Int -> TKGen m 'SecretTK ()
setKeySize PubKeyAlgorithm
algo Int
size = case PubKeyAlgorithm
algo of
    PubKeyAlgorithm
RSA -> RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  ()
-> TKGen m 'SecretTK ()
forall (m :: * -> *) (v :: TKKind) a.
RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> TKGen m v a
TKGen (RWST
   (KeyVersion, ThirtyTwoBitTimeStamp)
   [[Char]]
   TKGenState
   (ExceptT TKGenError m)
   ()
 -> TKGen m 'SecretTK ())
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
-> TKGen m 'SecretTK ()
forall a b. (a -> b) -> a -> b
$ (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify ((TKGenState -> TKGenState)
 -> RWST
      (KeyVersion, ThirtyTwoBitTimeStamp)
      [[Char]]
      TKGenState
      (ExceptT TKGenError m)
      ())
-> (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall a b. (a -> b) -> a -> b
$ \TKGenState
s ->
        TKGenState
s {_tkGenKeySizes = Map.insert algo size (_tkGenKeySizes s)}
    PubKeyAlgorithm
_ ->
        RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  ()
-> TKGen m 'SecretTK ()
forall (m :: * -> *) (v :: TKKind) a.
RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> TKGen m v a
TKGen (RWST
   (KeyVersion, ThirtyTwoBitTimeStamp)
   [[Char]]
   TKGenState
   (ExceptT TKGenError m)
   ()
 -> TKGen m 'SecretTK ())
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
-> TKGen m 'SecretTK ()
forall a b. (a -> b) -> a -> b
$
            ExceptT TKGenError m ()
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> RWST (KeyVersion, ThirtyTwoBitTimeStamp) [[Char]] TKGenState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT TKGenError m ()
 -> RWST
      (KeyVersion, ThirtyTwoBitTimeStamp)
      [[Char]]
      TKGenState
      (ExceptT TKGenError m)
      ())
-> ExceptT TKGenError m ()
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall a b. (a -> b) -> a -> b
$
                TKGenError -> ExceptT TKGenError m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
                    ( [Char] -> TKGenError
InvalidConfiguration
                        ([Char]
"key size can only be set for RSA, not " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PubKeyAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show PubKeyAlgorithm
algo)
                    )

-- | Append a user ID to the certificate.
addUID
    :: forall m
     . Monad m
    => Text
    -> TKGen m 'SecretTK ()
addUID :: forall (m :: * -> *). Monad m => Text -> TKGen m 'SecretTK ()
addUID Text
uid = RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  ()
-> TKGen m 'SecretTK ()
forall (m :: * -> *) (v :: TKKind) a.
RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> TKGen m v a
TKGen (RWST
   (KeyVersion, ThirtyTwoBitTimeStamp)
   [[Char]]
   TKGenState
   (ExceptT TKGenError m)
   ()
 -> TKGen m 'SecretTK ())
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
-> TKGen m 'SecretTK ()
forall a b. (a -> b) -> a -> b
$ (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify ((TKGenState -> TKGenState)
 -> RWST
      (KeyVersion, ThirtyTwoBitTimeStamp)
      [[Char]]
      TKGenState
      (ExceptT TKGenError m)
      ())
-> (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall a b. (a -> b) -> a -> b
$ \TKGenState
s ->
    TKGenState
s {_tkGenUIDs = _tkGenUIDs s ++ [uid]}

-- | Append a user ID with an explicit 'SignatureSpec' override.
addUIDWith
    :: forall m
     . Monad m
    => Text
    -> SignatureSpec
    -> TKGen m 'SecretTK ()
addUIDWith :: forall (m :: * -> *).
Monad m =>
Text -> SignatureSpec -> TKGen m 'SecretTK ()
addUIDWith Text
_ SignatureSpec
_ = () -> TKGen m 'SecretTK ()
forall a. a -> TKGen m 'SecretTK a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- SignatureSpec overrides are stored for finalization.
-- This placeholder preserves the API surface; the runtime
-- currently ignores per-UID overrides and uses the defaults.

{- | Generate a subkey (same key version as the primary) with the
specified key flags.  Uses a default RSA key size of 4096 bits for
RSA keys.
-}
addSubkey
    :: MonadRandom m
    => PubKeyAlgorithm
    -> [KeyFlag]
    -> TKGen m 'SecretTK (SomePKPayload, SKey)
addSubkey :: forall (m :: * -> *).
MonadRandom m =>
PubKeyAlgorithm
-> [KeyFlag] -> TKGen m 'SecretTK (SomePKPayload, SKey)
addSubkey PubKeyAlgorithm
algo [KeyFlag]
flags = do
    (kv, ct) <- RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  (KeyVersion, ThirtyTwoBitTimeStamp)
-> TKGen m 'SecretTK (KeyVersion, ThirtyTwoBitTimeStamp)
forall (m :: * -> *) (v :: TKKind) a.
RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> TKGen m v a
TKGen RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  (KeyVersion, ThirtyTwoBitTimeStamp)
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
ask
    msize <- TKGen $ gets (Map.lookup algo . _tkGenKeySizes)
    let rsaSize = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
4096 Maybe Int
msize
    (pkp, skey) <- TKGen $ lift $ generateKey kv ct algo rsaSize
    TKGen $ modify $ \TKGenState
s ->
        TKGenState
s
            { _tkGenSubkeys =
                _tkGenSubkeys
                    s
                    ++ [ SubkeySpec
                            { _subkeyPayload = pkp
                            , _subkeySKey = skey
                            , _subkeyUsage = Set.fromList flags
                            , _subkeyTimestamp = Nothing
                            }
                       ]
            }
    pure (pkp, skey)

{- | Set a creation-time expiration for the whole certificate (relative
to the primary key's creation time).  Omit the call entirely for a
non-expiring certificate.
-}
setExpiration
    :: forall m
     . Monad m
    => Duration
    -> TKGen m 'SecretTK ()
setExpiration :: forall (m :: * -> *). Monad m => Duration -> TKGen m 'SecretTK ()
setExpiration Duration
dur = RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  ()
-> TKGen m 'SecretTK ()
forall (m :: * -> *) (v :: TKKind) a.
RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> TKGen m v a
TKGen (RWST
   (KeyVersion, ThirtyTwoBitTimeStamp)
   [[Char]]
   TKGenState
   (ExceptT TKGenError m)
   ()
 -> TKGen m 'SecretTK ())
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
-> TKGen m 'SecretTK ()
forall a b. (a -> b) -> a -> b
$ (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify ((TKGenState -> TKGenState)
 -> RWST
      (KeyVersion, ThirtyTwoBitTimeStamp)
      [[Char]]
      TKGenState
      (ExceptT TKGenError m)
      ())
-> (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall a b. (a -> b) -> a -> b
$ \TKGenState
s ->
    TKGenState
s {_tkGenExpiration = Just (toThirtyTwoBitDuration dur)}

-- | Attach symmetric algorithm preferences for SEIPDv1 that flow into every binding signature.
setSEIPDv1SymmetricPreferences
    :: forall m
     . Monad m
    => [SymmetricAlgorithm]
    -> TKGen m 'SecretTK ()
setSEIPDv1SymmetricPreferences :: forall (m :: * -> *).
Monad m =>
[SymmetricAlgorithm] -> TKGen m 'SecretTK ()
setSEIPDv1SymmetricPreferences [SymmetricAlgorithm]
sym = RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  ()
-> TKGen m 'SecretTK ()
forall (m :: * -> *) (v :: TKKind) a.
RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> TKGen m v a
TKGen (RWST
   (KeyVersion, ThirtyTwoBitTimeStamp)
   [[Char]]
   TKGenState
   (ExceptT TKGenError m)
   ()
 -> TKGen m 'SecretTK ())
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
-> TKGen m 'SecretTK ()
forall a b. (a -> b) -> a -> b
$ (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify ((TKGenState -> TKGenState)
 -> RWST
      (KeyVersion, ThirtyTwoBitTimeStamp)
      [[Char]]
      TKGenState
      (ExceptT TKGenError m)
      ())
-> (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall a b. (a -> b) -> a -> b
$ \TKGenState
s ->
    TKGenState
s {_tkGenPrefs = (_tkGenPrefs s) {_prefSymmetric = sym}}

-- | Attach hash algorithm preferences that flow into every binding signature.
setHashPreferences
    :: forall m
     . Monad m
    => [HashAlgorithm]
    -> TKGen m 'SecretTK ()
setHashPreferences :: forall (m :: * -> *).
Monad m =>
[HashAlgorithm] -> TKGen m 'SecretTK ()
setHashPreferences [HashAlgorithm]
hash = RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  ()
-> TKGen m 'SecretTK ()
forall (m :: * -> *) (v :: TKKind) a.
RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> TKGen m v a
TKGen (RWST
   (KeyVersion, ThirtyTwoBitTimeStamp)
   [[Char]]
   TKGenState
   (ExceptT TKGenError m)
   ()
 -> TKGen m 'SecretTK ())
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
-> TKGen m 'SecretTK ()
forall a b. (a -> b) -> a -> b
$ (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify ((TKGenState -> TKGenState)
 -> RWST
      (KeyVersion, ThirtyTwoBitTimeStamp)
      [[Char]]
      TKGenState
      (ExceptT TKGenError m)
      ())
-> (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall a b. (a -> b) -> a -> b
$ \TKGenState
s ->
    TKGenState
s {_tkGenPrefs = (_tkGenPrefs s) {_prefHash = hash}}

-- | Attach compression algorithm preferences that flow into every binding signature.
setCompressionPreferences
    :: forall m
     . Monad m
    => [CompressionAlgorithm]
    -> TKGen m 'SecretTK ()
setCompressionPreferences :: forall (m :: * -> *).
Monad m =>
[CompressionAlgorithm] -> TKGen m 'SecretTK ()
setCompressionPreferences [CompressionAlgorithm]
comp = RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  ()
-> TKGen m 'SecretTK ()
forall (m :: * -> *) (v :: TKKind) a.
RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> TKGen m v a
TKGen (RWST
   (KeyVersion, ThirtyTwoBitTimeStamp)
   [[Char]]
   TKGenState
   (ExceptT TKGenError m)
   ()
 -> TKGen m 'SecretTK ())
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
-> TKGen m 'SecretTK ()
forall a b. (a -> b) -> a -> b
$ (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify ((TKGenState -> TKGenState)
 -> RWST
      (KeyVersion, ThirtyTwoBitTimeStamp)
      [[Char]]
      TKGenState
      (ExceptT TKGenError m)
      ())
-> (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall a b. (a -> b) -> a -> b
$ \TKGenState
s ->
    TKGenState
s {_tkGenPrefs = (_tkGenPrefs s) {_prefCompress = comp}}

-- | Attach AEAD ciphersuite preferences that flow into every binding signature.
setAEADPreferences
    :: forall m
     . Monad m
    => [(SymmetricAlgorithm, AEADAlgorithm)]
    -> TKGen m 'SecretTK ()
setAEADPreferences :: forall (m :: * -> *).
Monad m =>
[(SymmetricAlgorithm, AEADAlgorithm)] -> TKGen m 'SecretTK ()
setAEADPreferences [(SymmetricAlgorithm, AEADAlgorithm)]
aead = RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  ()
-> TKGen m 'SecretTK ()
forall (m :: * -> *) (v :: TKKind) a.
RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> TKGen m v a
TKGen (RWST
   (KeyVersion, ThirtyTwoBitTimeStamp)
   [[Char]]
   TKGenState
   (ExceptT TKGenError m)
   ()
 -> TKGen m 'SecretTK ())
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
-> TKGen m 'SecretTK ()
forall a b. (a -> b) -> a -> b
$ (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify ((TKGenState -> TKGenState)
 -> RWST
      (KeyVersion, ThirtyTwoBitTimeStamp)
      [[Char]]
      TKGenState
      (ExceptT TKGenError m)
      ())
-> (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall a b. (a -> b) -> a -> b
$ \TKGenState
s ->
    TKGenState
s {_tkGenPrefs = (_tkGenPrefs s) {_prefAEAD = aead}}

-- | Attach key server preferences that flow into every binding signature.
setKeyServerPreferences
    :: forall m
     . Monad m
    => Set KSPFlag
    -> TKGen m 'SecretTK ()
setKeyServerPreferences :: forall (m :: * -> *).
Monad m =>
Set KSPFlag -> TKGen m 'SecretTK ()
setKeyServerPreferences Set KSPFlag
ksp = RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  ()
-> TKGen m 'SecretTK ()
forall (m :: * -> *) (v :: TKKind) a.
RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> TKGen m v a
TKGen (RWST
   (KeyVersion, ThirtyTwoBitTimeStamp)
   [[Char]]
   TKGenState
   (ExceptT TKGenError m)
   ()
 -> TKGen m 'SecretTK ())
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
-> TKGen m 'SecretTK ()
forall a b. (a -> b) -> a -> b
$ (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify ((TKGenState -> TKGenState)
 -> RWST
      (KeyVersion, ThirtyTwoBitTimeStamp)
      [[Char]]
      TKGenState
      (ExceptT TKGenError m)
      ())
-> (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall a b. (a -> b) -> a -> b
$ \TKGenState
s ->
    TKGenState
s {_tkGenPrefs = (_tkGenPrefs s) {_prefKeyServer = ksp}}

-- | Attach feature flags that flow into every binding signature.
setFeatures
    :: forall m
     . Monad m
    => Set FeatureFlag
    -> TKGen m 'SecretTK ()
setFeatures :: forall (m :: * -> *).
Monad m =>
Set FeatureFlag -> TKGen m 'SecretTK ()
setFeatures Set FeatureFlag
ff = RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  ()
-> TKGen m 'SecretTK ()
forall (m :: * -> *) (v :: TKKind) a.
RWST
  (KeyVersion, ThirtyTwoBitTimeStamp)
  [[Char]]
  TKGenState
  (ExceptT TKGenError m)
  a
-> TKGen m v a
TKGen (RWST
   (KeyVersion, ThirtyTwoBitTimeStamp)
   [[Char]]
   TKGenState
   (ExceptT TKGenError m)
   ()
 -> TKGen m 'SecretTK ())
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
-> TKGen m 'SecretTK ()
forall a b. (a -> b) -> a -> b
$ (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify ((TKGenState -> TKGenState)
 -> RWST
      (KeyVersion, ThirtyTwoBitTimeStamp)
      [[Char]]
      TKGenState
      (ExceptT TKGenError m)
      ())
-> (TKGenState -> TKGenState)
-> RWST
     (KeyVersion, ThirtyTwoBitTimeStamp)
     [[Char]]
     TKGenState
     (ExceptT TKGenError m)
     ()
forall a b. (a -> b) -> a -> b
$ \TKGenState
s ->
    TKGenState
s {_tkGenPrefs = (_tkGenPrefs s) {_prefFeatures = ff}}

-- -----------------------------------------------------------------------------
-- Internal key generation
-- -----------------------------------------------------------------------------

generateKey
    :: forall m
     . MonadRandom m
    => KeyVersion
    -> ThirtyTwoBitTimeStamp
    -> PubKeyAlgorithm
    -> Int
    -> ExceptT TKGenError m (SomePKPayload, SKey)
generateKey :: forall (m :: * -> *).
MonadRandom m =>
KeyVersion
-> ThirtyTwoBitTimeStamp
-> PubKeyAlgorithm
-> Int
-> ExceptT TKGenError m (SomePKPayload, SKey)
generateKey KeyVersion
kv ThirtyTwoBitTimeStamp
ts PubKeyAlgorithm
algo Int
rsaSize = case PubKeyAlgorithm
algo of
    PubKeyAlgorithm
RSA -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> Int
-> ExceptT TKGenError m (SomePKPayload, SKey)
forall {m :: * -> *}.
MonadRandom m =>
KeyVersion
-> ThirtyTwoBitTimeStamp
-> Int
-> ExceptT TKGenError m (SomePKPayload, SKey)
rsaGenerate KeyVersion
kv ThirtyTwoBitTimeStamp
ts Int
rsaSize
    PubKeyAlgorithm
EdDSALegacy -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
forall {m :: * -> *}.
MonadRandom m =>
KeyVersion
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
ed25519Generate KeyVersion
kv ThirtyTwoBitTimeStamp
ts
    PubKeyAlgorithm
Ed448 -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
forall {m :: * -> *} {p}.
MonadRandom m =>
p
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
ed448Generate KeyVersion
kv ThirtyTwoBitTimeStamp
ts
    PubKeyAlgorithm
ECDH -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
forall {m :: * -> *}.
MonadRandom m =>
KeyVersion
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
x25519Generate KeyVersion
kv ThirtyTwoBitTimeStamp
ts
    PubKeyAlgorithm
X25519 -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
forall {m :: * -> *}.
MonadRandom m =>
KeyVersion
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
x25519Generate KeyVersion
kv ThirtyTwoBitTimeStamp
ts
    PubKeyAlgorithm
X448 -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
forall {m :: * -> *} {p}.
MonadRandom m =>
p
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
x448Generate KeyVersion
kv ThirtyTwoBitTimeStamp
ts
    PubKeyAlgorithm
Ed25519 -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
forall {m :: * -> *}.
MonadRandom m =>
KeyVersion
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
ed25519Generate KeyVersion
kv ThirtyTwoBitTimeStamp
ts
    PubKeyAlgorithm
_ ->
        TKGenError -> ExceptT TKGenError m (SomePKPayload, SKey)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
            ( [Char] -> TKGenError
KeyGenFailed
                ([Char]
"unsupported algorithm for key generation: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PubKeyAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show PubKeyAlgorithm
algo)
            )
  where
    rsaGenerate :: KeyVersion
-> ThirtyTwoBitTimeStamp
-> Int
-> ExceptT TKGenError m (SomePKPayload, SKey)
rsaGenerate KeyVersion
kv ThirtyTwoBitTimeStamp
ts Int
keySizeBits = do
        Bool -> ExceptT TKGenError m () -> ExceptT TKGenError m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
keySizeBits Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (ExceptT TKGenError m () -> ExceptT TKGenError m ())
-> ExceptT TKGenError m () -> ExceptT TKGenError m ()
forall a b. (a -> b) -> a -> b
$
            TKGenError -> ExceptT TKGenError m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
KeyGenFailed [Char]
"RSA key size must be a multiple of 8")
        let keySizeBytes :: Int
keySizeBytes = Int
keySizeBits Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
        (publicKey, privateKey) <- m (PublicKey, PrivateKey)
-> ExceptT TKGenError m (PublicKey, PrivateKey)
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (PublicKey, PrivateKey)
 -> ExceptT TKGenError m (PublicKey, PrivateKey))
-> m (PublicKey, PrivateKey)
-> ExceptT TKGenError m (PublicKey, PrivateKey)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> m (PublicKey, PrivateKey)
forall (m :: * -> *).
MonadRandom m =>
Int -> Integer -> m (PublicKey, PrivateKey)
RSA.generate Int
keySizeBytes Integer
65537
        let pkey = RSA_PublicKey -> PKey
RSAPubKey (PublicKey -> RSA_PublicKey
RSA_PublicKey PublicKey
publicKey)
            skey = RSA_PrivateKey -> SKey
RSAPrivateKey (PrivateKey -> RSA_PrivateKey
RSA_PrivateKey PrivateKey
privateKey)
            pkp = case KeyVersion
kv of
                KeyVersion
DeprecatedV3 -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> V3Expiration
-> PubKeyAlgorithm
-> PKey
-> SomePKPayload
PKPayload KeyVersion
DeprecatedV3 ThirtyTwoBitTimeStamp
ts V3Expiration
0 PubKeyAlgorithm
RSA PKey
pkey
                KeyVersion
V4 -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> V3Expiration
-> PubKeyAlgorithm
-> PKey
-> SomePKPayload
PKPayload KeyVersion
V4 ThirtyTwoBitTimeStamp
ts V3Expiration
0 PubKeyAlgorithm
RSA PKey
pkey
                KeyVersion
V6 -> KeyVersion
-> ThirtyTwoBitTimeStamp
-> V3Expiration
-> PubKeyAlgorithm
-> PKey
-> SomePKPayload
PKPayload KeyVersion
V6 ThirtyTwoBitTimeStamp
ts V3Expiration
0 PubKeyAlgorithm
RSA PKey
pkey
        pure (pkp, skey)
    ed25519Generate :: KeyVersion
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
ed25519Generate KeyVersion
V4 ThirtyTwoBitTimeStamp
ts = do
        seed <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
        secretKey <-
            either
                ( throwE
                    . KeyGenFailed
                    . ("Ed25519 key generation failed: " ++)
                    . show
                )
                pure
                (CE.eitherCryptoError (Ed25519.secretKey seed))
        let pubBytes = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SecretKey -> PublicKey
Ed25519.toPublic SecretKey
secretKey) :: B.ByteString
            pkey =
                EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey
                    EdSigningCurve
EdSigningCurve25519
                    (EPoint -> EdPoint
NativeEPoint (Integer -> EPoint
EPoint (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
pubBytes)))
            skey = ByteString -> SKey
Ed25519PrivateKey ByteString
seed
        pure (PKPayload V4 ts 0 EdDSALegacy pkey, skey)
    ed25519Generate KeyVersion
V6 ThirtyTwoBitTimeStamp
ts = do
        seed <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
        secretKey <-
            either
                ( throwE
                    . KeyGenFailed
                    . ("Ed25519 key generation failed: " ++)
                    . show
                )
                pure
                (CE.eitherCryptoError (Ed25519.secretKey seed))
        let pubBytes = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SecretKey -> PublicKey
Ed25519.toPublic SecretKey
secretKey) :: B.ByteString
            pkey =
                EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey
                    EdSigningCurve
EdSigningCurve25519
                    (EPoint -> EdPoint
NativeEPoint (Integer -> EPoint
EPoint (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
pubBytes)))
            skey = ByteString -> SKey
Ed25519PrivateKey ByteString
seed
        pure (PKPayload V6 ts 0 Ed25519 pkey, skey)
    ed25519Generate KeyVersion
DeprecatedV3 ThirtyTwoBitTimeStamp
_ts =
        TKGenError -> ExceptT TKGenError m (SomePKPayload, SKey)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
InvalidConfiguration [Char]
"Ed25519 V3 is not supported")
    ed448Generate :: p
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
ed448Generate p
_kv ThirtyTwoBitTimeStamp
ts = do
        seed <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
57
        secretKey <-
            either
                ( throwE
                    . KeyGenFailed
                    . ("Ed448 key generation failed: " ++)
                    . show
                )
                pure
                (CE.eitherCryptoError (Ed448.secretKey seed))
        let pubBytes = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SecretKey -> PublicKey
Ed448.toPublic SecretKey
secretKey) :: B.ByteString
            pkey =
                EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey
                    EdSigningCurve
EdSigningCurve448
                    (EPoint -> EdPoint
NativeEPoint (Integer -> EPoint
EPoint (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
pubBytes)))
            skey = ByteString -> SKey
Ed448PrivateKey ByteString
seed
            pkp = KeyVersion
-> ThirtyTwoBitTimeStamp
-> V3Expiration
-> PubKeyAlgorithm
-> PKey
-> SomePKPayload
PKPayload KeyVersion
V6 ThirtyTwoBitTimeStamp
ts V3Expiration
0 PubKeyAlgorithm
Ed448 PKey
pkey
        pure (pkp, skey)
    x25519Generate :: KeyVersion
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
x25519Generate KeyVersion
V4 ThirtyTwoBitTimeStamp
ts = do
        secretRaw <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
        secretKey <-
            either
                ( throwE
                    . KeyGenFailed
                    . ("X25519 key generation failed: " ++)
                    . show
                )
                pure
                (CE.eitherCryptoError (C25519.secretKey secretRaw))
        let pubRaw = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SecretKey -> PublicKey
C25519.toPublic SecretKey
secretKey) :: B.ByteString
            pkey =
                EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey
                    EdSigningCurve
EdSigningCurve25519
                    (EPoint -> EdPoint
NativeEPoint (Integer -> EPoint
EPoint (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
pubRaw)))
            skey = ByteString -> SKey
X25519PrivateKey ByteString
secretRaw
        pure (PKPayload V4 ts 0 ECDH pkey, skey)
    x25519Generate KeyVersion
V6 ThirtyTwoBitTimeStamp
ts = do
        secretRaw <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
        secretKey <-
            either
                ( throwE
                    . KeyGenFailed
                    . ("X25519 key generation failed: " ++)
                    . show
                )
                pure
                (CE.eitherCryptoError (C25519.secretKey secretRaw))
        let pubRaw = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SecretKey -> PublicKey
C25519.toPublic SecretKey
secretKey) :: B.ByteString
            pkey =
                EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey
                    EdSigningCurve
EdSigningCurve25519
                    (EPoint -> EdPoint
NativeEPoint (Integer -> EPoint
EPoint (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
pubRaw)))
            skey = ByteString -> SKey
X25519PrivateKey ByteString
secretRaw
        pure (PKPayload V6 ts 0 X25519 pkey, skey)
    x25519Generate KeyVersion
DeprecatedV3 ThirtyTwoBitTimeStamp
_ts =
        TKGenError -> ExceptT TKGenError m (SomePKPayload, SKey)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
InvalidConfiguration [Char]
"X25519 V3 is not supported")
    x448Generate :: p
-> ThirtyTwoBitTimeStamp
-> ExceptT TKGenError m (SomePKPayload, SKey)
x448Generate p
_kv ThirtyTwoBitTimeStamp
ts = do
        secretRaw <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
56
        secretKey <-
            either
                ( throwE
                    . KeyGenFailed
                    . ("X448 key generation failed: " ++)
                    . show
                )
                pure
                (CE.eitherCryptoError (C448.secretKey secretRaw))
        let pubRaw = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SecretKey -> PublicKey
C448.toPublic SecretKey
secretKey) :: B.ByteString
            pkey =
                EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey
                    EdSigningCurve
EdSigningCurve448
                    (EPoint -> EdPoint
NativeEPoint (Integer -> EPoint
EPoint (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
pubRaw)))
            skey = ByteString -> SKey
X448PrivateKey ByteString
secretRaw
            pkp = KeyVersion
-> ThirtyTwoBitTimeStamp
-> V3Expiration
-> PubKeyAlgorithm
-> PKey
-> SomePKPayload
PKPayload KeyVersion
V6 ThirtyTwoBitTimeStamp
ts V3Expiration
0 PubKeyAlgorithm
X448 PKey
pkey
        pure (pkp, skey)

-- -----------------------------------------------------------------------------
-- Finalization
-- -----------------------------------------------------------------------------

finalize
    :: forall m
     . MonadRandom m
    => TKGenState
    -> ExceptT TKGenError m (TK 'SecretTK)
finalize :: forall (m :: * -> *).
MonadRandom m =>
TKGenState -> ExceptT TKGenError m (TK 'SecretTK)
finalize TKGenState
state = do
    (primaryPkp, primarySKey) <-
        ExceptT TKGenError m (SomePKPayload, SKey)
-> ((SomePKPayload, SKey)
    -> ExceptT TKGenError m (SomePKPayload, SKey))
-> Maybe (SomePKPayload, SKey)
-> ExceptT TKGenError m (SomePKPayload, SKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TKGenError -> ExceptT TKGenError m (SomePKPayload, SKey)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TKGenError
NoPrimaryKey) (SomePKPayload, SKey) -> ExceptT TKGenError m (SomePKPayload, SKey)
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TKGenState -> Maybe (SomePKPayload, SKey)
_tkGenPrimary TKGenState
state)
    let primaryPkt = SomePKPayload -> SKAddendum -> KeyPkt 'SecretPkt
KeyPktSecretPrimary SomePKPayload
primaryPkp (SKey -> V3Expiration -> SKAddendum
SUSUnprotected SKey
primarySKey V3Expiration
0)
        (kv, ct) = case primaryPkp of
            PKPayload KeyVersion
_ ThirtyTwoBitTimeStamp
ts V3Expiration
_ PubKeyAlgorithm
_ PKey
_ -> (SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
primaryPkp, ThirtyTwoBitTimeStamp
ts)

    mdkSig <- case kv of
        KeyVersion
DeprecatedV3 -> [SignaturePayload] -> ExceptT TKGenError m [SignaturePayload]
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        KeyVersion
_ ->
            KeyVersion
-> SomePKPayload
-> SKey
-> ThirtyTwoBitTimeStamp
-> Maybe ThirtyTwoBitDuration
-> Preferences
-> ExceptT TKGenError m [SignaturePayload]
signDirectKey
                KeyVersion
kv
                SomePKPayload
primaryPkp
                SKey
primarySKey
                ThirtyTwoBitTimeStamp
ct
                (TKGenState -> Maybe ThirtyTwoBitDuration
_tkGenExpiration TKGenState
state)
                (TKGenState -> Preferences
_tkGenPrefs TKGenState
state)

    uids <-
        mapM (mkUID primaryPkp primarySKey kv ct) (_tkGenUIDs state)

    subs <-
        mapM
            (mkSubkey primaryPkp primarySKey kv ct)
            (_tkGenSubkeys state)

    let tk =
            TK
                { _tkPrimaryKey :: KeyPkt (TKKindToKeyPktKind 'SecretTK)
_tkPrimaryKey = KeyPkt 'SecretPkt
KeyPkt (TKKindToKeyPktKind 'SecretTK)
primaryPkt
                , _tkRevs :: [SignaturePayload]
_tkRevs = []
                , _tkDirectKeySigs :: [SignaturePayload]
_tkDirectKeySigs = [SignaturePayload]
mdkSig
                , _tkUIDs :: [(Text, [SignaturePayload])]
_tkUIDs = [(Text, [SignaturePayload])]
uids
                , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])]
_tkUAts = []
                , _tkSubs :: [(KeyPkt (TKKindToKeyPktKind 'SecretTK), [SignaturePayload])]
_tkSubs = [(KeyPkt 'SecretPkt, [SignaturePayload])]
[(KeyPkt (TKKindToKeyPktKind 'SecretTK), [SignaturePayload])]
subs
                }
    pure tk
  where
    issuerFingerprintSub
        :: KeyVersion -> SomePKPayload -> SigSubPacket
    issuerFingerprintSub :: KeyVersion -> SomePKPayload -> SigSubPacket
issuerFingerprintSub KeyVersion
V4 SomePKPayload
pkp =
        Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket
            Bool
False
            (IssuerFingerprintVersion -> Fingerprint -> SigSubPacketPayload
IssuerFingerprint IssuerFingerprintVersion
IssuerFingerprintV4 (SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pkp))
    issuerFingerprintSub KeyVersion
V6 SomePKPayload
pkp =
        Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket
            Bool
False
            (IssuerFingerprintVersion -> Fingerprint -> SigSubPacketPayload
IssuerFingerprint IssuerFingerprintVersion
IssuerFingerprintV6 (SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pkp))
    issuerFingerprintSub KeyVersion
DeprecatedV3 SomePKPayload
pkp =
        Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket
            Bool
False
            (IssuerFingerprintVersion -> Fingerprint -> SigSubPacketPayload
IssuerFingerprint IssuerFingerprintVersion
IssuerFingerprintV4 (SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pkp))

    issuerKeyIdSub :: SomePKPayload -> SigSubPacket
    issuerKeyIdSub :: SomePKPayload -> SigSubPacket
issuerKeyIdSub SomePKPayload
pkp = case SomePKPayload -> Either [Char] EightOctetKeyId
eightOctetKeyID SomePKPayload
pkp of
        Left [Char]
err -> [Char] -> SigSubPacket
forall a. HasCallStack => [Char] -> a
error ([Char]
"failed to derive issuer key id: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err)
        Right EightOctetKeyId
eoki -> Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (EightOctetKeyId -> SigSubPacketPayload
Issuer EightOctetKeyId
eoki)

    baseHashedSubs
        :: KeyVersion
        -> SomePKPayload
        -> ThirtyTwoBitTimeStamp
        -> Maybe ThirtyTwoBitDuration
        -> [SigSubPacket]
    baseHashedSubs :: KeyVersion
-> SomePKPayload
-> ThirtyTwoBitTimeStamp
-> Maybe ThirtyTwoBitDuration
-> [SigSubPacket]
baseHashedSubs KeyVersion
kv SomePKPayload
pkp ThirtyTwoBitTimeStamp
ct Maybe ThirtyTwoBitDuration
mExp =
        [ KeyVersion -> SomePKPayload -> SigSubPacket
issuerFingerprintSub KeyVersion
kv SomePKPayload
pkp
        , Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True (ThirtyTwoBitTimeStamp -> SigSubPacketPayload
SigCreationTime ThirtyTwoBitTimeStamp
ct)
        ]
            [SigSubPacket] -> [SigSubPacket] -> [SigSubPacket]
forall a. [a] -> [a] -> [a]
++ case Maybe ThirtyTwoBitDuration
mExp of
                Just ThirtyTwoBitDuration
dur -> [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (ThirtyTwoBitDuration -> SigSubPacketPayload
SigExpirationTime ThirtyTwoBitDuration
dur)]
                Maybe ThirtyTwoBitDuration
Nothing -> []

    baseUnhashedSubs :: KeyVersion -> SomePKPayload -> [SigSubPacket]
    baseUnhashedSubs :: KeyVersion -> SomePKPayload -> [SigSubPacket]
baseUnhashedSubs KeyVersion
V4 SomePKPayload
pkp = [SomePKPayload -> SigSubPacket
issuerKeyIdSub SomePKPayload
pkp]
    baseUnhashedSubs KeyVersion
DeprecatedV3 SomePKPayload
pkp = [SomePKPayload -> SigSubPacket
issuerKeyIdSub SomePKPayload
pkp]
    baseUnhashedSubs KeyVersion
V6 SomePKPayload
_pkp = []

    signCertification
        :: KeyVersion
        -> SomePKPayload
        -> SKey
        -> ThirtyTwoBitTimeStamp
        -> Text
        -> [SigSubPacket]
        -> ExceptT TKGenError m SignaturePayload
    signCertification :: KeyVersion
-> SomePKPayload
-> SKey
-> ThirtyTwoBitTimeStamp
-> Text
-> [SigSubPacket]
-> ExceptT TKGenError m SignaturePayload
signCertification KeyVersion
kv SomePKPayload
primaryPkp SKey
primarySKey ThirtyTwoBitTimeStamp
ct Text
uid [SigSubPacket]
hashedExtras = do
        let ctx :: PktStreamContext
ctx =
                PktStreamContext
emptyPSC
                    { lastPrimaryKey = PublicKeyPkt primaryPkp
                    , lastUIDorUAt = UserIdPkt uid
                    }
            payload :: ByteString
payload = SigType -> PktStreamContext -> ByteString
payloadForSig SigType
GenericCert PktStreamContext
ctx
            rawHashed :: [SigSubPacket]
rawHashed =
                [SigSubPacket]
hashedExtras
                    [SigSubPacket] -> [SigSubPacket] -> [SigSubPacket]
forall a. [a] -> [a] -> [a]
++ KeyVersion
-> SomePKPayload
-> ThirtyTwoBitTimeStamp
-> Maybe ThirtyTwoBitDuration
-> [SigSubPacket]
baseHashedSubs KeyVersion
kv SomePKPayload
primaryPkp ThirtyTwoBitTimeStamp
ct (TKGenState -> Maybe ThirtyTwoBitDuration
_tkGenExpiration TKGenState
state)
            rawUnhashed :: [SigSubPacket]
rawUnhashed = KeyVersion -> SomePKPayload -> [SigSubPacket]
baseUnhashedSubs KeyVersion
kv SomePKPayload
primaryPkp
         in case (KeyVersion
kv, SKey
primarySKey) of
                (KeyVersion
V4, RSAPrivateKey RSA_PrivateKey
rsaPriv) ->
                    (SignError -> ExceptT TKGenError m SignaturePayload)
-> (SignaturePayload -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SignaturePayload)
-> (SignError -> TKGenError)
-> SignError
-> ExceptT TKGenError m SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (SignError -> [Char]) -> SignError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignError -> [Char]
forall a. Show a => a -> [Char]
show) SignaturePayload -> ExceptT TKGenError m SignaturePayload
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a b. (a -> b) -> a -> b
$
                        SigBuilder Unhashed V4Sig 'RSA
-> PrivateKey -> ByteString -> Either SignError SignaturePayload
signDataWithRSABuilder
                            ([SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig 'RSA
forall {algo :: PubKeyAlgorithm}.
KnownPubKeyAlgorithm algo =>
[SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed)
                            (RSA_PrivateKey -> PrivateKey
unRSA_PrivateKey RSA_PrivateKey
rsaPriv)
                            ByteString
payload
                (KeyVersion
V6, RSAPrivateKey RSA_PrivateKey
rsaPriv) -> do
                    (salt :: B.ByteString) <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
                    either (throwE . SignatureFailed . show) pure $
                        signDataWithRSAV6Builder
                            (mkBuilderV6 rawHashed rawUnhashed (SignatureSalt salt))
                            (unRSA_PrivateKey rsaPriv)
                            payload
                (KeyVersion
V4, Ed25519PrivateKey ByteString
seed) ->
                    [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, Monad m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                (KeyVersion
V6, Ed25519PrivateKey ByteString
seed) ->
                    [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, MonadRandom m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                (KeyVersion
V4, EdDSAPrivateKey EdSigningCurve
EdSigningCurve25519 ByteString
seed) ->
                    [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, Monad m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                (KeyVersion
V6, EdDSAPrivateKey EdSigningCurve
EdSigningCurve25519 ByteString
seed) ->
                    [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, MonadRandom m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                (KeyVersion
V4, EdDSAPrivateKey EdSigningCurve
EdSigningCurve448 ByteString
seed) ->
                    [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, Monad m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                (KeyVersion
V6, EdDSAPrivateKey EdSigningCurve
EdSigningCurve448 ByteString
seed) ->
                    [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, MonadRandom m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                (KeyVersion
V4, Ed448PrivateKey ByteString
seed) ->
                    [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, Monad m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                (KeyVersion
V6, Ed448PrivateKey ByteString
seed) ->
                    [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, MonadRandom m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                (KeyVersion, SKey)
_ ->
                    TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
                        ( [Char] -> TKGenError
InvalidConfiguration
                            ( [Char]
"unsupported primary key type for certification: "
                                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SKey -> [Char]
forall a. Show a => a -> [Char]
show SKey
primarySKey
                            )
                        )
      where
        mkBuilderV4 :: [SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed =
            UnhashedSubpackets V4Sig
-> SigBuilder Unhashed V4Sig algo -> SigBuilder Unhashed V4Sig algo
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs
                ([SigSubPacket] -> UnhashedSubpackets V4Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
rawUnhashed)
                ( HashedSubpackets V4Sig
-> SigBuilder Hashed V4Sig algo -> SigBuilder Unhashed V4Sig algo
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs
                    ([SigSubPacket] -> HashedSubpackets V4Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
rawHashed)
                    (SigType -> HashAlgorithm -> SigBuilder Hashed V4Sig algo
forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigType -> HashAlgorithm -> SigBuilder Hashed V4Sig algo
sigBuilderInit SigType
GenericCert HashAlgorithm
SHA512)
                )
        mkBuilderV6 :: [SigSubPacket]
-> [SigSubPacket]
-> SignatureSalt
-> SigBuilder Unhashed V6Sig algo
mkBuilderV6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed SignatureSalt
salt =
            UnhashedSubpackets V6Sig
-> SigBuilder Unhashed V6Sig algo -> SigBuilder Unhashed V6Sig algo
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs
                ([SigSubPacket] -> UnhashedSubpackets V6Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
rawUnhashed)
                ( HashedSubpackets V6Sig
-> SigBuilder Hashed V6Sig algo -> SigBuilder Unhashed V6Sig algo
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs
                    ([SigSubPacket] -> HashedSubpackets V6Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
rawHashed)
                    (SigType
-> HashAlgorithm -> SignatureSalt -> SigBuilder Hashed V6Sig algo
forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigType
-> HashAlgorithm -> SignatureSalt -> SigBuilder Hashed V6Sig algo
sigBuilderInitV6 SigType
GenericCert HashAlgorithm
SHA512 SignatureSalt
salt)
                )

        signEd25519V4 :: [SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ba
seed ByteString
payload = case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ba
seed) of
            Left CryptoError
err ->
                TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
SignatureFailed ([Char]
"Ed25519 signing failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err))
            Right SecretKey
sk ->
                (SignError -> ExceptT TKGenError m SignaturePayload)
-> (SignaturePayload -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SignaturePayload)
-> (SignError -> TKGenError)
-> SignError
-> ExceptT TKGenError m SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (SignError -> [Char]) -> SignError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignError -> [Char]
forall a. Show a => a -> [Char]
show) SignaturePayload -> ExceptT TKGenError m SignaturePayload
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a b. (a -> b) -> a -> b
$
                    SigBuilder Unhashed V4Sig 'Ed25519
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd25519Builder
                        ([SigSubPacket]
-> [SigSubPacket] -> SigBuilder Unhashed V4Sig 'Ed25519
forall {algo :: PubKeyAlgorithm}.
KnownPubKeyAlgorithm algo =>
[SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed)
                        SecretKey
sk
                        ByteString
payload
        signEd25519V6 :: [SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ba
seed ByteString
payload = case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ba
seed) of
            Left CryptoError
err ->
                TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
SignatureFailed ([Char]
"Ed25519 signing failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err))
            Right SecretKey
sk -> do
                (salt :: B.ByteString) <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
                either (throwE . SignatureFailed . show) pure $
                    signDataWithEd25519V6Builder
                        (mkBuilderV6 rawHashed rawUnhashed (SignatureSalt salt))
                        sk
                        payload
        signEd448V4 :: [SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ba
seed ByteString
payload = case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey ba
seed) of
            Left CryptoError
err ->
                TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
SignatureFailed ([Char]
"Ed448 signing failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err))
            Right SecretKey
sk ->
                (SignError -> ExceptT TKGenError m SignaturePayload)
-> (SignaturePayload -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SignaturePayload)
-> (SignError -> TKGenError)
-> SignError
-> ExceptT TKGenError m SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (SignError -> [Char]) -> SignError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignError -> [Char]
forall a. Show a => a -> [Char]
show) SignaturePayload -> ExceptT TKGenError m SignaturePayload
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a b. (a -> b) -> a -> b
$
                    SigBuilder Unhashed V4Sig 'Ed448
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd448Builder
                        ([SigSubPacket]
-> [SigSubPacket] -> SigBuilder Unhashed V4Sig 'Ed448
forall {algo :: PubKeyAlgorithm}.
KnownPubKeyAlgorithm algo =>
[SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed)
                        SecretKey
sk
                        ByteString
payload
        signEd448V6 :: [SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ba
seed ByteString
payload = case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey ba
seed) of
            Left CryptoError
err ->
                TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
SignatureFailed ([Char]
"Ed448 signing failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err))
            Right SecretKey
sk -> do
                (salt :: B.ByteString) <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
                either (throwE . SignatureFailed . show) pure $
                    signDataWithEd448V6Builder
                        (mkBuilderV6 rawHashed rawUnhashed (SignatureSalt salt))
                        sk
                        payload

    mkUID
        :: SomePKPayload
        -> SKey
        -> KeyVersion
        -> ThirtyTwoBitTimeStamp
        -> Text
        -> ExceptT TKGenError m (Text, [SignaturePayload])
    mkUID :: SomePKPayload
-> SKey
-> KeyVersion
-> ThirtyTwoBitTimeStamp
-> Text
-> ExceptT TKGenError m (Text, [SignaturePayload])
mkUID SomePKPayload
primaryPkp SKey
primarySKey KeyVersion
kv ThirtyTwoBitTimeStamp
ct Text
uid = do
        sig <- KeyVersion
-> SomePKPayload
-> SKey
-> ThirtyTwoBitTimeStamp
-> Text
-> [SigSubPacket]
-> ExceptT TKGenError m SignaturePayload
signCertification KeyVersion
kv SomePKPayload
primaryPkp SKey
primarySKey ThirtyTwoBitTimeStamp
ct Text
uid []
        pure (uid, [sig])

    signDirectKey
        :: KeyVersion
        -> SomePKPayload
        -> SKey
        -> ThirtyTwoBitTimeStamp
        -> Maybe ThirtyTwoBitDuration
        -> Preferences
        -> ExceptT TKGenError m [SignaturePayload]
    signDirectKey :: KeyVersion
-> SomePKPayload
-> SKey
-> ThirtyTwoBitTimeStamp
-> Maybe ThirtyTwoBitDuration
-> Preferences
-> ExceptT TKGenError m [SignaturePayload]
signDirectKey KeyVersion
kv SomePKPayload
primaryPkp SKey
primarySKey ThirtyTwoBitTimeStamp
ct Maybe ThirtyTwoBitDuration
mExp Preferences
prefs =
        let ctx :: PktStreamContext
ctx = PktStreamContext
emptyPSC {lastPrimaryKey = PublicKeyPkt primaryPkp}
            payload :: ByteString
payload = SigType -> PktStreamContext -> ByteString
payloadForSig SigType
DirectKeySignature PktStreamContext
ctx
            rawHashed :: [SigSubPacket]
rawHashed =
                [ KeyVersion -> SomePKPayload -> SigSubPacket
issuerFingerprintSub KeyVersion
kv SomePKPayload
primaryPkp
                , Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True (ThirtyTwoBitTimeStamp -> SigSubPacketPayload
SigCreationTime ThirtyTwoBitTimeStamp
ct)
                , Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True (Set KeyFlag -> SigSubPacketPayload
KeyFlags ([KeyFlag] -> Set KeyFlag
forall a. Ord a => [a] -> Set a
Set.fromList [KeyFlag
CertifyKeysKey]))
                ]
                    [SigSubPacket] -> [SigSubPacket] -> [SigSubPacket]
forall a. [a] -> [a] -> [a]
++ [SigSubPacket]
-> (ThirtyTwoBitDuration -> [SigSubPacket])
-> Maybe ThirtyTwoBitDuration
-> [SigSubPacket]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                        []
                        (\ThirtyTwoBitDuration
dur -> [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (ThirtyTwoBitDuration -> SigSubPacketPayload
SigExpirationTime ThirtyTwoBitDuration
dur)])
                        Maybe ThirtyTwoBitDuration
mExp
                    [SigSubPacket] -> [SigSubPacket] -> [SigSubPacket]
forall a. [a] -> [a] -> [a]
++ Preferences -> [SigSubPacket]
preferenceSubs Preferences
prefs
            rawUnhashed :: [SigSubPacket]
rawUnhashed = case KeyVersion
kv of
                KeyVersion
V4 -> [SomePKPayload -> SigSubPacket
issuerKeyIdSub SomePKPayload
primaryPkp]
                KeyVersion
_ -> []
         in case (KeyVersion
kv, SKey
primarySKey) of
                (KeyVersion
V4, RSAPrivateKey RSA_PrivateKey
rsaPriv) -> do
                    sig <-
                        (SignError -> ExceptT TKGenError m SignaturePayload)
-> (SignaturePayload -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SignaturePayload)
-> (SignError -> TKGenError)
-> SignError
-> ExceptT TKGenError m SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (SignError -> [Char]) -> SignError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignError -> [Char]
forall a. Show a => a -> [Char]
show) SignaturePayload -> ExceptT TKGenError m SignaturePayload
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a b. (a -> b) -> a -> b
$
                            SigBuilder Unhashed V4Sig 'RSA
-> PrivateKey -> ByteString -> Either SignError SignaturePayload
signDataWithRSABuilder
                                ([SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig 'RSA
forall {algo :: PubKeyAlgorithm}.
KnownPubKeyAlgorithm algo =>
[SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed)
                                (RSA_PrivateKey -> PrivateKey
unRSA_PrivateKey RSA_PrivateKey
rsaPriv)
                                ByteString
payload
                    pure [sig]
                (KeyVersion
V6, RSAPrivateKey RSA_PrivateKey
rsaPriv) -> do
                    (salt :: B.ByteString) <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
                    sig <-
                        either (throwE . SignatureFailed . show) pure $
                            signDataWithRSAV6Builder
                                (mkBuilderV6 rawHashed rawUnhashed (SignatureSalt salt))
                                (unRSA_PrivateKey rsaPriv)
                                payload
                    pure [sig]
                (KeyVersion
V4, Ed25519PrivateKey ByteString
seed) -> do
                    sig <- [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, Monad m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                    pure [sig]
                (KeyVersion
V6, Ed25519PrivateKey ByteString
seed) -> do
                    sig <- [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, MonadRandom m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                    pure [sig]
                (KeyVersion
V4, EdDSAPrivateKey EdSigningCurve
EdSigningCurve25519 ByteString
seed) -> do
                    sig <- [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, Monad m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                    pure [sig]
                (KeyVersion
V6, EdDSAPrivateKey EdSigningCurve
EdSigningCurve25519 ByteString
seed) -> do
                    sig <- [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, MonadRandom m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                    pure [sig]
                (KeyVersion
V4, EdDSAPrivateKey EdSigningCurve
EdSigningCurve448 ByteString
seed) -> do
                    sig <- [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, Monad m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                    pure [sig]
                (KeyVersion
V6, EdDSAPrivateKey EdSigningCurve
EdSigningCurve448 ByteString
seed) -> do
                    sig <- [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, MonadRandom m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                    pure [sig]
                (KeyVersion
V4, Ed448PrivateKey ByteString
seed) -> do
                    sig <- [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, Monad m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                    pure [sig]
                (KeyVersion
V6, Ed448PrivateKey ByteString
seed) -> do
                    sig <- [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, MonadRandom m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                    pure [sig]
                (KeyVersion, SKey)
_ -> [SignaturePayload] -> ExceptT TKGenError m [SignaturePayload]
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      where
        mkBuilderV4 :: [SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed =
            UnhashedSubpackets V4Sig
-> SigBuilder Unhashed V4Sig algo -> SigBuilder Unhashed V4Sig algo
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs
                ([SigSubPacket] -> UnhashedSubpackets V4Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
rawUnhashed)
                ( HashedSubpackets V4Sig
-> SigBuilder Hashed V4Sig algo -> SigBuilder Unhashed V4Sig algo
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs
                    ([SigSubPacket] -> HashedSubpackets V4Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
rawHashed)
                    (SigType -> HashAlgorithm -> SigBuilder Hashed V4Sig algo
forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigType -> HashAlgorithm -> SigBuilder Hashed V4Sig algo
sigBuilderInit SigType
DirectKeySignature HashAlgorithm
SHA512)
                )
        mkBuilderV6 :: [SigSubPacket]
-> [SigSubPacket]
-> SignatureSalt
-> SigBuilder Unhashed V6Sig algo
mkBuilderV6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed SignatureSalt
salt =
            UnhashedSubpackets V6Sig
-> SigBuilder Unhashed V6Sig algo -> SigBuilder Unhashed V6Sig algo
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs
                ([SigSubPacket] -> UnhashedSubpackets V6Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
rawUnhashed)
                ( HashedSubpackets V6Sig
-> SigBuilder Hashed V6Sig algo -> SigBuilder Unhashed V6Sig algo
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs
                    ([SigSubPacket] -> HashedSubpackets V6Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
rawHashed)
                    (SigType
-> HashAlgorithm -> SignatureSalt -> SigBuilder Hashed V6Sig algo
forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigType
-> HashAlgorithm -> SignatureSalt -> SigBuilder Hashed V6Sig algo
sigBuilderInitV6 SigType
DirectKeySignature HashAlgorithm
SHA512 SignatureSalt
salt)
                )
        signEd25519V4 :: [SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ba
seed ByteString
payload =
            case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ba
seed) of
                Left CryptoError
err ->
                    TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
SignatureFailed ([Char]
"Ed25519 signing failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err))
                Right SecretKey
sk ->
                    (SignError -> ExceptT TKGenError m SignaturePayload)
-> (SignaturePayload -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SignaturePayload)
-> (SignError -> TKGenError)
-> SignError
-> ExceptT TKGenError m SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (SignError -> [Char]) -> SignError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignError -> [Char]
forall a. Show a => a -> [Char]
show) SignaturePayload -> ExceptT TKGenError m SignaturePayload
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a b. (a -> b) -> a -> b
$
                        SigBuilder Unhashed V4Sig 'Ed25519
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd25519Builder
                            ([SigSubPacket]
-> [SigSubPacket] -> SigBuilder Unhashed V4Sig 'Ed25519
forall {algo :: PubKeyAlgorithm}.
KnownPubKeyAlgorithm algo =>
[SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed)
                            SecretKey
sk
                            ByteString
payload
        signEd25519V6 :: [SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ba
seed ByteString
payload =
            case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ba
seed) of
                Left CryptoError
err ->
                    TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
SignatureFailed ([Char]
"Ed25519 signing failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err))
                Right SecretKey
sk -> do
                    (salt :: B.ByteString) <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
                    either (throwE . SignatureFailed . show) pure $
                        signDataWithEd25519V6Builder
                            (mkBuilderV6 rawHashed rawUnhashed (SignatureSalt salt))
                            sk
                            payload
        signEd448V4 :: [SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ba
seed ByteString
payload =
            case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey ba
seed) of
                Left CryptoError
err ->
                    TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
SignatureFailed ([Char]
"Ed448 signing failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err))
                Right SecretKey
sk ->
                    (SignError -> ExceptT TKGenError m SignaturePayload)
-> (SignaturePayload -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SignaturePayload)
-> (SignError -> TKGenError)
-> SignError
-> ExceptT TKGenError m SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (SignError -> [Char]) -> SignError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignError -> [Char]
forall a. Show a => a -> [Char]
show) SignaturePayload -> ExceptT TKGenError m SignaturePayload
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a b. (a -> b) -> a -> b
$
                        SigBuilder Unhashed V4Sig 'Ed448
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd448Builder
                            ([SigSubPacket]
-> [SigSubPacket] -> SigBuilder Unhashed V4Sig 'Ed448
forall {algo :: PubKeyAlgorithm}.
KnownPubKeyAlgorithm algo =>
[SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed)
                            SecretKey
sk
                            ByteString
payload
        signEd448V6 :: [SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ba
seed ByteString
payload =
            case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey ba
seed) of
                Left CryptoError
err ->
                    TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
SignatureFailed ([Char]
"Ed448 signing failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err))
                Right SecretKey
sk -> do
                    (salt :: B.ByteString) <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
                    either (throwE . SignatureFailed . show) pure $
                        signDataWithEd448V6Builder
                            (mkBuilderV6 rawHashed rawUnhashed (SignatureSalt salt))
                            sk
                            payload
        preferenceSubs :: Preferences -> [SigSubPacket]
        preferenceSubs :: Preferences -> [SigSubPacket]
preferenceSubs (Preferences [SymmetricAlgorithm]
sym [HashAlgorithm]
hash [CompressionAlgorithm]
comp [(SymmetricAlgorithm, AEADAlgorithm)]
aead Set KSPFlag
ksp Set FeatureFlag
ff) =
            ( if [SymmetricAlgorithm] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SymmetricAlgorithm]
sym
                then []
                else [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False ([SymmetricAlgorithm] -> SigSubPacketPayload
PreferredSymmetricAlgorithms [SymmetricAlgorithm]
sym)]
            )
                [SigSubPacket] -> [SigSubPacket] -> [SigSubPacket]
forall a. [a] -> [a] -> [a]
++ ( if [HashAlgorithm] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HashAlgorithm]
hash
                        then []
                        else [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False ([HashAlgorithm] -> SigSubPacketPayload
PreferredHashAlgorithms [HashAlgorithm]
hash)]
                   )
                [SigSubPacket] -> [SigSubPacket] -> [SigSubPacket]
forall a. [a] -> [a] -> [a]
++ ( if [CompressionAlgorithm] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CompressionAlgorithm]
comp
                        then []
                        else [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False ([CompressionAlgorithm] -> SigSubPacketPayload
PreferredCompressionAlgorithms [CompressionAlgorithm]
comp)]
                   )
                [SigSubPacket] -> [SigSubPacket] -> [SigSubPacket]
forall a. [a] -> [a] -> [a]
++ ( if [(SymmetricAlgorithm, AEADAlgorithm)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SymmetricAlgorithm, AEADAlgorithm)]
aead
                        then []
                        else [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False ([(SymmetricAlgorithm, AEADAlgorithm)] -> SigSubPacketPayload
PreferredAEADCiphersuites [(SymmetricAlgorithm, AEADAlgorithm)]
aead)]
                   )
                [SigSubPacket] -> [SigSubPacket] -> [SigSubPacket]
forall a. [a] -> [a] -> [a]
++ ( if Set KSPFlag -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set KSPFlag
ksp
                        then []
                        else [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (Set KSPFlag -> SigSubPacketPayload
KeyServerPreferences Set KSPFlag
ksp)]
                   )
                [SigSubPacket] -> [SigSubPacket] -> [SigSubPacket]
forall a. [a] -> [a] -> [a]
++ ( if Set FeatureFlag -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set FeatureFlag
ff
                        then []
                        else [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (Set FeatureFlag -> SigSubPacketPayload
Features Set FeatureFlag
ff)]
                   )

    signSubkeyBinding
        :: KeyVersion
        -> SomePKPayload
        -> SKey
        -> ThirtyTwoBitTimeStamp
        -> SubkeySpec
        -> ExceptT TKGenError m SignaturePayload
    signSubkeyBinding :: KeyVersion
-> SomePKPayload
-> SKey
-> ThirtyTwoBitTimeStamp
-> SubkeySpec
-> ExceptT TKGenError m SignaturePayload
signSubkeyBinding KeyVersion
kv SomePKPayload
primaryPkp SKey
primarySKey ThirtyTwoBitTimeStamp
ct SubkeySpec
spec = do
        let subkp :: SomePKPayload
subkp = SubkeySpec -> SomePKPayload
_subkeyPayload SubkeySpec
spec
            subSKey :: SKey
subSKey = SubkeySpec -> SKey
_subkeySKey SubkeySpec
spec
            usage :: Set KeyFlag
usage = SubkeySpec -> Set KeyFlag
_subkeyUsage SubkeySpec
spec
            ctx :: PktStreamContext
ctx =
                PktStreamContext
emptyPSC
                    { lastPrimaryKey = PublicKeyPkt primaryPkp
                    , lastSubkey = PublicSubkeyPkt subkp
                    }
            payload :: ByteString
payload = SigType -> PktStreamContext -> ByteString
payloadForSig SigType
SubkeyBindingSig PktStreamContext
ctx
            keyFlagsSub :: [SigSubPacket]
keyFlagsSub = [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True (Set KeyFlag -> SigSubPacketPayload
KeyFlags Set KeyFlag
usage)]
            isSigning :: [KeyFlag] -> Bool
isSigning = Bool -> Bool
not (Bool -> Bool) -> ([KeyFlag] -> Bool) -> [KeyFlag] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set KeyFlag -> Bool
forall a. Set a -> Bool
Set.null (Set KeyFlag -> Bool)
-> ([KeyFlag] -> Set KeyFlag) -> [KeyFlag] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set KeyFlag -> Set KeyFlag -> Set KeyFlag
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set KeyFlag
usage (Set KeyFlag -> Set KeyFlag)
-> ([KeyFlag] -> Set KeyFlag) -> [KeyFlag] -> Set KeyFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KeyFlag] -> Set KeyFlag
forall a. Ord a => [a] -> Set a
Set.fromList
            signingCapable :: Bool
signingCapable = [KeyFlag] -> Bool
isSigning [KeyFlag
SignDataKey, KeyFlag
CertifyKeysKey, KeyFlag
AuthKey]
         in do
                embSig <-
                    if Bool
signingCapable
                        then do
                            let bindCtx :: PktStreamContext
bindCtx =
                                    PktStreamContext
emptyPSC
                                        { lastPrimaryKey = PublicKeyPkt primaryPkp
                                        , lastSubkey = PublicSubkeyPkt subkp
                                        }
                                bindPayload :: ByteString
bindPayload = SigType -> PktStreamContext -> ByteString
payloadForSig SigType
PrimaryKeyBindingSig PktStreamContext
bindCtx
                                bindHashed :: [SigSubPacket]
bindHashed =
                                    [ Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True (ThirtyTwoBitTimeStamp -> SigSubPacketPayload
SigCreationTime ThirtyTwoBitTimeStamp
ct)
                                    , Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True (Set KeyFlag -> SigSubPacketPayload
KeyFlags Set KeyFlag
usage)
                                    , KeyVersion -> SomePKPayload -> SigSubPacket
issuerFingerprintSub KeyVersion
kv SomePKPayload
subkp
                                    ]
                                bindUnhashed :: [SigSubPacket]
bindUnhashed = KeyVersion -> SomePKPayload -> [SigSubPacket]
baseUnhashedSubs KeyVersion
kv SomePKPayload
subkp
                            KeyVersion
-> SKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ExceptT TKGenError m (Maybe SignaturePayload)
forall {m :: * -> *}.
MonadRandom m =>
KeyVersion
-> SKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ExceptT TKGenError m (Maybe SignaturePayload)
signPrimaryKeyBinding
                                KeyVersion
kv
                                SKey
subSKey
                                [SigSubPacket]
bindHashed
                                [SigSubPacket]
bindUnhashed
                                ByteString
bindPayload
                        else Maybe SignaturePayload
-> ExceptT TKGenError m (Maybe SignaturePayload)
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SignaturePayload
forall a. Maybe a
Nothing
                let embSub = case Maybe SignaturePayload
embSig of
                        Just SignaturePayload
sig -> [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True (SignaturePayload -> SigSubPacketPayload
EmbeddedSignature SignaturePayload
sig)]
                        Maybe SignaturePayload
Nothing -> []
                    rawHashed =
                        [SigSubPacket]
keyFlagsSub
                            [SigSubPacket] -> [SigSubPacket] -> [SigSubPacket]
forall a. [a] -> [a] -> [a]
++ [SigSubPacket]
embSub
                            [SigSubPacket] -> [SigSubPacket] -> [SigSubPacket]
forall a. [a] -> [a] -> [a]
++ KeyVersion
-> SomePKPayload
-> ThirtyTwoBitTimeStamp
-> Maybe ThirtyTwoBitDuration
-> [SigSubPacket]
baseHashedSubs KeyVersion
kv SomePKPayload
primaryPkp ThirtyTwoBitTimeStamp
ct (TKGenState -> Maybe ThirtyTwoBitDuration
_tkGenExpiration TKGenState
state)
                    rawUnhashed = KeyVersion -> SomePKPayload -> [SigSubPacket]
baseUnhashedSubs KeyVersion
kv SomePKPayload
primaryPkp
                 in case (kv, primarySKey) of
                        (KeyVersion
V4, RSAPrivateKey RSA_PrivateKey
rsaPriv) ->
                            (SignError -> ExceptT TKGenError m SignaturePayload)
-> (SignaturePayload -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SignaturePayload)
-> (SignError -> TKGenError)
-> SignError
-> ExceptT TKGenError m SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (SignError -> [Char]) -> SignError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignError -> [Char]
forall a. Show a => a -> [Char]
show) SignaturePayload -> ExceptT TKGenError m SignaturePayload
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a b. (a -> b) -> a -> b
$
                                SigBuilder Unhashed V4Sig 'RSA
-> PrivateKey -> ByteString -> Either SignError SignaturePayload
signDataWithRSABuilder
                                    ([SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig 'RSA
forall {algo :: PubKeyAlgorithm}.
KnownPubKeyAlgorithm algo =>
[SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed)
                                    (RSA_PrivateKey -> PrivateKey
unRSA_PrivateKey RSA_PrivateKey
rsaPriv)
                                    ByteString
payload
                        (KeyVersion
V6, RSAPrivateKey RSA_PrivateKey
rsaPriv) -> do
                            (salt :: B.ByteString) <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
                            either (throwE . SignatureFailed . show) pure $
                                signDataWithRSAV6Builder
                                    (mkBuilderV6 rawHashed rawUnhashed (SignatureSalt salt))
                                    (unRSA_PrivateKey rsaPriv)
                                    payload
                        (KeyVersion
V4, Ed25519PrivateKey ByteString
seed) ->
                            [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, Monad m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                        (KeyVersion
V6, Ed25519PrivateKey ByteString
seed) ->
                            [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, MonadRandom m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                        (KeyVersion
V4, EdDSAPrivateKey EdSigningCurve
EdSigningCurve25519 ByteString
seed) ->
                            [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, Monad m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                        (KeyVersion
V6, EdDSAPrivateKey EdSigningCurve
EdSigningCurve25519 ByteString
seed) ->
                            [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, MonadRandom m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                        (KeyVersion
V4, EdDSAPrivateKey EdSigningCurve
EdSigningCurve448 ByteString
seed) ->
                            [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, Monad m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                        (KeyVersion
V6, EdDSAPrivateKey EdSigningCurve
EdSigningCurve448 ByteString
seed) ->
                            [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, MonadRandom m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                        (KeyVersion
V4, Ed448PrivateKey ByteString
seed) ->
                            [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, Monad m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                        (KeyVersion
V6, Ed448PrivateKey ByteString
seed) ->
                            [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ByteString
-> ExceptT TKGenError m SignaturePayload
forall {ba} {m :: * -> *}.
(ByteArrayAccess ba, MonadRandom m) =>
[SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ByteString
seed ByteString
payload
                        (KeyVersion, SKey)
_ ->
                            TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
                                ( [Char] -> TKGenError
InvalidConfiguration
                                    ( [Char]
"unsupported primary key type for subkey binding: "
                                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SKey -> [Char]
forall a. Show a => a -> [Char]
show SKey
primarySKey
                                    )
                                )
      where
        mkBuilderV4 :: [SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed =
            UnhashedSubpackets V4Sig
-> SigBuilder Unhashed V4Sig algo -> SigBuilder Unhashed V4Sig algo
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs
                ([SigSubPacket] -> UnhashedSubpackets V4Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
rawUnhashed)
                ( HashedSubpackets V4Sig
-> SigBuilder Hashed V4Sig algo -> SigBuilder Unhashed V4Sig algo
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs
                    ([SigSubPacket] -> HashedSubpackets V4Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
rawHashed)
                    (SigType -> HashAlgorithm -> SigBuilder Hashed V4Sig algo
forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigType -> HashAlgorithm -> SigBuilder Hashed V4Sig algo
sigBuilderInit SigType
SubkeyBindingSig HashAlgorithm
SHA512)
                )
        mkBuilderV6 :: [SigSubPacket]
-> [SigSubPacket]
-> SignatureSalt
-> SigBuilder Unhashed V6Sig algo
mkBuilderV6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed SignatureSalt
salt =
            UnhashedSubpackets V6Sig
-> SigBuilder Unhashed V6Sig algo -> SigBuilder Unhashed V6Sig algo
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs
                ([SigSubPacket] -> UnhashedSubpackets V6Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
rawUnhashed)
                ( HashedSubpackets V6Sig
-> SigBuilder Hashed V6Sig algo -> SigBuilder Unhashed V6Sig algo
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs
                    ([SigSubPacket] -> HashedSubpackets V6Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
rawHashed)
                    (SigType
-> HashAlgorithm -> SignatureSalt -> SigBuilder Hashed V6Sig algo
forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigType
-> HashAlgorithm -> SignatureSalt -> SigBuilder Hashed V6Sig algo
sigBuilderInitV6 SigType
SubkeyBindingSig HashAlgorithm
SHA512 SignatureSalt
salt)
                )

        mkPkBuilderV4 :: [SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkPkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed =
            UnhashedSubpackets V4Sig
-> SigBuilder Unhashed V4Sig algo -> SigBuilder Unhashed V4Sig algo
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs
                ([SigSubPacket] -> UnhashedSubpackets V4Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
rawUnhashed)
                ( HashedSubpackets V4Sig
-> SigBuilder Hashed V4Sig algo -> SigBuilder Unhashed V4Sig algo
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs
                    ([SigSubPacket] -> HashedSubpackets V4Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
rawHashed)
                    (SigType -> HashAlgorithm -> SigBuilder Hashed V4Sig algo
forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigType -> HashAlgorithm -> SigBuilder Hashed V4Sig algo
sigBuilderInit SigType
PrimaryKeyBindingSig HashAlgorithm
SHA512)
                )
        mkPkBuilderV6 :: [SigSubPacket]
-> [SigSubPacket]
-> SignatureSalt
-> SigBuilder Unhashed V6Sig algo
mkPkBuilderV6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed SignatureSalt
salt =
            UnhashedSubpackets V6Sig
-> SigBuilder Unhashed V6Sig algo -> SigBuilder Unhashed V6Sig algo
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs
                ([SigSubPacket] -> UnhashedSubpackets V6Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
rawUnhashed)
                ( HashedSubpackets V6Sig
-> SigBuilder Hashed V6Sig algo -> SigBuilder Unhashed V6Sig algo
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs
                    ([SigSubPacket] -> HashedSubpackets V6Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
rawHashed)
                    (SigType
-> HashAlgorithm -> SignatureSalt -> SigBuilder Hashed V6Sig algo
forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigType
-> HashAlgorithm -> SignatureSalt -> SigBuilder Hashed V6Sig algo
sigBuilderInitV6 SigType
PrimaryKeyBindingSig HashAlgorithm
SHA512 SignatureSalt
salt)
                )

        signPrimaryKeyBinding :: KeyVersion
-> SKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> ExceptT TKGenError m (Maybe SignaturePayload)
signPrimaryKeyBinding KeyVersion
V4 SKey
sKey [SigSubPacket]
h [SigSubPacket]
u ByteString
p =
            case SKey
sKey of
                RSAPrivateKey RSA_PrivateKey
rsaPriv ->
                    (SignError -> ExceptT TKGenError m (Maybe SignaturePayload))
-> (SignaturePayload
    -> ExceptT TKGenError m (Maybe SignaturePayload))
-> Either SignError SignaturePayload
-> ExceptT TKGenError m (Maybe SignaturePayload)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TKGenError -> ExceptT TKGenError m (Maybe SignaturePayload)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m (Maybe SignaturePayload))
-> (SignError -> TKGenError)
-> SignError
-> ExceptT TKGenError m (Maybe SignaturePayload)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (SignError -> [Char]) -> SignError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignError -> [Char]
forall a. Show a => a -> [Char]
show) (Maybe SignaturePayload
-> ExceptT TKGenError m (Maybe SignaturePayload)
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SignaturePayload
 -> ExceptT TKGenError m (Maybe SignaturePayload))
-> (SignaturePayload -> Maybe SignaturePayload)
-> SignaturePayload
-> ExceptT TKGenError m (Maybe SignaturePayload)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SignaturePayload
forall a. a -> Maybe a
Just) (Either SignError SignaturePayload
 -> ExceptT TKGenError m (Maybe SignaturePayload))
-> Either SignError SignaturePayload
-> ExceptT TKGenError m (Maybe SignaturePayload)
forall a b. (a -> b) -> a -> b
$
                        SigBuilder Unhashed V4Sig 'RSA
-> PrivateKey -> ByteString -> Either SignError SignaturePayload
signDataWithRSABuilder
                            ([SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig 'RSA
forall {algo :: PubKeyAlgorithm}.
KnownPubKeyAlgorithm algo =>
[SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkPkBuilderV4 [SigSubPacket]
h [SigSubPacket]
u)
                            (RSA_PrivateKey -> PrivateKey
unRSA_PrivateKey RSA_PrivateKey
rsaPriv)
                            ByteString
p
                Ed25519PrivateKey ByteString
seed -> do
                    sk <-
                        (CryptoError -> ExceptT TKGenError m SecretKey)
-> (SecretKey -> ExceptT TKGenError m SecretKey)
-> Either CryptoError SecretKey
-> ExceptT TKGenError m SecretKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                            (TKGenError -> ExceptT TKGenError m SecretKey
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SecretKey)
-> (CryptoError -> TKGenError)
-> CryptoError
-> ExceptT TKGenError m SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (CryptoError -> [Char]) -> CryptoError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> [Char]
forall a. Show a => a -> [Char]
show)
                            SecretKey -> ExceptT TKGenError m SecretKey
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                            (CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ByteString
seed))
                    either (throwE . SignatureFailed . show) (pure . Just) $
                        signDataWithEd25519Builder (mkPkBuilderV4 h u) sk p
                EdDSAPrivateKey EdSigningCurve
EdSigningCurve25519 ByteString
seed -> do
                    sk <-
                        (CryptoError -> ExceptT TKGenError m SecretKey)
-> (SecretKey -> ExceptT TKGenError m SecretKey)
-> Either CryptoError SecretKey
-> ExceptT TKGenError m SecretKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                            (TKGenError -> ExceptT TKGenError m SecretKey
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SecretKey)
-> (CryptoError -> TKGenError)
-> CryptoError
-> ExceptT TKGenError m SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (CryptoError -> [Char]) -> CryptoError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> [Char]
forall a. Show a => a -> [Char]
show)
                            SecretKey -> ExceptT TKGenError m SecretKey
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                            (CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ByteString
seed))
                    either (throwE . SignatureFailed . show) (pure . Just) $
                        signDataWithEd25519Builder (mkPkBuilderV4 h u) sk p
                EdDSAPrivateKey EdSigningCurve
EdSigningCurve448 ByteString
seed -> do
                    sk <-
                        (CryptoError -> ExceptT TKGenError m SecretKey)
-> (SecretKey -> ExceptT TKGenError m SecretKey)
-> Either CryptoError SecretKey
-> ExceptT TKGenError m SecretKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                            (TKGenError -> ExceptT TKGenError m SecretKey
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SecretKey)
-> (CryptoError -> TKGenError)
-> CryptoError
-> ExceptT TKGenError m SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (CryptoError -> [Char]) -> CryptoError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> [Char]
forall a. Show a => a -> [Char]
show)
                            SecretKey -> ExceptT TKGenError m SecretKey
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                            (CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey ByteString
seed))
                    either (throwE . SignatureFailed . show) (pure . Just) $
                        signDataWithEd448Builder (mkPkBuilderV4 h u) sk p
                Ed448PrivateKey ByteString
seed -> do
                    sk <-
                        (CryptoError -> ExceptT TKGenError m SecretKey)
-> (SecretKey -> ExceptT TKGenError m SecretKey)
-> Either CryptoError SecretKey
-> ExceptT TKGenError m SecretKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                            (TKGenError -> ExceptT TKGenError m SecretKey
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SecretKey)
-> (CryptoError -> TKGenError)
-> CryptoError
-> ExceptT TKGenError m SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (CryptoError -> [Char]) -> CryptoError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> [Char]
forall a. Show a => a -> [Char]
show)
                            SecretKey -> ExceptT TKGenError m SecretKey
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                            (CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey ByteString
seed))
                    either (throwE . SignatureFailed . show) (pure . Just) $
                        signDataWithEd448Builder (mkPkBuilderV4 h u) sk p
                SKey
_ -> Maybe SignaturePayload
-> ExceptT TKGenError m (Maybe SignaturePayload)
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SignaturePayload
forall a. Maybe a
Nothing
        signPrimaryKeyBinding KeyVersion
V6 SKey
sKey [SigSubPacket]
h [SigSubPacket]
u ByteString
p =
            case SKey
sKey of
                RSAPrivateKey RSA_PrivateKey
rsaPriv -> do
                    (salt :: B.ByteString) <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
                    either (throwE . SignatureFailed . show) (pure . Just) $
                        signDataWithRSAV6Builder
                            (mkPkBuilderV6 h u (SignatureSalt salt))
                            (unRSA_PrivateKey rsaPriv)
                            p
                Ed25519PrivateKey ByteString
seed -> do
                    sk <-
                        (CryptoError -> ExceptT TKGenError m SecretKey)
-> (SecretKey -> ExceptT TKGenError m SecretKey)
-> Either CryptoError SecretKey
-> ExceptT TKGenError m SecretKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                            (TKGenError -> ExceptT TKGenError m SecretKey
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SecretKey)
-> (CryptoError -> TKGenError)
-> CryptoError
-> ExceptT TKGenError m SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (CryptoError -> [Char]) -> CryptoError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> [Char]
forall a. Show a => a -> [Char]
show)
                            SecretKey -> ExceptT TKGenError m SecretKey
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                            (CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ByteString
seed))
                    (salt :: B.ByteString) <- lift $ getRandomBytes 32
                    either (throwE . SignatureFailed . show) (pure . Just) $
                        signDataWithEd25519V6Builder
                            (mkPkBuilderV6 h u (SignatureSalt salt))
                            sk
                            p
                EdDSAPrivateKey EdSigningCurve
EdSigningCurve25519 ByteString
seed -> do
                    sk <-
                        (CryptoError -> ExceptT TKGenError m SecretKey)
-> (SecretKey -> ExceptT TKGenError m SecretKey)
-> Either CryptoError SecretKey
-> ExceptT TKGenError m SecretKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                            (TKGenError -> ExceptT TKGenError m SecretKey
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SecretKey)
-> (CryptoError -> TKGenError)
-> CryptoError
-> ExceptT TKGenError m SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (CryptoError -> [Char]) -> CryptoError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> [Char]
forall a. Show a => a -> [Char]
show)
                            SecretKey -> ExceptT TKGenError m SecretKey
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                            (CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ByteString
seed))
                    (salt :: B.ByteString) <- lift $ getRandomBytes 32
                    either (throwE . SignatureFailed . show) (pure . Just) $
                        signDataWithEd25519V6Builder
                            (mkPkBuilderV6 h u (SignatureSalt salt))
                            sk
                            p
                EdDSAPrivateKey EdSigningCurve
EdSigningCurve448 ByteString
seed -> do
                    sk <-
                        (CryptoError -> ExceptT TKGenError m SecretKey)
-> (SecretKey -> ExceptT TKGenError m SecretKey)
-> Either CryptoError SecretKey
-> ExceptT TKGenError m SecretKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                            (TKGenError -> ExceptT TKGenError m SecretKey
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SecretKey)
-> (CryptoError -> TKGenError)
-> CryptoError
-> ExceptT TKGenError m SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (CryptoError -> [Char]) -> CryptoError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> [Char]
forall a. Show a => a -> [Char]
show)
                            SecretKey -> ExceptT TKGenError m SecretKey
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                            (CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey ByteString
seed))
                    (salt :: B.ByteString) <- lift $ getRandomBytes 32
                    either (throwE . SignatureFailed . show) (pure . Just) $
                        signDataWithEd448V6Builder
                            (mkPkBuilderV6 h u (SignatureSalt salt))
                            sk
                            p
                Ed448PrivateKey ByteString
seed -> do
                    sk <-
                        (CryptoError -> ExceptT TKGenError m SecretKey)
-> (SecretKey -> ExceptT TKGenError m SecretKey)
-> Either CryptoError SecretKey
-> ExceptT TKGenError m SecretKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                            (TKGenError -> ExceptT TKGenError m SecretKey
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SecretKey)
-> (CryptoError -> TKGenError)
-> CryptoError
-> ExceptT TKGenError m SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (CryptoError -> [Char]) -> CryptoError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> [Char]
forall a. Show a => a -> [Char]
show)
                            SecretKey -> ExceptT TKGenError m SecretKey
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                            (CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey ByteString
seed))
                    (salt :: B.ByteString) <- lift $ getRandomBytes 32
                    either (throwE . SignatureFailed . show) (pure . Just) $
                        signDataWithEd448V6Builder
                            (mkPkBuilderV6 h u (SignatureSalt salt))
                            sk
                            p
                SKey
_ -> Maybe SignaturePayload
-> ExceptT TKGenError m (Maybe SignaturePayload)
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SignaturePayload
forall a. Maybe a
Nothing

        signEd25519V4 :: [SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ba
seed ByteString
payload = case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ba
seed) of
            Left CryptoError
err ->
                TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
SignatureFailed ([Char]
"Ed25519 signing failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err))
            Right SecretKey
sk ->
                (SignError -> ExceptT TKGenError m SignaturePayload)
-> (SignaturePayload -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SignaturePayload)
-> (SignError -> TKGenError)
-> SignError
-> ExceptT TKGenError m SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (SignError -> [Char]) -> SignError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignError -> [Char]
forall a. Show a => a -> [Char]
show) SignaturePayload -> ExceptT TKGenError m SignaturePayload
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a b. (a -> b) -> a -> b
$
                    SigBuilder Unhashed V4Sig 'Ed25519
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd25519Builder
                        ([SigSubPacket]
-> [SigSubPacket] -> SigBuilder Unhashed V4Sig 'Ed25519
forall {algo :: PubKeyAlgorithm}.
KnownPubKeyAlgorithm algo =>
[SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed)
                        SecretKey
sk
                        ByteString
payload
        signEd25519V6 :: [SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd25519V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ba
seed ByteString
payload = case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ba
seed) of
            Left CryptoError
err ->
                TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
SignatureFailed ([Char]
"Ed25519 signing failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err))
            Right SecretKey
sk -> do
                (salt :: B.ByteString) <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
                either (throwE . SignatureFailed . show) pure $
                    signDataWithEd25519V6Builder
                        (mkBuilderV6 rawHashed rawUnhashed (SignatureSalt salt))
                        sk
                        payload
        signEd448V4 :: [SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ba
seed ByteString
payload = case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey ba
seed) of
            Left CryptoError
err ->
                TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
SignatureFailed ([Char]
"Ed448 signing failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err))
            Right SecretKey
sk ->
                (SignError -> ExceptT TKGenError m SignaturePayload)
-> (SignaturePayload -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TKGenError -> ExceptT TKGenError m SignaturePayload)
-> (SignError -> TKGenError)
-> SignError
-> ExceptT TKGenError m SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TKGenError
SignatureFailed ([Char] -> TKGenError)
-> (SignError -> [Char]) -> SignError -> TKGenError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignError -> [Char]
forall a. Show a => a -> [Char]
show) SignaturePayload -> ExceptT TKGenError m SignaturePayload
forall a. a -> ExceptT TKGenError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SignError SignaturePayload
 -> ExceptT TKGenError m SignaturePayload)
-> Either SignError SignaturePayload
-> ExceptT TKGenError m SignaturePayload
forall a b. (a -> b) -> a -> b
$
                    SigBuilder Unhashed V4Sig 'Ed448
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd448Builder
                        ([SigSubPacket]
-> [SigSubPacket] -> SigBuilder Unhashed V4Sig 'Ed448
forall {algo :: PubKeyAlgorithm}.
KnownPubKeyAlgorithm algo =>
[SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed V4Sig algo
mkBuilderV4 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed)
                        SecretKey
sk
                        ByteString
payload
        signEd448V6 :: [SigSubPacket]
-> [SigSubPacket]
-> ba
-> ByteString
-> ExceptT TKGenError m SignaturePayload
signEd448V6 [SigSubPacket]
rawHashed [SigSubPacket]
rawUnhashed ba
seed ByteString
payload = case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey ba
seed) of
            Left CryptoError
err ->
                TKGenError -> ExceptT TKGenError m SignaturePayload
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> TKGenError
SignatureFailed ([Char]
"Ed448 signing failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err))
            Right SecretKey
sk -> do
                (salt :: B.ByteString) <- m ByteString -> ExceptT TKGenError m ByteString
forall (m :: * -> *) a. Monad m => m a -> ExceptT TKGenError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ExceptT TKGenError m ByteString)
-> m ByteString -> ExceptT TKGenError m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
                either (throwE . SignatureFailed . show) pure $
                    signDataWithEd448V6Builder
                        (mkBuilderV6 rawHashed rawUnhashed (SignatureSalt salt))
                        sk
                        payload

    signBinding
        :: KeyVersion
        -> SomePKPayload
        -> SKey
        -> ThirtyTwoBitTimeStamp
        -> SubkeySpec
        -> ExceptT TKGenError m SignaturePayload
    signBinding :: KeyVersion
-> SomePKPayload
-> SKey
-> ThirtyTwoBitTimeStamp
-> SubkeySpec
-> ExceptT TKGenError m SignaturePayload
signBinding KeyVersion
kv SomePKPayload
primaryPkp SKey
primarySKey ThirtyTwoBitTimeStamp
ct SubkeySpec
spec =
        KeyVersion
-> SomePKPayload
-> SKey
-> ThirtyTwoBitTimeStamp
-> SubkeySpec
-> ExceptT TKGenError m SignaturePayload
signSubkeyBinding KeyVersion
kv SomePKPayload
primaryPkp SKey
primarySKey ThirtyTwoBitTimeStamp
ct SubkeySpec
spec

    mkSubkey
        :: SomePKPayload
        -> SKey
        -> KeyVersion
        -> ThirtyTwoBitTimeStamp
        -> SubkeySpec
        -> ExceptT TKGenError m (KeyPkt 'SecretPkt, [SignaturePayload])
    mkSubkey :: SomePKPayload
-> SKey
-> KeyVersion
-> ThirtyTwoBitTimeStamp
-> SubkeySpec
-> ExceptT TKGenError m (KeyPkt 'SecretPkt, [SignaturePayload])
mkSubkey SomePKPayload
primaryPkp SKey
primarySKey KeyVersion
kv ThirtyTwoBitTimeStamp
ct SubkeySpec
spec = do
        let subPkt :: KeyPkt 'SecretPkt
subPkt =
                SomePKPayload -> SKAddendum -> KeyPkt 'SecretPkt
KeyPktSecretSubkey
                    (SubkeySpec -> SomePKPayload
_subkeyPayload SubkeySpec
spec)
                    (SKey -> V3Expiration -> SKAddendum
SUSUnprotected (SubkeySpec -> SKey
_subkeySKey SubkeySpec
spec) V3Expiration
0)
        sig <- KeyVersion
-> SomePKPayload
-> SKey
-> ThirtyTwoBitTimeStamp
-> SubkeySpec
-> ExceptT TKGenError m SignaturePayload
signBinding KeyVersion
kv SomePKPayload
primaryPkp SKey
primarySKey ThirtyTwoBitTimeStamp
ct SubkeySpec
spec
        pure (subPkt, [sig])

-- -----------------------------------------------------------------------------
-- Helper
-- -----------------------------------------------------------------------------