-- Subpackets.hs: Type-safe subpacket builders with phantom types
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Codec.Encryption.OpenPGP.Subpackets
    ( -- * Safe subpacket construction
      SafeSubpacket
    , mkSafeSubpacket
    , safePayload
    , safeSubpacket

      -- * Critical subpacket handling
    , CriticalSubpacket
    , mkCritical
    , canBeCritical

      -- * Text normalization mode
    , TextNormalizationMode (..)

      -- * Builder API for signature composition
    , SigBuilder
    , LegalSubpacket (..)
    , legalSubpacket
    , singleLegalSub
    , consLegalSub
    , listToLegalSubs
    , sbSigType
    , sbPubKeyAlgo
    , sbHashAlgo
    , sbHashedSubs
    , sbUnhashedSubs
    , sbSalt
    , sbTextNormMode
    , buildSigV4
    , buildSigV6
    , sigBuilderInit
    , sigBuilderInitTyped
    , sigBuilderInitRuntime
    , sigBuilderInitV6
    , sigBuilderInitV6Typed
    , sigBuilderInitV6Runtime
    , addHashedSubs
    , addUnhashedSubs
    , KnownPubKeyAlgorithm (..)

      -- * Private key wrapper (algorithm-specific)
    , PrivateKeyFor (..)

      -- * Subpacket list utilities
    , HashedSubpackets
    , UnhashedSubpackets
    , consHashedSub
    , singleHashedSub
    , singleUnhashedSub
    , listToHashedSubs
    , listToUnhashedSubs
    ) where

import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.Ed448 as Ed448
import qualified Crypto.PubKey.RSA.Types as RSATypes
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty)
import Data.Proxy (Proxy (..))
import Data.Word (Word16)

import Codec.Encryption.OpenPGP.Policy
    ( HashAlgoAllowedFor
    , HashAlgorithmW (..)
    , OpenPGPRFC
    , OpenPGPRFCW (..)
    , SomeHashAlgorithmW (..)
    , SomeOpenPGPRFCW (..)
    , demoteHashAlgorithmW
    , deprecatedHashAlgorithms
    , policyForRFC
    , policyGenerationDeprecations
    , promoteHashAlgorithm
    , promoteOpenPGPRFC
    )
import Codec.Encryption.OpenPGP.Types
    ( EightOctetKeyId
    , Fingerprint
    , HashAlgorithm
    , Hashed
    , MPI
    , SigSubPacket (..)
    , SigSubPacketPayload (..)
    , SigType
    , SignaturePayload (..)
    , SignatureSalt
    , SubpacketList (..)
    , ThirtyTwoBitTimeStamp
    , Unhashed
    , V4Sig
    , V6Sig
    )
import Codec.Encryption.OpenPGP.Types.Internal.Base
    ( IssuerFingerprintVersion (..)
    , PubKeyAlgorithm (..)
    )

-- | Type alias for readability: hashed subpacket list
type HashedSubpackets v = SubpacketList Hashed v

-- | Type alias for readability: unhashed subpacket list
type UnhashedSubpackets v = SubpacketList Unhashed v

