-- 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 Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty)
import Data.Proxy (Proxy(..))
import Data.Word (Word16)

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

-- | 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"

-- | 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 'EdDSA where
  demotePubKeyAlgorithmT :: Proxy 'EdDSA -> PubKeyAlgorithm
demotePubKeyAlgorithmT Proxy 'EdDSA
_ = PubKeyAlgorithm
EdDSA

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
  = RFC9580Strict
    -- ^ CRLF normalization only; no trailing-whitespace stripping.
    --   Correct for inline type 0x01 document signatures.
  | CleartextCompat
    -- ^ CRLF normalization *plus* per-line trailing-whitespace stripping.
    --   Required by the Cleartext Signature Framework (RFC 9580 §7).
  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
   . (KnownPubKeyAlgorithm algo, HashAlgoAllowedFor rfc h)
  => OpenPGPRFCW rfc
  -> SigType
  -> HashAlgorithmW h
  -> SigBuilder Hashed V4Sig algo
sigBuilderInitTyped :: forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(KnownPubKeyAlgorithm algo, HashAlgoAllowedFor rfc h) =>
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).
(KnownPubKeyAlgorithm algo, HashAlgoAllowedFor rfc h) =>
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
   . (KnownPubKeyAlgorithm algo, HashAlgoAllowedFor rfc h)
  => OpenPGPRFCW rfc
  -> SigType
  -> HashAlgorithmW h
  -> SignatureSalt
  -> SigBuilder Hashed V6Sig algo
sigBuilderInitV6Typed :: forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(KnownPubKeyAlgorithm algo, HashAlgoAllowedFor rfc h) =>
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).
(KnownPubKeyAlgorithm algo, HashAlgoAllowedFor rfc h) =>
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