{- | A subpacket that has passed basic safety checks
(does not guarantee it's critical-safe; use CriticalSubpacket for that)
-}
newtype SafeSubpacket = SafeSubpacket SigSubPacket
    deriving (SafeSubpacket -> SafeSubpacket -> Bool
(SafeSubpacket -> SafeSubpacket -> Bool)
-> (SafeSubpacket -> SafeSubpacket -> Bool) -> Eq SafeSubpacket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SafeSubpacket -> SafeSubpacket -> Bool
== :: SafeSubpacket -> SafeSubpacket -> Bool
$c/= :: SafeSubpacket -> SafeSubpacket -> Bool
/= :: SafeSubpacket -> SafeSubpacket -> Bool
Eq, Eq SafeSubpacket
Eq SafeSubpacket =>
(SafeSubpacket -> SafeSubpacket -> Ordering)
-> (SafeSubpacket -> SafeSubpacket -> Bool)
-> (SafeSubpacket -> SafeSubpacket -> Bool)
-> (SafeSubpacket -> SafeSubpacket -> Bool)
-> (SafeSubpacket -> SafeSubpacket -> Bool)
-> (SafeSubpacket -> SafeSubpacket -> SafeSubpacket)
-> (SafeSubpacket -> SafeSubpacket -> SafeSubpacket)
-> Ord SafeSubpacket
SafeSubpacket -> SafeSubpacket -> Bool
SafeSubpacket -> SafeSubpacket -> Ordering
SafeSubpacket -> SafeSubpacket -> SafeSubpacket
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 :: SafeSubpacket -> SafeSubpacket -> Ordering
compare :: SafeSubpacket -> SafeSubpacket -> Ordering
$c< :: SafeSubpacket -> SafeSubpacket -> Bool
< :: SafeSubpacket -> SafeSubpacket -> Bool
$c<= :: SafeSubpacket -> SafeSubpacket -> Bool
<= :: SafeSubpacket -> SafeSubpacket -> Bool
$c> :: SafeSubpacket -> SafeSubpacket -> Bool
> :: SafeSubpacket -> SafeSubpacket -> Bool
$c>= :: SafeSubpacket -> SafeSubpacket -> Bool
>= :: SafeSubpacket -> SafeSubpacket -> Bool
$cmax :: SafeSubpacket -> SafeSubpacket -> SafeSubpacket
max :: SafeSubpacket -> SafeSubpacket -> SafeSubpacket
$cmin :: SafeSubpacket -> SafeSubpacket -> SafeSubpacket
min :: SafeSubpacket -> SafeSubpacket -> SafeSubpacket
Ord, Int -> SafeSubpacket -> ShowS
[SafeSubpacket] -> ShowS
SafeSubpacket -> String
(Int -> SafeSubpacket -> ShowS)
-> (SafeSubpacket -> String)
-> ([SafeSubpacket] -> ShowS)
-> Show SafeSubpacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SafeSubpacket -> ShowS
showsPrec :: Int -> SafeSubpacket -> ShowS
$cshow :: SafeSubpacket -> String
show :: SafeSubpacket -> String
$cshowList :: [SafeSubpacket] -> ShowS
showList :: [SafeSubpacket] -> ShowS
Show)

{- | Create a safe subpacket from a payload and criticality flag
Basic validation that the payload is well-formed
-}
mkSafeSubpacket
    :: Bool -> SigSubPacketPayload -> Either String SafeSubpacket
mkSafeSubpacket :: Bool -> SigSubPacketPayload -> Either String SafeSubpacket
mkSafeSubpacket Bool
crit SigSubPacketPayload
payload = do
    -- Validate criticality constraints: some subpackets should never be critical
    if Bool
crit Bool -> Bool -> Bool
&& Bool -> Bool
not (SigSubPacketPayload -> Bool
canBeCritical SigSubPacketPayload
payload)
        then
            String -> Either String SafeSubpacket
forall a b. a -> Either a b
Left (String -> Either String SafeSubpacket)
-> String -> Either String SafeSubpacket
forall a b. (a -> b) -> a -> b
$
                String
"Subpacket type cannot be marked critical: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SigSubPacketPayload -> String
forall a. Show a => a -> String
show SigSubPacketPayload
payload
        else SafeSubpacket -> Either String SafeSubpacket
forall a b. b -> Either a b
Right (SigSubPacket -> SafeSubpacket
SafeSubpacket (Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
crit SigSubPacketPayload
payload))

-- | Extract the payload from a safe subpacket
safePayload :: SafeSubpacket -> SigSubPacketPayload
safePayload :: SafeSubpacket -> SigSubPacketPayload
safePayload (SafeSubpacket (SigSubPacket Bool
_ SigSubPacketPayload
payload)) = SigSubPacketPayload
payload

-- | Extract the underlying SigSubPacket from a safe subpacket
safeSubpacket :: SafeSubpacket -> SigSubPacket
safeSubpacket :: SafeSubpacket -> SigSubPacket
safeSubpacket (SafeSubpacket SigSubPacket
ssp) = SigSubPacket
ssp

{- | A subpacket that is guaranteed to be both well-formed AND can be safely marked critical
Used to prevent accidentally marking non-critical-safe types as critical
-}
newtype CriticalSubpacket = CriticalSubpacket SigSubPacket
    deriving (CriticalSubpacket -> CriticalSubpacket -> Bool
(CriticalSubpacket -> CriticalSubpacket -> Bool)
-> (CriticalSubpacket -> CriticalSubpacket -> Bool)
-> Eq CriticalSubpacket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CriticalSubpacket -> CriticalSubpacket -> Bool
== :: CriticalSubpacket -> CriticalSubpacket -> Bool
$c/= :: CriticalSubpacket -> CriticalSubpacket -> Bool
/= :: CriticalSubpacket -> CriticalSubpacket -> Bool
Eq, Eq CriticalSubpacket
Eq CriticalSubpacket =>
(CriticalSubpacket -> CriticalSubpacket -> Ordering)
-> (CriticalSubpacket -> CriticalSubpacket -> Bool)
-> (CriticalSubpacket -> CriticalSubpacket -> Bool)
-> (CriticalSubpacket -> CriticalSubpacket -> Bool)
-> (CriticalSubpacket -> CriticalSubpacket -> Bool)
-> (CriticalSubpacket -> CriticalSubpacket -> CriticalSubpacket)
-> (CriticalSubpacket -> CriticalSubpacket -> CriticalSubpacket)
-> Ord CriticalSubpacket
CriticalSubpacket -> CriticalSubpacket -> Bool
CriticalSubpacket -> CriticalSubpacket -> Ordering
CriticalSubpacket -> CriticalSubpacket -> CriticalSubpacket
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 :: CriticalSubpacket -> CriticalSubpacket -> Ordering
compare :: CriticalSubpacket -> CriticalSubpacket -> Ordering
$c< :: CriticalSubpacket -> CriticalSubpacket -> Bool
< :: CriticalSubpacket -> CriticalSubpacket -> Bool
$c<= :: CriticalSubpacket -> CriticalSubpacket -> Bool
<= :: CriticalSubpacket -> CriticalSubpacket -> Bool
$c> :: CriticalSubpacket -> CriticalSubpacket -> Bool
> :: CriticalSubpacket -> CriticalSubpacket -> Bool
$c>= :: CriticalSubpacket -> CriticalSubpacket -> Bool
>= :: CriticalSubpacket -> CriticalSubpacket -> Bool
$cmax :: CriticalSubpacket -> CriticalSubpacket -> CriticalSubpacket
max :: CriticalSubpacket -> CriticalSubpacket -> CriticalSubpacket
$cmin :: CriticalSubpacket -> CriticalSubpacket -> CriticalSubpacket
min :: CriticalSubpacket -> CriticalSubpacket -> CriticalSubpacket
Ord, Int -> CriticalSubpacket -> ShowS
[CriticalSubpacket] -> ShowS
CriticalSubpacket -> String
(Int -> CriticalSubpacket -> ShowS)
-> (CriticalSubpacket -> String)
-> ([CriticalSubpacket] -> ShowS)
-> Show CriticalSubpacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CriticalSubpacket -> ShowS
showsPrec :: Int -> CriticalSubpacket -> ShowS
$cshow :: CriticalSubpacket -> String
show :: CriticalSubpacket -> String
$cshowList :: [CriticalSubpacket] -> ShowS
showList :: [CriticalSubpacket] -> ShowS
Show)

{- | Create a critical subpacket only if the payload type allows it
RFC9580 section 5.2.3.5: only certain subpacket types can be marked critical
-}
mkCritical
    :: SigSubPacketPayload -> Either String CriticalSubpacket
mkCritical :: SigSubPacketPayload -> Either String CriticalSubpacket
mkCritical SigSubPacketPayload
payload
    | SigSubPacketPayload -> Bool
canBeCritical SigSubPacketPayload
payload =
        CriticalSubpacket -> Either String CriticalSubpacket
forall a b. b -> Either a b
Right (CriticalSubpacket -> Either String CriticalSubpacket)
-> CriticalSubpacket -> Either String CriticalSubpacket
forall a b. (a -> b) -> a -> b
$ SigSubPacket -> CriticalSubpacket
CriticalSubpacket (Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
True SigSubPacketPayload
payload)
    | Bool
otherwise =
        String -> Either String CriticalSubpacket
forall a b. a -> Either a b
Left (String -> Either String CriticalSubpacket)
-> String -> Either String CriticalSubpacket
forall a b. (a -> b) -> a -> b
$ String
"Cannot mark as critical: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SigSubPacketPayload -> String
payloadType SigSubPacketPayload
payload
  where
    payloadType :: SigSubPacketPayload -> String
payloadType (SigCreationTime ThirtyTwoBitTimeStamp
_) = String
"SigCreationTime"
    payloadType (SigExpirationTime ThirtyTwoBitDuration
_) = String
"SigExpirationTime"
    payloadType (ExportableCertification Bool
_) = String
"ExportableCertification"
    payloadType (TrustSignature {}) = String
"TrustSignature"
    payloadType (RegularExpression AlmostPublicDomainRegex
_) = String
"RegularExpression"
    payloadType (Revocable Bool
_) = String
"Revocable"
    payloadType (KeyExpirationTime ThirtyTwoBitDuration
_) = String
"KeyExpirationTime"
    payloadType (PreferredSymmetricAlgorithms [SymmetricAlgorithm]
_) = String
"PreferredSymmetricAlgorithms"
    payloadType (RevocationKey {}) = String
"RevocationKey"
    payloadType (Issuer EightOctetKeyId
_) = String
"Issuer"
    payloadType (NotationData {}) = String
"NotationData"
    payloadType (PreferredHashAlgorithms [HashAlgorithm]
_) = String
"PreferredHashAlgorithms"
    payloadType (PreferredCompressionAlgorithms [CompressionAlgorithm]
_) = String
"PreferredCompressionAlgorithms"
    payloadType (KeyServerPreferences Set KSPFlag
_) = String
"KeyServerPreferences"
    payloadType (PreferredKeyServer AlmostPublicDomainRegex
_) = String
"PreferredKeyServer"
    payloadType (PrimaryUserId Bool
_) = String
"PrimaryUserId"
    payloadType (PolicyURL URL
_) = String
"PolicyURL"
    payloadType (KeyFlags Set KeyFlag
_) = String
"KeyFlags"
    payloadType (SignersUserId Text
_) = String
"SignersUserId"
    payloadType (ReasonForRevocation {}) = String
"ReasonForRevocation"
    payloadType (Features Set FeatureFlag
_) = String
"Features"
    payloadType (SignatureTarget {}) = String
"SignatureTarget"
    payloadType (EmbeddedSignature SignaturePayload
_) = String
"EmbeddedSignature"
    payloadType (IssuerFingerprint {}) = String
"IssuerFingerprint"
    payloadType (UserDefinedSigSub Word8
_ AlmostPublicDomainRegex
_) = String
"UserDefinedSigSub"
    payloadType (OtherSigSub Word8
_ AlmostPublicDomainRegex
_) = String
"OtherSigSub"
    payloadType (IntendedRecipient IssuerFingerprintVersion
_ Fingerprint
_) = String
"IntendedRecipient"
    payloadType (PreferredAEADCiphersuites [(SymmetricAlgorithm, AEADAlgorithm)]
_) = String
"PreferredAEADCiphersuites"

-- | RFC9580 §5.2.3.5 lists which subpacket types can be marked critical
canBeCritical :: SigSubPacketPayload -> Bool
canBeCritical :: SigSubPacketPayload -> Bool
canBeCritical KeyFlags {} = Bool
True
canBeCritical IssuerFingerprint {} = Bool
True
canBeCritical EmbeddedSignature {} = Bool
True
-- Future-proofing: unknown critical types are allowed to be critical
canBeCritical UserDefinedSigSub {} = Bool
True
canBeCritical OtherSigSub {} = Bool
True
canBeCritical SigSubPacketPayload
_ = Bool
False

{- | Wrapper GADT for algorithm-specific private keys
Encodes the algorithm at the type level to ensure type-safe key/builder matching
-}
data PrivateKeyFor (algo :: PubKeyAlgorithm) where
    RSAPrivateKey :: RSATypes.PrivateKey -> PrivateKeyFor 'RSA
    Ed25519PrivateKey :: Ed25519.SecretKey -> PrivateKeyFor 'Ed25519
    Ed448PrivateKey :: Ed448.SecretKey -> PrivateKeyFor 'Ed448
    DSAPrivateKey :: DSA.PrivateKey -> PrivateKeyFor 'DSA
    ECDSAPrivateKey :: ECDSA.PrivateKey -> PrivateKeyFor 'ECDSA

class KnownPubKeyAlgorithm (algo :: PubKeyAlgorithm) where
    demotePubKeyAlgorithmT :: Proxy algo -> PubKeyAlgorithm

instance KnownPubKeyAlgorithm 'RSA where
    demotePubKeyAlgorithmT :: Proxy 'RSA -> PubKeyAlgorithm
demotePubKeyAlgorithmT Proxy 'RSA
_ = PubKeyAlgorithm
RSA

instance KnownPubKeyAlgorithm 'DSA where
    demotePubKeyAlgorithmT :: Proxy 'DSA -> PubKeyAlgorithm
demotePubKeyAlgorithmT Proxy 'DSA
_ = PubKeyAlgorithm
DSA

instance KnownPubKeyAlgorithm 'ECDSA where
    demotePubKeyAlgorithmT :: Proxy 'ECDSA -> PubKeyAlgorithm
demotePubKeyAlgorithmT Proxy 'ECDSA
_ = PubKeyAlgorithm
ECDSA

instance KnownPubKeyAlgorithm 'EdDSALegacy where
    demotePubKeyAlgorithmT :: Proxy 'EdDSALegacy -> PubKeyAlgorithm
demotePubKeyAlgorithmT Proxy 'EdDSALegacy
_ = PubKeyAlgorithm
EdDSALegacy

instance KnownPubKeyAlgorithm 'Ed25519 where
    demotePubKeyAlgorithmT :: Proxy 'Ed25519 -> PubKeyAlgorithm
demotePubKeyAlgorithmT Proxy 'Ed25519
_ = PubKeyAlgorithm
Ed25519

instance KnownPubKeyAlgorithm 'Ed448 where
    demotePubKeyAlgorithmT :: Proxy 'Ed448 -> PubKeyAlgorithm
demotePubKeyAlgorithmT Proxy 'Ed448
_ = PubKeyAlgorithm
Ed448

{- | Legal subpackets encoded by placement and signature-version constraints.
This expands compile-time legality beyond bare hashed/unhashed staging.
-}
data LegalSubpacket (h :: Type) (v :: Type) where
    -- RFC9580: signature creation time is a hashed subpacket.
    LegalSigCreationTime
        :: ThirtyTwoBitTimeStamp -> LegalSubpacket Hashed v
    -- v4 signatures use an issuer fingerprint subpacket with version marker 4 in hashed area.
    LegalIssuerFingerprintV4
        :: Fingerprint -> LegalSubpacket Hashed V4Sig
    -- v6 signatures use an issuer fingerprint subpacket with version marker 6 in hashed area.
    LegalIssuerFingerprintV6
        :: Fingerprint -> LegalSubpacket Hashed V6Sig
    -- Legacy issuer key ID subpacket is accepted only in v4 and only unhashed.
    LegalIssuerV4 :: EightOctetKeyId -> LegalSubpacket Unhashed V4Sig

legalSubpacket :: LegalSubpacket h v -> SigSubPacket
legalSubpacket :: forall h v. LegalSubpacket h v -> SigSubPacket
legalSubpacket (LegalSigCreationTime ThirtyTwoBitTimeStamp
ts) = Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (ThirtyTwoBitTimeStamp -> SigSubPacketPayload
SigCreationTime ThirtyTwoBitTimeStamp
ts)
legalSubpacket (LegalIssuerFingerprintV4 Fingerprint
fp) = Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (IssuerFingerprintVersion -> Fingerprint -> SigSubPacketPayload
IssuerFingerprint IssuerFingerprintVersion
IssuerFingerprintV4 Fingerprint
fp)
legalSubpacket (LegalIssuerFingerprintV6 Fingerprint
fp) = Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (IssuerFingerprintVersion -> Fingerprint -> SigSubPacketPayload
IssuerFingerprint IssuerFingerprintVersion
IssuerFingerprintV6 Fingerprint
fp)
legalSubpacket (LegalIssuerV4 EightOctetKeyId
keyId) = Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (EightOctetKeyId -> SigSubPacketPayload
Issuer EightOctetKeyId
keyId)

singleLegalSub :: LegalSubpacket h v -> SubpacketList h v
singleLegalSub :: forall h v. LegalSubpacket h v -> SubpacketList h v
singleLegalSub = [SigSubPacket] -> SubpacketList h v
forall hashedness version.
[SigSubPacket] -> SubpacketList hashedness version
SubpacketList ([SigSubPacket] -> SubpacketList h v)
-> (LegalSubpacket h v -> [SigSubPacket])
-> LegalSubpacket h v
-> SubpacketList h v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigSubPacket -> [SigSubPacket] -> [SigSubPacket]
forall a. a -> [a] -> [a]
: []) (SigSubPacket -> [SigSubPacket])
-> (LegalSubpacket h v -> SigSubPacket)
-> LegalSubpacket h v
-> [SigSubPacket]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegalSubpacket h v -> SigSubPacket
forall h v. LegalSubpacket h v -> SigSubPacket
legalSubpacket

consLegalSub
    :: LegalSubpacket h v -> SubpacketList h v -> SubpacketList h v
consLegalSub :: forall h v.
LegalSubpacket h v -> SubpacketList h v -> SubpacketList h v
consLegalSub LegalSubpacket h v
legal (SubpacketList [SigSubPacket]
sps) = [SigSubPacket] -> SubpacketList h v
forall hashedness version.
[SigSubPacket] -> SubpacketList hashedness version
SubpacketList (LegalSubpacket h v -> SigSubPacket
forall h v. LegalSubpacket h v -> SigSubPacket
legalSubpacket LegalSubpacket h v
legal SigSubPacket -> [SigSubPacket] -> [SigSubPacket]
forall a. a -> [a] -> [a]
: [SigSubPacket]
sps)

listToLegalSubs :: [LegalSubpacket h v] -> SubpacketList h v
listToLegalSubs :: forall h v. [LegalSubpacket h v] -> SubpacketList h v
listToLegalSubs = [SigSubPacket] -> SubpacketList h v
forall hashedness version.
[SigSubPacket] -> SubpacketList hashedness version
SubpacketList ([SigSubPacket] -> SubpacketList h v)
-> ([LegalSubpacket h v] -> [SigSubPacket])
-> [LegalSubpacket h v]
-> SubpacketList h v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LegalSubpacket h v -> SigSubPacket)
-> [LegalSubpacket h v] -> [SigSubPacket]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LegalSubpacket h v -> SigSubPacket
forall h v. LegalSubpacket h v -> SigSubPacket
legalSubpacket

-- | Construct a single hashed subpacket into a hashed subpacket list
singleHashedSub :: SigSubPacket -> HashedSubpackets v
singleHashedSub :: forall v. SigSubPacket -> HashedSubpackets v
singleHashedSub SigSubPacket
sp = [SigSubPacket] -> SubpacketList Hashed v
forall hashedness version.
[SigSubPacket] -> SubpacketList hashedness version
SubpacketList [SigSubPacket
sp]

-- | Construct a single unhashed subpacket into an unhashed subpacket list
singleUnhashedSub :: SigSubPacket -> UnhashedSubpackets v
singleUnhashedSub :: forall v. SigSubPacket -> UnhashedSubpackets v
singleUnhashedSub SigSubPacket
sp = [SigSubPacket] -> SubpacketList Unhashed v
forall hashedness version.
[SigSubPacket] -> SubpacketList hashedness version
SubpacketList [SigSubPacket
sp]

-- | Prepend a subpacket to a hashed subpacket list
consHashedSub
    :: SigSubPacket -> HashedSubpackets v -> HashedSubpackets v
consHashedSub :: forall v. SigSubPacket -> HashedSubpackets v -> HashedSubpackets v
consHashedSub SigSubPacket
sp (SubpacketList [SigSubPacket]
sps) = [SigSubPacket] -> SubpacketList Hashed v
forall hashedness version.
[SigSubPacket] -> SubpacketList hashedness version
SubpacketList (SigSubPacket
sp SigSubPacket -> [SigSubPacket] -> [SigSubPacket]
forall a. a -> [a] -> [a]
: [SigSubPacket]
sps)

{- | Controls how text payload is normalized for CanonicalTextSig.

RFC 9580 §5.2.1.2 requires only CRLF normalization for type 0x01
signatures.  Trailing-whitespace stripping is only mandated by
§7 (Cleartext Signature Framework).  Use 'CleartextCompat' for
GnuPG-compatible behaviour when producing cleartext-armored
signatures; use 'RFC9580Strict' for inline text signatures.
-}
data TextNormalizationMode
    = {- | CRLF normalization only; no trailing-whitespace stripping.
      Correct for inline type 0x01 document signatures.
      -}
      RFC9580Strict
    | {- | CRLF normalization *plus* per-line trailing-whitespace stripping.
      Required by the Cleartext Signature Framework (RFC 9580 §7).
      -}
      CleartextCompat
    deriving (TextNormalizationMode -> TextNormalizationMode -> Bool
(TextNormalizationMode -> TextNormalizationMode -> Bool)
-> (TextNormalizationMode -> TextNormalizationMode -> Bool)
-> Eq TextNormalizationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextNormalizationMode -> TextNormalizationMode -> Bool
== :: TextNormalizationMode -> TextNormalizationMode -> Bool
$c/= :: TextNormalizationMode -> TextNormalizationMode -> Bool
/= :: TextNormalizationMode -> TextNormalizationMode -> Bool
Eq, Int -> TextNormalizationMode -> ShowS
[TextNormalizationMode] -> ShowS
TextNormalizationMode -> String
(Int -> TextNormalizationMode -> ShowS)
-> (TextNormalizationMode -> String)
-> ([TextNormalizationMode] -> ShowS)
-> Show TextNormalizationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextNormalizationMode -> ShowS
showsPrec :: Int -> TextNormalizationMode -> ShowS
$cshow :: TextNormalizationMode -> String
show :: TextNormalizationMode -> String
$cshowList :: [TextNormalizationMode] -> ShowS
showList :: [TextNormalizationMode] -> ShowS
Show)

{- | Staged signature builder that enforces completion order

Usage pattern:
  builder <- sigBuilderInit SigTypeBinary RSA SHA256
  builder' <- addHashedSubs hashedList builder
  finalPayload <- buildSigV4 sigMPIs (addUnhashedSubs unhashedList builder')
-}
data
    SigBuilder
        (hashedness :: Type)
        (v :: Type)
        (algo :: PubKeyAlgorithm)
    = SigBuilder
    { forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> SigType
sbSigType :: SigType
    , forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> HashAlgorithm
sbHashAlgo :: HashAlgorithm
    , forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbHashedSubs :: [SigSubPacket]
    , forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbUnhashedSubs :: [SigSubPacket]
    , forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> BuilderSalt v
sbSalt :: BuilderSalt v
    , forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> TextNormalizationMode
sbTextNormMode :: TextNormalizationMode
    {- ^ Normalization mode for CanonicalTextSig payloads.
    Defaults to 'CleartextCompat' for backward compatibility.
    -}
    }

type family BuilderSalt (v :: Type) where
    BuilderSalt V4Sig = ()
    BuilderSalt V6Sig = SignatureSalt

sbPubKeyAlgo
    :: forall hashedness v algo
     . KnownPubKeyAlgorithm algo
    => SigBuilder hashedness v algo -> PubKeyAlgorithm
sbPubKeyAlgo :: forall hashedness v (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigBuilder hashedness v algo -> PubKeyAlgorithm
sbPubKeyAlgo SigBuilder hashedness v algo
_ = Proxy algo -> PubKeyAlgorithm
forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
Proxy algo -> PubKeyAlgorithm
demotePubKeyAlgorithmT (forall {k} (t :: k). Proxy t
forall (t :: PubKeyAlgorithm). Proxy t
Proxy @algo)

{- | Initialize a builder for a v4 signature
Starts with no subpackets and must call addHashedSubs and addUnhashedSubs
-}
sigBuilderInit
    :: forall algo
     . KnownPubKeyAlgorithm algo
    => SigType
    -> HashAlgorithm
    -> SigBuilder Hashed V4Sig algo
sigBuilderInit :: forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigType -> HashAlgorithm -> SigBuilder Hashed V4Sig algo
sigBuilderInit SigType
st HashAlgorithm
ha =
    SigBuilder
        { sbSigType :: SigType
sbSigType = SigType
st
        , sbHashAlgo :: HashAlgorithm
sbHashAlgo = HashAlgorithm
ha
        , sbHashedSubs :: [SigSubPacket]
sbHashedSubs = []
        , sbUnhashedSubs :: [SigSubPacket]
sbUnhashedSubs = []
        , sbSalt :: BuilderSalt V4Sig
sbSalt = ()
        , sbTextNormMode :: TextNormalizationMode
sbTextNormMode = TextNormalizationMode
CleartextCompat
        }

-- | Initialize a builder for a v4 signature with compile-time RFC/hash policy enforcement.
sigBuilderInitTyped
    :: forall algo rfc h
     . (HashAlgoAllowedFor rfc h, KnownPubKeyAlgorithm algo)
    => OpenPGPRFCW rfc
    -> SigType
    -> HashAlgorithmW h
    -> SigBuilder Hashed V4Sig algo
sigBuilderInitTyped :: forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(HashAlgoAllowedFor rfc h, KnownPubKeyAlgorithm algo) =>
OpenPGPRFCW rfc
-> SigType -> HashAlgorithmW h -> SigBuilder Hashed V4Sig algo
sigBuilderInitTyped OpenPGPRFCW rfc
_ SigType
st HashAlgorithmW h
hashW =
    forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigType -> HashAlgorithm -> SigBuilder Hashed V4Sig algo
sigBuilderInit @algo SigType
st (HashAlgorithmW h -> HashAlgorithm
forall (h :: HashAlgorithm). HashAlgorithmW h -> HashAlgorithm
demoteHashAlgorithmW HashAlgorithmW h
hashW)

{- | Initialize a v4 builder from runtime RFC/hash inputs with policy validation
and witness promotion at the API boundary.
-}
sigBuilderInitRuntime
    :: forall algo
     . KnownPubKeyAlgorithm algo
    => OpenPGPRFC
    -> SigType
    -> HashAlgorithm
    -> Either String (SigBuilder Hashed V4Sig algo)
sigBuilderInitRuntime :: forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
OpenPGPRFC
-> SigType
-> HashAlgorithm
-> Either String (SigBuilder Hashed V4Sig algo)
sigBuilderInitRuntime OpenPGPRFC
rfc SigType
st HashAlgorithm
ha =
    OpenPGPRFC
-> HashAlgorithm
-> (forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
    HashAlgoAllowedFor rfc h =>
    OpenPGPRFCW rfc
    -> HashAlgorithmW h -> SigBuilder Hashed V4Sig algo)
-> Either String (SigBuilder Hashed V4Sig algo)
forall a.
OpenPGPRFC
-> HashAlgorithm
-> (forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
    HashAlgoAllowedFor rfc h =>
    OpenPGPRFCW rfc -> HashAlgorithmW h -> a)
-> Either String a
withGenerationHashWitness
        OpenPGPRFC
rfc
        HashAlgorithm
ha
        (\OpenPGPRFCW rfc
rfcW HashAlgorithmW h
hashW -> forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(HashAlgoAllowedFor rfc h, KnownPubKeyAlgorithm algo) =>
OpenPGPRFCW rfc
-> SigType -> HashAlgorithmW h -> SigBuilder Hashed V4Sig algo
sigBuilderInitTyped @algo OpenPGPRFCW rfc
rfcW SigType
st HashAlgorithmW h
hashW)

-- | Initialize a builder for a v6 signature
sigBuilderInitV6
    :: forall algo
     . KnownPubKeyAlgorithm algo
    => SigType
    -> HashAlgorithm
    -> SignatureSalt
    -> SigBuilder Hashed V6Sig algo
sigBuilderInitV6 :: forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigType
-> HashAlgorithm -> SignatureSalt -> SigBuilder Hashed V6Sig algo
sigBuilderInitV6 SigType
st HashAlgorithm
ha SignatureSalt
salt =
    SigBuilder
        { sbSigType :: SigType
sbSigType = SigType
st
        , sbHashAlgo :: HashAlgorithm
sbHashAlgo = HashAlgorithm
ha
        , sbHashedSubs :: [SigSubPacket]
sbHashedSubs = []
        , sbUnhashedSubs :: [SigSubPacket]
sbUnhashedSubs = []
        , sbSalt :: BuilderSalt V6Sig
sbSalt = SignatureSalt
BuilderSalt V6Sig
salt
        , sbTextNormMode :: TextNormalizationMode
sbTextNormMode = TextNormalizationMode
CleartextCompat
        }

-- | Initialize a builder for a v6 signature with compile-time RFC/hash policy enforcement.
sigBuilderInitV6Typed
    :: forall algo rfc h
     . (HashAlgoAllowedFor rfc h, KnownPubKeyAlgorithm algo)
    => OpenPGPRFCW rfc
    -> SigType
    -> HashAlgorithmW h
    -> SignatureSalt
    -> SigBuilder Hashed V6Sig algo
sigBuilderInitV6Typed :: forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(HashAlgoAllowedFor rfc h, KnownPubKeyAlgorithm algo) =>
OpenPGPRFCW rfc
-> SigType
-> HashAlgorithmW h
-> SignatureSalt
-> SigBuilder Hashed V6Sig algo
sigBuilderInitV6Typed OpenPGPRFCW rfc
_ SigType
st HashAlgorithmW h
hashW SignatureSalt
salt =
    forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigType
-> HashAlgorithm -> SignatureSalt -> SigBuilder Hashed V6Sig algo
sigBuilderInitV6 @algo SigType
st (HashAlgorithmW h -> HashAlgorithm
forall (h :: HashAlgorithm). HashAlgorithmW h -> HashAlgorithm
demoteHashAlgorithmW HashAlgorithmW h
hashW) SignatureSalt
salt

{- | Initialize a v6 builder from runtime RFC/hash inputs with policy validation
and witness promotion at the API boundary.
-}
sigBuilderInitV6Runtime
    :: forall algo
     . KnownPubKeyAlgorithm algo
    => OpenPGPRFC
    -> SigType
    -> HashAlgorithm
    -> SignatureSalt
    -> Either String (SigBuilder Hashed V6Sig algo)
sigBuilderInitV6Runtime :: forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
OpenPGPRFC
-> SigType
-> HashAlgorithm
-> SignatureSalt
-> Either String (SigBuilder Hashed V6Sig algo)
sigBuilderInitV6Runtime OpenPGPRFC
rfc SigType
st HashAlgorithm
ha SignatureSalt
salt =
    OpenPGPRFC
-> HashAlgorithm
-> (forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
    HashAlgoAllowedFor rfc h =>
    OpenPGPRFCW rfc
    -> HashAlgorithmW h -> SigBuilder Hashed V6Sig algo)
-> Either String (SigBuilder Hashed V6Sig algo)
forall a.
OpenPGPRFC
-> HashAlgorithm
-> (forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
    HashAlgoAllowedFor rfc h =>
    OpenPGPRFCW rfc -> HashAlgorithmW h -> a)
-> Either String a
withGenerationHashWitness
        OpenPGPRFC
rfc
        HashAlgorithm
ha
        (\OpenPGPRFCW rfc
rfcW HashAlgorithmW h
hashW -> forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(HashAlgoAllowedFor rfc h, KnownPubKeyAlgorithm algo) =>
OpenPGPRFCW rfc
-> SigType
-> HashAlgorithmW h
-> SignatureSalt
-> SigBuilder Hashed V6Sig algo
sigBuilderInitV6Typed @algo OpenPGPRFCW rfc
rfcW SigType
st HashAlgorithmW h
hashW SignatureSalt
salt)

withGenerationHashWitness
    :: OpenPGPRFC
    -> HashAlgorithm
    -> ( forall rfc h
          . HashAlgoAllowedFor rfc h
         => OpenPGPRFCW rfc -> HashAlgorithmW h -> a
       )
    -> Either String a
withGenerationHashWitness :: forall a.
OpenPGPRFC
-> HashAlgorithm
-> (forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
    HashAlgoAllowedFor rfc h =>
    OpenPGPRFCW rfc -> HashAlgorithmW h -> a)
-> Either String a
withGenerationHashWitness OpenPGPRFC
rfc HashAlgorithm
ha forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk
    | HashAlgorithm
ha
        HashAlgorithm -> [HashAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` GenerationDeprecationPolicy -> [HashAlgorithm]
deprecatedHashAlgorithms
            (OpenPGPPolicy -> GenerationDeprecationPolicy
policyGenerationDeprecations (OpenPGPRFC -> OpenPGPPolicy
policyForRFC OpenPGPRFC
rfc)) =
        String -> Either String a
forall a b. a -> Either a b
Left (OpenPGPRFC -> HashAlgorithm -> String
hashPolicyDisallowedMessage OpenPGPRFC
rfc HashAlgorithm
ha)
    | Bool
otherwise =
        case HashAlgorithm -> Maybe SomeHashAlgorithmW
promoteHashAlgorithm HashAlgorithm
ha of
            Maybe SomeHashAlgorithmW
Nothing ->
                String -> Either String a
forall a b. a -> Either a b
Left (HashAlgorithm -> String
hashNotTypedBuilderMessage HashAlgorithm
ha)
            Just (SomeHashAlgorithmW HashAlgorithmW h
hashW) ->
                case OpenPGPRFC -> SomeOpenPGPRFCW
promoteOpenPGPRFC OpenPGPRFC
rfc of
                    SomeOpenPGPRFCW OpenPGPRFCW rfc
RFC2440W ->
                        a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$
                            case HashAlgorithmW h
hashW of
                                HashAlgorithmW h
DeprecatedMD5W -> OpenPGPRFCW 'RFC2440 -> HashAlgorithmW 'DeprecatedMD5 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC2440
RFC2440W HashAlgorithmW 'DeprecatedMD5
DeprecatedMD5W
                                HashAlgorithmW h
SHA1W -> OpenPGPRFCW 'RFC2440 -> HashAlgorithmW 'SHA1 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC2440
RFC2440W HashAlgorithmW 'SHA1
SHA1W
                                HashAlgorithmW h
RIPEMD160W -> OpenPGPRFCW 'RFC2440 -> HashAlgorithmW 'RIPEMD160 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC2440
RFC2440W HashAlgorithmW 'RIPEMD160
RIPEMD160W
                                HashAlgorithmW h
SHA256W -> OpenPGPRFCW 'RFC2440 -> HashAlgorithmW 'SHA256 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC2440
RFC2440W HashAlgorithmW 'SHA256
SHA256W
                                HashAlgorithmW h
SHA384W -> OpenPGPRFCW 'RFC2440 -> HashAlgorithmW 'SHA384 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC2440
RFC2440W HashAlgorithmW 'SHA384
SHA384W
                                HashAlgorithmW h
SHA512W -> OpenPGPRFCW 'RFC2440 -> HashAlgorithmW 'SHA512 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC2440
RFC2440W HashAlgorithmW 'SHA512
SHA512W
                                HashAlgorithmW h
SHA224W -> OpenPGPRFCW 'RFC2440 -> HashAlgorithmW 'SHA224 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC2440
RFC2440W HashAlgorithmW 'SHA224
SHA224W
                                HashAlgorithmW h
SHA3_256W -> OpenPGPRFCW 'RFC2440 -> HashAlgorithmW 'SHA3_256 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC2440
RFC2440W HashAlgorithmW 'SHA3_256
SHA3_256W
                                HashAlgorithmW h
SHA3_512W -> OpenPGPRFCW 'RFC2440 -> HashAlgorithmW 'SHA3_512 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC2440
RFC2440W HashAlgorithmW 'SHA3_512
SHA3_512W
                    SomeOpenPGPRFCW OpenPGPRFCW rfc
RFC4880W ->
                        case HashAlgorithmW h
hashW of
                            HashAlgorithmW h
SHA1W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC4880 -> HashAlgorithmW 'SHA1 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC4880
RFC4880W HashAlgorithmW 'SHA1
SHA1W)
                            HashAlgorithmW h
RIPEMD160W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC4880 -> HashAlgorithmW 'RIPEMD160 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC4880
RFC4880W HashAlgorithmW 'RIPEMD160
RIPEMD160W)
                            HashAlgorithmW h
SHA256W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC4880 -> HashAlgorithmW 'SHA256 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC4880
RFC4880W HashAlgorithmW 'SHA256
SHA256W)
                            HashAlgorithmW h
SHA384W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC4880 -> HashAlgorithmW 'SHA384 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC4880
RFC4880W HashAlgorithmW 'SHA384
SHA384W)
                            HashAlgorithmW h
SHA512W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC4880 -> HashAlgorithmW 'SHA512 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC4880
RFC4880W HashAlgorithmW 'SHA512
SHA512W)
                            HashAlgorithmW h
SHA224W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC4880 -> HashAlgorithmW 'SHA224 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC4880
RFC4880W HashAlgorithmW 'SHA224
SHA224W)
                            HashAlgorithmW h
SHA3_256W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC4880 -> HashAlgorithmW 'SHA3_256 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC4880
RFC4880W HashAlgorithmW 'SHA3_256
SHA3_256W)
                            HashAlgorithmW h
SHA3_512W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC4880 -> HashAlgorithmW 'SHA3_512 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC4880
RFC4880W HashAlgorithmW 'SHA3_512
SHA3_512W)
                            HashAlgorithmW h
DeprecatedMD5W ->
                                String -> Either String a
forall a b. a -> Either a b
Left (OpenPGPRFC -> HashAlgorithm -> String
hashPolicyDisallowedMessage OpenPGPRFC
rfc HashAlgorithm
ha)
                    SomeOpenPGPRFCW OpenPGPRFCW rfc
RFC9580W ->
                        case HashAlgorithmW h
hashW of
                            HashAlgorithmW h
SHA256W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC9580 -> HashAlgorithmW 'SHA256 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC9580
RFC9580W HashAlgorithmW 'SHA256
SHA256W)
                            HashAlgorithmW h
SHA384W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC9580 -> HashAlgorithmW 'SHA384 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC9580
RFC9580W HashAlgorithmW 'SHA384
SHA384W)
                            HashAlgorithmW h
SHA512W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC9580 -> HashAlgorithmW 'SHA512 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC9580
RFC9580W HashAlgorithmW 'SHA512
SHA512W)
                            HashAlgorithmW h
SHA224W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC9580 -> HashAlgorithmW 'SHA224 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC9580
RFC9580W HashAlgorithmW 'SHA224
SHA224W)
                            HashAlgorithmW h
SHA3_256W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC9580 -> HashAlgorithmW 'SHA3_256 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC9580
RFC9580W HashAlgorithmW 'SHA3_256
SHA3_256W)
                            HashAlgorithmW h
SHA3_512W -> a -> Either String a
forall a b. b -> Either a b
Right (OpenPGPRFCW 'RFC9580 -> HashAlgorithmW 'SHA3_512 -> a
forall (rfc :: OpenPGPRFC) (h :: HashAlgorithm).
HashAlgoAllowedFor rfc h =>
OpenPGPRFCW rfc -> HashAlgorithmW h -> a
mk OpenPGPRFCW 'RFC9580
RFC9580W HashAlgorithmW 'SHA3_512
SHA3_512W)
                            HashAlgorithmW h
DeprecatedMD5W ->
                                String -> Either String a
forall a b. a -> Either a b
Left (OpenPGPRFC -> HashAlgorithm -> String
hashPolicyDisallowedMessage OpenPGPRFC
rfc HashAlgorithm
ha)
                            HashAlgorithmW h
SHA1W ->
                                String -> Either String a
forall a b. a -> Either a b
Left (OpenPGPRFC -> HashAlgorithm -> String
hashPolicyDisallowedMessage OpenPGPRFC
rfc HashAlgorithm
ha)
                            HashAlgorithmW h
RIPEMD160W ->
                                String -> Either String a
forall a b. a -> Either a b
Left (OpenPGPRFC -> HashAlgorithm -> String
hashPolicyDisallowedMessage OpenPGPRFC
rfc HashAlgorithm
ha)

hashPolicyDisallowedMessage
    :: OpenPGPRFC -> HashAlgorithm -> String
hashPolicyDisallowedMessage :: OpenPGPRFC -> HashAlgorithm -> String
hashPolicyDisallowedMessage OpenPGPRFC
rfc HashAlgorithm
ha =
    String
"signature hash algorithm disallowed by RFC policy ("
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ OpenPGPRFC -> String
forall a. Show a => a -> String
show OpenPGPRFC
rfc
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"): "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha

hashNotTypedBuilderMessage :: HashAlgorithm -> String
hashNotTypedBuilderMessage :: HashAlgorithm -> String
hashNotTypedBuilderMessage HashAlgorithm
ha =
    String
"signature hash algorithm is not supported by typed builder API: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha

{- | Add hashed subpackets to a builder
Must be called before addUnhashedSubs
-}
addHashedSubs
    :: HashedSubpackets v
    -> SigBuilder Hashed v algo
    -> SigBuilder Unhashed v algo
addHashedSubs :: forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs (SubpacketList [SigSubPacket]
sps) SigBuilder Hashed v algo
builder = SigBuilder Hashed v algo
builder {sbHashedSubs = sps}

{- | Add unhashed subpackets to a builder
Must be called after addHashedSubs
-}
addUnhashedSubs
    :: UnhashedSubpackets v
    -> SigBuilder Unhashed v algo
    -> SigBuilder Unhashed v algo
addUnhashedSubs :: forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs (SubpacketList [SigSubPacket]
sps) SigBuilder Unhashed v algo
builder = SigBuilder Unhashed v algo
builder {sbUnhashedSubs = sps}

-- | Build a v4 signature from a completed builder and MPI values
buildSigV4
    :: KnownPubKeyAlgorithm algo
    => SigBuilder Unhashed V4Sig algo
    -> Word16
    -> NonEmpty MPI
    -> SignaturePayload
buildSigV4 :: forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigBuilder Unhashed V4Sig algo
-> Word16 -> NonEmpty MPI -> SignaturePayload
buildSigV4 SigBuilder Unhashed V4Sig algo
builder Word16
hashLeft NonEmpty MPI
mpis =
    SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4
        (SigBuilder Unhashed V4Sig algo -> SigType
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> SigType
sbSigType SigBuilder Unhashed V4Sig algo
builder)
        (SigBuilder Unhashed V4Sig algo -> PubKeyAlgorithm
forall hashedness v (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigBuilder hashedness v algo -> PubKeyAlgorithm
sbPubKeyAlgo SigBuilder Unhashed V4Sig algo
builder)
        (SigBuilder Unhashed V4Sig algo -> HashAlgorithm
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> HashAlgorithm
sbHashAlgo SigBuilder Unhashed V4Sig algo
builder)
        (SigBuilder Unhashed V4Sig algo -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbHashedSubs SigBuilder Unhashed V4Sig algo
builder)
        (SigBuilder Unhashed V4Sig algo -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbUnhashedSubs SigBuilder Unhashed V4Sig algo
builder)
        Word16
hashLeft
        NonEmpty MPI
mpis

-- | Build a v6 signature from a completed builder and MPI values
buildSigV6
    :: KnownPubKeyAlgorithm algo
    => SigBuilder Unhashed V6Sig algo
    -> Word16
    -> NonEmpty MPI
    -> SignaturePayload
buildSigV6 :: forall (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigBuilder Unhashed V6Sig algo
-> Word16 -> NonEmpty MPI -> SignaturePayload
buildSigV6 SigBuilder Unhashed V6Sig algo
builder Word16
hashLeft NonEmpty MPI
mpis =
    SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV6
        (SigBuilder Unhashed V6Sig algo -> SigType
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> SigType
sbSigType SigBuilder Unhashed V6Sig algo
builder)
        (SigBuilder Unhashed V6Sig algo -> PubKeyAlgorithm
forall hashedness v (algo :: PubKeyAlgorithm).
KnownPubKeyAlgorithm algo =>
SigBuilder hashedness v algo -> PubKeyAlgorithm
sbPubKeyAlgo SigBuilder Unhashed V6Sig algo
builder)
        (SigBuilder Unhashed V6Sig algo -> HashAlgorithm
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> HashAlgorithm
sbHashAlgo SigBuilder Unhashed V6Sig algo
builder)
        (SigBuilder Unhashed V6Sig algo -> BuilderSalt V6Sig
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> BuilderSalt v
sbSalt SigBuilder Unhashed V6Sig algo
builder)
        (SigBuilder Unhashed V6Sig algo -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbHashedSubs SigBuilder Unhashed V6Sig algo
builder)
        (SigBuilder Unhashed V6Sig algo -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbUnhashedSubs SigBuilder Unhashed V6Sig algo
builder)
        Word16
hashLeft
        NonEmpty MPI
mpis

{- | Convert a list to a hashed subpacket list
Used to bridge between list-based and phantom-typed APIs
-}
listToHashedSubs :: [SigSubPacket] -> HashedSubpackets v
listToHashedSubs :: forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
sps = [SigSubPacket] -> SubpacketList Hashed v
forall hashedness version.
[SigSubPacket] -> SubpacketList hashedness version
SubpacketList [SigSubPacket]
sps

{- | Convert a list to an unhashed subpacket list
Used to bridge between list-based and phantom-typed APIs
-}
listToUnhashedSubs :: [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs :: forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
sps = [SigSubPacket] -> SubpacketList Unhashed v
forall hashedness version.
[SigSubPacket] -> SubpacketList hashedness version
SubpacketList [SigSubPacket]
sps