-- Signatures.hs: OpenPGP (RFC9580) signature verification
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

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

module Codec.Encryption.OpenPGP.Signatures
  ( SignError(..)
  , renderSignError
  , CertificationState(..)
  , certificationStateAt
  , VerificationError(..)
  , renderVerificationError
  , verifySigWith
  , verifyAgainstKeyring
  , verifyAgainstKeys
  , verifyTKWith
  , verifyUnknownTKWith
  , signCertificationWithRSA
  , signDirectKeyWithRSA
  , signKeyRevocationWithRSA
  , signSubkeyRevocationWithRSA
  , signCertRevocationWithRSA
  , signUserIDwithRSA
  , crossSignSubkeyWithRSA
  , signDataWithEd25519
  , signDataWithEd25519V6
  , signDataWithEd448
  , signDataWithEd448V6
  , signDataWithRSA
  , signDataWithRSAV6
  -- * Builder-based API (Phase 2)
  , signDataWithRSABuilder
  , signDataWithRSAV6Builder
  , signDataWithEd25519Builder
  , signDataWithEd25519V6Builder
  , signDataWithEd448Builder
  , signDataWithEd448V6Builder
  , signDataWithAlgorithmicBuilder
  -- * Text normalization mode
  , TextNormalizationMode(..)
  ) where

import Control.Applicative ((<|>))
import Control.Error.Util (hush)
import Control.Lens ((&), (^.), _1)
import Control.Monad (liftM2, when)

import Crypto.Error (eitherCryptoError)
import Crypto.Hash (hashWith)
import qualified Crypto.Hash.Algorithms as CHA
import Crypto.Number.Serialize (i2osp, os2ip)
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.PKCS15 as P15
import qualified Crypto.PubKey.RSA.Types as RSATypes

import Data.Bifunctor (first)
import Data.Binary.Put (runPut)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Either (isRight, lefts, rights)
import Data.Function (on)
import Data.IxSet.Typed ((@=))
import qualified Data.IxSet.Typed as IxSet
import qualified Data.Set as Set
import Data.List (find, intercalate, nub)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust, mapMaybe)
import Data.Text (Text)
import Data.Time.Clock (UTCTime(..), addUTCTime, diffUTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Word (Word16, Word8)
import GHC.TypeLits (TypeError, ErrorMessage(..))

import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)
import Codec.Encryption.OpenPGP.Expirations
  ( isPKTimeValidWithSelfSignatures
  , keyStateAt
  , keyStateValid
  )
import Codec.Encryption.OpenPGP.Internal
  ( PktStreamContext(..)
  , emptyPSC
  , issuer
  , issuerFP
  )
import Codec.Encryption.OpenPGP.Ontology
  ( isCertRevocationSig
  , isRevocationKeySSP
  , isRevokerP
  , isSubkeyBindingSig
  , isSubkeyRevocation
  )
import Codec.Encryption.OpenPGP.SignatureQualities
  ( sigCT
  , sigHA
  , sigPKA
  , sigType
  , signatureHashedSubpacketsKnown
  , signatureSubpacketListsKnown
  )

import Codec.Encryption.OpenPGP.SerializeForSigs
  ( payloadForSig
  , putKeyforSigning
  , putPartialSigforSigning
  , putSigTrailer
  , putUforSigning
  )
import Codec.Encryption.OpenPGP.Policy (signatureV6SaltSizeForHashAlgorithm)
import Codec.Encryption.OpenPGP.Subpackets
  ( SigBuilder
  , TextNormalizationMode(..)
  , sbSigType
  , sbHashAlgo
  , sbHashedSubs
  , sbUnhashedSubs
  , sbSalt
  , sbTextNormMode
  , PrivateKeyFor
  )
import qualified Codec.Encryption.OpenPGP.Subpackets as SP
import Codec.Encryption.OpenPGP.Types
import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA
import Data.Conduit.OpenPGP.Keyring.Instances ()

data VerificationError
  = IssuerSubpacketMismatch
  | IssuerSubpacketUncheckable String
  | IssuerKeyIdProhibitedInV6Signature
  | IssuerFingerprintSubpacketMismatch
  | UnsupportedCriticalSubpacket SigType
  | UnknownCriticalPacketInStream Word8
  | BrokenCriticalPacketInStream Word8 String
  | ExternalVerificationError String
  | NonSignaturePacket
  | UnexpectedSignaturePayloadShape
  | MissingHashAlgorithm
  | HashComputationFailed String
  | UnexpectedKeyVersion
  | SignatureHashUnsupportedByAlgorithm HashAlgorithm PubKeyAlgorithm
  | KeyRevoked
  | SigningKeyUnavailableAtSignatureTime
  | MissingIssuer
  | SigningKeyNotFound (Maybe EightOctetKeyId) (Maybe Fingerprint)
  | MultipleVerificationSuccesses Int
  | UnsupportedKeyType PubKeyAlgorithm
  | SignatureMismatch PubKeyAlgorithm Fingerprint
  | SignatureShapeMismatch PubKeyAlgorithm
  | SignatureEncodingInvalid PubKeyAlgorithm String
  | SignaturePolicyHashUnsupported HashAlgorithm
  | SignaturePolicyPKAMismatch PubKeyAlgorithm PubKeyAlgorithm
  | SignatureExpired
  | CandidateKeyFailures [VerificationError]
  | InvalidSubkeyBackSignature VerificationError
    -- ^ An embedded primary-key back-signature (type 0x19) in a subkey
    -- binding signature failed to verify.
  deriving (VerificationError -> VerificationError -> Bool
(VerificationError -> VerificationError -> Bool)
-> (VerificationError -> VerificationError -> Bool)
-> Eq VerificationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationError -> VerificationError -> Bool
== :: VerificationError -> VerificationError -> Bool
$c/= :: VerificationError -> VerificationError -> Bool
/= :: VerificationError -> VerificationError -> Bool
Eq, Int -> VerificationError -> ShowS
[VerificationError] -> ShowS
VerificationError -> String
(Int -> VerificationError -> ShowS)
-> (VerificationError -> String)
-> ([VerificationError] -> ShowS)
-> Show VerificationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationError -> ShowS
showsPrec :: Int -> VerificationError -> ShowS
$cshow :: VerificationError -> String
show :: VerificationError -> String
$cshowList :: [VerificationError] -> ShowS
showList :: [VerificationError] -> ShowS
Show)

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

renderVerificationError :: VerificationError -> String
renderVerificationError :: VerificationError -> String
renderVerificationError VerificationError
IssuerSubpacketMismatch =
  String
"verification failed: issuer subpacket does not match the actual signer"
renderVerificationError (IssuerSubpacketUncheckable String
err) =
  String
"verification failed: issuer subpacket cannot be checked (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
renderVerificationError VerificationError
IssuerKeyIdProhibitedInV6Signature =
  String
"verification failed: Issuer Key ID subpacket is prohibited in v6 signatures"
renderVerificationError VerificationError
IssuerFingerprintSubpacketMismatch =
  String
"verification failed: issuer fingerprint subpacket does not match the actual signer"
renderVerificationError (UnsupportedCriticalSubpacket SigType
sigType) =
  String
"verification failed: unsupported critical hashed subpacket in " String -> ShowS
forall a. [a] -> [a] -> [a]
++
  SigType -> String
forall a. Show a => a -> String
show SigType
sigType String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" signature"
renderVerificationError (UnknownCriticalPacketInStream Word8
t) =
  String
"verification failed: unknown critical packet type in packet sequence (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
renderVerificationError (BrokenCriticalPacketInStream Word8
t String
err) =
  String
"verification failed: broken critical packet type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
renderVerificationError (ExternalVerificationError String
err) = String
err
renderVerificationError VerificationError
NonSignaturePacket =
  String
"verification failed: non-signature packet encountered where signature was expected"
renderVerificationError VerificationError
UnexpectedSignaturePayloadShape =
  String
"verification failed: unexpected signature payload shape"
renderVerificationError VerificationError
MissingHashAlgorithm =
  String
"verification failed: signature payload is missing hash algorithm"
renderVerificationError (HashComputationFailed String
err) =
  String
"verification failed: hash computation error (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
renderVerificationError VerificationError
UnexpectedKeyVersion =
  String
"verification failed: signing key has unexpected version (only v4 and v6 are supported)"
renderVerificationError (SignatureHashUnsupportedByAlgorithm HashAlgorithm
ha PubKeyAlgorithm
pka) =
  String
"verification failed: hash algorithm " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha String -> ShowS
forall a. [a] -> [a] -> [a]
++
  String
" is not supported by " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PubKeyAlgorithm -> String
forall a. Show a => a -> String
show PubKeyAlgorithm
pka String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" signing backend"
renderVerificationError VerificationError
KeyRevoked =
  String
"verification failed: signing key is revoked"
renderVerificationError VerificationError
SigningKeyUnavailableAtSignatureTime =
  String
"verification failed: signing key was not valid at the signature creation time"
renderVerificationError VerificationError
MissingIssuer =
  String
"verification failed: signature is missing issuer information"
renderVerificationError (SigningKeyNotFound Maybe EightOctetKeyId
meoki Maybe Fingerprint
mfp) =
  String
"verification failed: signing key not found in keyring" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe EightOctetKeyId -> Maybe Fingerprint -> String
issuerContext Maybe EightOctetKeyId
meoki Maybe Fingerprint
mfp
renderVerificationError (MultipleVerificationSuccesses Int
n) =
  String
"verification failed: multiple successful key matches (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
renderVerificationError (UnsupportedKeyType PubKeyAlgorithm
pka) =
  String
"verification failed: unsupported public key algorithm for verification (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PubKeyAlgorithm -> String
forall a. Show a => a -> String
show PubKeyAlgorithm
pka String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
renderVerificationError (SignatureMismatch PubKeyAlgorithm
pka Fingerprint
fpr) =
  String
"verification failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PubKeyAlgorithm -> String
forall a. Show a => a -> String
show PubKeyAlgorithm
pka String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" signature mismatch (signer " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Fingerprint -> String
forall a. Show a => a -> String
show Fingerprint
fpr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
renderVerificationError (SignatureShapeMismatch PubKeyAlgorithm
pka) =
  String
"verification failed: malformed " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PubKeyAlgorithm -> String
forall a. Show a => a -> String
show PubKeyAlgorithm
pka String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" signature encoding"
renderVerificationError (SignatureEncodingInvalid PubKeyAlgorithm
pka String
err) =
  String
"verification failed: invalid " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PubKeyAlgorithm -> String
forall a. Show a => a -> String
show PubKeyAlgorithm
pka String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" key/signature encoding (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
renderVerificationError (SignaturePolicyHashUnsupported HashAlgorithm
ha) =
  String
"verification failed: unsupported signature hash policy (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
renderVerificationError (SignaturePolicyPKAMismatch PubKeyAlgorithm
sigPka PubKeyAlgorithm
keyPka) =
  String
"verification failed: signature public-key algorithm " String -> ShowS
forall a. [a] -> [a] -> [a]
++
  PubKeyAlgorithm -> String
forall a. Show a => a -> String
show PubKeyAlgorithm
sigPka String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not match key algorithm " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PubKeyAlgorithm -> String
forall a. Show a => a -> String
show PubKeyAlgorithm
keyPka
renderVerificationError VerificationError
SignatureExpired =
  String
"verification failed: signature expired"
renderVerificationError (CandidateKeyFailures [VerificationError]
errs) =
  String
"verification failed: no candidate key validated the signature (" String -> ShowS
forall a. [a] -> [a] -> [a]
++
  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"; " ([String] -> [String]
forall a. Eq a => [a] -> [a]
nub ((VerificationError -> String) -> [VerificationError] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map VerificationError -> String
renderVerificationError [VerificationError]
errs)) String -> ShowS
forall a. [a] -> [a] -> [a]
++
  String
")"
renderVerificationError (InvalidSubkeyBackSignature VerificationError
err) =
  String
"verification failed: embedded primary-key back-signature verification failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
  VerificationError -> String
renderVerificationError VerificationError
err

issuerContext ::
     Maybe EightOctetKeyId -> Maybe Fingerprint -> String
issuerContext :: Maybe EightOctetKeyId -> Maybe Fingerprint -> String
issuerContext Maybe EightOctetKeyId
meoki Maybe Fingerprint
mfp =
  case (Maybe EightOctetKeyId
meoki, Maybe Fingerprint
mfp) of
    (Maybe EightOctetKeyId
Nothing, Maybe Fingerprint
Nothing) -> String
""
    (Maybe EightOctetKeyId, Maybe Fingerprint)
_ ->
      String
" (issuer-keyid=" String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
-> (EightOctetKeyId -> String) -> Maybe EightOctetKeyId -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"unknown" EightOctetKeyId -> String
forall a. Show a => a -> String
show Maybe EightOctetKeyId
meoki String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
", issuer-fingerprint=" String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String -> (Fingerprint -> String) -> Maybe Fingerprint -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"unknown" Fingerprint -> String
forall a. Show a => a -> String
show Maybe Fingerprint
mfp String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
")"

verificationError :: VerificationError -> Either VerificationError a
verificationError :: forall a. VerificationError -> Either VerificationError a
verificationError = VerificationError -> Either VerificationError a
forall a b. a -> Either a b
Left

renderVerificationResult :: Either VerificationError a -> Either String a
renderVerificationResult :: forall a. Either VerificationError a -> Either String a
renderVerificationResult = (VerificationError -> String)
-> Either VerificationError a -> Either String a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first VerificationError -> String
renderVerificationError

data SignError
  = SignBackendError String
  | SignUnsupportedCertificationType SigType
  | SignUnsupportedKeySignatureType SigType
  | SignV6SaltSizeMismatch HashAlgorithm Word8 Int
  | SignProducedWrongLength String Int Int
  deriving (SignError -> SignError -> Bool
(SignError -> SignError -> Bool)
-> (SignError -> SignError -> Bool) -> Eq SignError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignError -> SignError -> Bool
== :: SignError -> SignError -> Bool
$c/= :: SignError -> SignError -> Bool
/= :: SignError -> SignError -> Bool
Eq, Int -> SignError -> ShowS
[SignError] -> ShowS
SignError -> String
(Int -> SignError -> ShowS)
-> (SignError -> String)
-> ([SignError] -> ShowS)
-> Show SignError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignError -> ShowS
showsPrec :: Int -> SignError -> ShowS
$cshow :: SignError -> String
show :: SignError -> String
$cshowList :: [SignError] -> ShowS
showList :: [SignError] -> ShowS
Show)

renderSignError :: SignError -> String
renderSignError :: SignError -> String
renderSignError (SignBackendError String
err) =
  String
"signature backend error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
renderSignError (SignUnsupportedCertificationType SigType
st) =
  String
"unsupported certification signature type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
  SigType -> String
forall a. Show a => a -> String
show SigType
st String -> ShowS
forall a. [a] -> [a] -> [a]
++
  String
" (expected one of GenericCert/PersonaCert/CasualCert/PositiveCert)"
renderSignError (SignUnsupportedKeySignatureType SigType
st) =
  String
"unsupported key signature type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
  SigType -> String
forall a. Show a => a -> String
show SigType
st String -> ShowS
forall a. [a] -> [a] -> [a]
++
  String
" (expected SignatureDirectlyOnAKey or KeyRevocationSig)"
renderSignError (SignV6SaltSizeMismatch HashAlgorithm
ha Word8
expected Int
actual) =
  String
"v6 signature salt size mismatch for " String -> ShowS
forall a. [a] -> [a] -> [a]
++
  HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha String -> ShowS
forall a. [a] -> [a] -> [a]
++
  String
": expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
expected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
actual
renderSignError (SignProducedWrongLength String
algo Int
expected Int
actual) =
  String
algo String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" produced a non-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
expected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-byte signature (got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
actual String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

data VerifiableSignatureV where
  VerifiableSignatureV4 :: SignaturePayloadV 'SigPayloadV4 -> VerifiableSignatureV
  VerifiableSignatureV6 :: SignaturePayloadV 'SigPayloadV6 -> VerifiableSignatureV

fromSignaturePayloadVerifiableSignatureV ::
     SignaturePayload -> Maybe VerifiableSignatureV
fromSignaturePayloadVerifiableSignatureV :: SignaturePayload -> Maybe VerifiableSignatureV
fromSignaturePayloadVerifiableSignatureV SignaturePayload
sigPayload =
  case SignaturePayload -> SomeSignaturePayload
toSomeSignaturePayload SignaturePayload
sigPayload of
    SomeSignaturePayload (payload :: SignaturePayloadV v
payload@SigPayloadV4Data {}) ->
      VerifiableSignatureV -> Maybe VerifiableSignatureV
forall a. a -> Maybe a
Just (SignaturePayloadV 'SigPayloadV4 -> VerifiableSignatureV
VerifiableSignatureV4 SignaturePayloadV v
SignaturePayloadV 'SigPayloadV4
payload)
    SomeSignaturePayload (payload :: SignaturePayloadV v
payload@SigPayloadV6Data {}) ->
      VerifiableSignatureV -> Maybe VerifiableSignatureV
forall a. a -> Maybe a
Just (SignaturePayloadV 'SigPayloadV6 -> VerifiableSignatureV
VerifiableSignatureV6 SignaturePayloadV v
SignaturePayloadV 'SigPayloadV6
payload)
    SomeSignaturePayload
_ -> Maybe VerifiableSignatureV
forall a. Maybe a
Nothing

isVerifiableSignaturePayload :: SignaturePayload -> Bool
isVerifiableSignaturePayload :: SignaturePayload -> Bool
isVerifiableSignaturePayload = Maybe VerifiableSignatureV -> Bool
forall a. Maybe a -> Bool
isJust (Maybe VerifiableSignatureV -> Bool)
-> (SignaturePayload -> Maybe VerifiableSignatureV)
-> SignaturePayload
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe VerifiableSignatureV
fromSignaturePayloadVerifiableSignatureV

toSignaturePayloadFromVerifiable :: VerifiableSignatureV -> SignaturePayload
toSignaturePayloadFromVerifiable :: VerifiableSignatureV -> SignaturePayload
toSignaturePayloadFromVerifiable (VerifiableSignatureV4 SignaturePayloadV 'SigPayloadV4
payload) =
  SignaturePayloadV 'SigPayloadV4 -> SignaturePayload
forall (v :: SignaturePayloadVersion).
SignaturePayloadV v -> SignaturePayload
toSignaturePayload SignaturePayloadV 'SigPayloadV4
payload
toSignaturePayloadFromVerifiable (VerifiableSignatureV6 SignaturePayloadV 'SigPayloadV6
payload) =
  SignaturePayloadV 'SigPayloadV6 -> SignaturePayload
forall (v :: SignaturePayloadVersion).
SignaturePayloadV v -> SignaturePayload
toSignaturePayload SignaturePayloadV 'SigPayloadV6
payload

fromPktEitherVerifiableSignatureV :: Pkt -> Either VerificationError VerifiableSignatureV
fromPktEitherVerifiableSignatureV :: Pkt -> Either VerificationError VerifiableSignatureV
fromPktEitherVerifiableSignatureV (SignaturePkt SignaturePayload
sigPayload) =
  case SignaturePayload -> Maybe VerifiableSignatureV
fromSignaturePayloadVerifiableSignatureV SignaturePayload
sigPayload of
    Just VerifiableSignatureV
verifiableSig -> VerifiableSignatureV
-> Either VerificationError VerifiableSignatureV
forall a b. b -> Either a b
Right VerifiableSignatureV
verifiableSig
    Maybe VerifiableSignatureV
Nothing ->
      VerificationError -> Either VerificationError VerifiableSignatureV
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
UnexpectedSignaturePayloadShape
fromPktEitherVerifiableSignatureV Pkt
_ =
  VerificationError -> Either VerificationError VerifiableSignatureV
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
NonSignaturePacket

signaturePKAAndMPIsFromClass ::
     SomeSignatureV
  -> Either VerificationError (PubKeyAlgorithm, NonEmpty MPI)
signaturePKAAndMPIsFromClass :: SomeSignatureV
-> Either VerificationError (PubKeyAlgorithm, NonEmpty MPI)
signaturePKAAndMPIsFromClass =
  ((PubKeyAlgorithm, Word16, NonEmpty MPI)
 -> (PubKeyAlgorithm, NonEmpty MPI))
-> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
-> Either VerificationError (PubKeyAlgorithm, NonEmpty MPI)
forall a b.
(a -> b)
-> Either VerificationError a -> Either VerificationError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PubKeyAlgorithm
pka, Word16
_, NonEmpty MPI
mpis) -> (PubKeyAlgorithm
pka, NonEmpty MPI
mpis)) (Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
 -> Either VerificationError (PubKeyAlgorithm, NonEmpty MPI))
-> (SomeSignatureV
    -> Either
         VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI))
-> SomeSignatureV
-> Either VerificationError (PubKeyAlgorithm, NonEmpty MPI)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeSignatureV
-> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
signatureVerificationMaterialFromClass

signatureLeft16FromClass :: SomeSignatureV -> Either VerificationError Word16
signatureLeft16FromClass :: SomeSignatureV -> Either VerificationError Word16
signatureLeft16FromClass =
  ((PubKeyAlgorithm, Word16, NonEmpty MPI) -> Word16)
-> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
-> Either VerificationError Word16
forall a b.
(a -> b)
-> Either VerificationError a -> Either VerificationError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PubKeyAlgorithm
_, Word16
l16, NonEmpty MPI
_) -> Word16
l16) (Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
 -> Either VerificationError Word16)
-> (SomeSignatureV
    -> Either
         VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI))
-> SomeSignatureV
-> Either VerificationError Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeSignatureV
-> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
signatureVerificationMaterialFromClass

signatureVerificationMaterialFromClass ::
     SomeSignatureV
  -> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
signatureVerificationMaterialFromClass :: SomeSignatureV
-> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
signatureVerificationMaterialFromClass (SomeSignatureV SignatureV v
typedSig) =
  case SignatureV v
typedSig of
    SignatureV3Packet (SigPayloadV3Data SigType
_ ThirtyTwoBitTimeStamp
_ EightOctetKeyId
_ PubKeyAlgorithm
pka HashAlgorithm
_ Word16
l16 NonEmpty MPI
mpis) ->
      (PubKeyAlgorithm, Word16, NonEmpty MPI)
-> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
forall a b. b -> Either a b
Right (PubKeyAlgorithm
pka, Word16
l16, NonEmpty MPI
mpis)
    SignatureV4Packet (SigPayloadV4Data SigType
_ PubKeyAlgorithm
pka HashAlgorithm
_ [SigSubPacket]
_ [SigSubPacket]
_ Word16
l16 NonEmpty MPI
mpis) ->
      (PubKeyAlgorithm, Word16, NonEmpty MPI)
-> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
forall a b. b -> Either a b
Right (PubKeyAlgorithm
pka, Word16
l16, NonEmpty MPI
mpis)
    SignatureV6Packet (SigPayloadV6Data SigType
_ PubKeyAlgorithm
pka HashAlgorithm
_ SignatureSalt
_ [SigSubPacket]
_ [SigSubPacket]
_ Word16
l16 NonEmpty MPI
mpis) ->
      (PubKeyAlgorithm, Word16, NonEmpty MPI)
-> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
forall a b. b -> Either a b
Right (PubKeyAlgorithm
pka, Word16
l16, NonEmpty MPI
mpis)
    SignatureV v
_ ->
      VerificationError
-> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
UnexpectedSignaturePayloadShape

verifySigWith ::
     (Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification)
  -> Pkt
  -> PktStreamContext
  -> Maybe UTCTime
  -> Either VerificationError Verification
verifySigWith :: (Pkt
 -> Maybe UTCTime
 -> ByteString
 -> Either VerificationError Verification)
-> Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either VerificationError Verification
verifySigWith Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
vf sig :: Pkt
sig@(SignaturePkt SignaturePayload
_) PktStreamContext
state Maybe UTCTime
mt =
  case Pkt -> Either VerificationError VerifiableSignatureV
fromPktEitherVerifiableSignatureV Pkt
sig of
    Right VerifiableSignatureV
verifiableSig ->
      let (SigType
st, [SigSubPacket]
hs, [SigSubPacket]
us, SomePKPayload
-> SigSubPacketPayload -> Either VerificationError Bool
checkSubpacket, [SigSubPacket] -> Either VerificationError ()
checkUnhashedSubpackets) =
            VerifiableSignatureV
-> (SigType, [SigSubPacket], [SigSubPacket],
    SomePKPayload
    -> SigSubPacketPayload -> Either VerificationError Bool,
    [SigSubPacket] -> Either VerificationError ())
verifiableSignatureVerificationInputs VerifiableSignatureV
verifiableSig
       in [SigSubPacket] -> Either VerificationError ()
checkUnhashedSubpackets [SigSubPacket]
us Either VerificationError ()
-> Either VerificationError Verification
-> Either VerificationError Verification
forall a b.
Either VerificationError a
-> Either VerificationError b -> Either VerificationError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
          (Pkt
 -> Maybe UTCTime
 -> ByteString
 -> Either VerificationError Verification)
-> Pkt
-> PktStreamContext
-> Maybe UTCTime
-> SigType
-> [SigSubPacket]
-> (SomePKPayload
    -> SigSubPacketPayload -> Either VerificationError Bool)
-> Either VerificationError Verification
verifyWithSubpacketChecks Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
vf Pkt
sig PktStreamContext
state Maybe UTCTime
mt SigType
st [SigSubPacket]
hs SomePKPayload
-> SigSubPacketPayload -> Either VerificationError Bool
checkSubpacket
    Left VerificationError
err ->
      VerificationError -> Either VerificationError Verification
forall a b. a -> Either a b
Left VerificationError
err
  where
    checkV4Subpacket :: SomePKPayload
-> SigSubPacketPayload -> Either VerificationError Bool
checkV4Subpacket SomePKPayload
signer i :: SigSubPacketPayload
i@Issuer {} = Either String EightOctetKeyId
-> SigSubPacketPayload -> Either VerificationError Bool
checkIssuerSubpacket (SomePKPayload -> Either String EightOctetKeyId
eightOctetKeyID SomePKPayload
signer) SigSubPacketPayload
i
    checkV4Subpacket SomePKPayload
signer i :: SigSubPacketPayload
i@IssuerFingerprint {} =
      IssuerFingerprintVersion
-> Fingerprint
-> SigSubPacketPayload
-> Either VerificationError Bool
checkIssuerFingerprintSubpacket IssuerFingerprintVersion
PKA.IssuerFingerprintV4 (SomePKPayload -> Fingerprint
fingerprint SomePKPayload
signer) SigSubPacketPayload
i
    checkV4Subpacket SomePKPayload
_ SigSubPacketPayload
_ = Bool -> Either VerificationError Bool
forall a b. b -> Either a b
Right Bool
True
    -- RFC 9580 §5.2.3.35: v6 signatures MUST NOT include an Issuer Key ID subpacket.
    -- Treat any such subpacket as a verification error rather than merely uncheckable.
    checkV6Subpacket :: SomePKPayload
-> SigSubPacketPayload -> Either VerificationError Bool
checkV6Subpacket SomePKPayload
_ Issuer {} =
      VerificationError -> Either VerificationError Bool
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
IssuerKeyIdProhibitedInV6Signature
    checkV6Subpacket SomePKPayload
signer i :: SigSubPacketPayload
i@IssuerFingerprint {} =
      IssuerFingerprintVersion
-> Fingerprint
-> SigSubPacketPayload
-> Either VerificationError Bool
checkIssuerFingerprintSubpacket IssuerFingerprintVersion
PKA.IssuerFingerprintV6 (SomePKPayload -> Fingerprint
fingerprint SomePKPayload
signer) SigSubPacketPayload
i
    checkV6Subpacket SomePKPayload
_ SigSubPacketPayload
_ = Bool -> Either VerificationError Bool
forall a b. b -> Either a b
Right Bool
True
    rejectV6UnhashedIssuer :: SigSubPacket -> Either VerificationError ()
rejectV6UnhashedIssuer (SigSubPacket Bool
_ Issuer {}) =
      VerificationError -> Either VerificationError ()
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
IssuerKeyIdProhibitedInV6Signature
    rejectV6UnhashedIssuer SigSubPacket
_ = () -> Either VerificationError ()
forall a b. b -> Either a b
Right ()
    verifiableSignatureVerificationInputs ::
         VerifiableSignatureV
      ->
         ( SigType
         , [SigSubPacket]
         , [SigSubPacket]
         , SomePKPayload -> SigSubPacketPayload -> Either VerificationError Bool
         , [SigSubPacket] -> Either VerificationError ()
         )
    verifiableSignatureVerificationInputs :: VerifiableSignatureV
-> (SigType, [SigSubPacket], [SigSubPacket],
    SomePKPayload
    -> SigSubPacketPayload -> Either VerificationError Bool,
    [SigSubPacket] -> Either VerificationError ())
verifiableSignatureVerificationInputs
      (VerifiableSignatureV4 (SigPayloadV4Data SigType
st PubKeyAlgorithm
_ HashAlgorithm
_ [SigSubPacket]
hs [SigSubPacket]
us Word16
_ NonEmpty MPI
_)) =
        (SigType
st, [SigSubPacket]
hs, [SigSubPacket]
us, SomePKPayload
-> SigSubPacketPayload -> Either VerificationError Bool
checkV4Subpacket, Either VerificationError ()
-> [SigSubPacket] -> Either VerificationError ()
forall a b. a -> b -> a
const (() -> Either VerificationError ()
forall a b. b -> Either a b
Right ()))
    verifiableSignatureVerificationInputs
      (VerifiableSignatureV6 (SigPayloadV6Data SigType
st PubKeyAlgorithm
_ HashAlgorithm
_ SignatureSalt
_ [SigSubPacket]
hs [SigSubPacket]
us Word16
_ NonEmpty MPI
_)) =
        (SigType
st, [SigSubPacket]
hs, [SigSubPacket]
us, SomePKPayload
-> SigSubPacketPayload -> Either VerificationError Bool
checkV6Subpacket, (SigSubPacket -> Either VerificationError ())
-> [SigSubPacket] -> Either VerificationError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SigSubPacket -> Either VerificationError ()
rejectV6UnhashedIssuer)
verifySigWith Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
_ Pkt
_ PktStreamContext
_ Maybe UTCTime
_ =
  VerificationError -> Either VerificationError Verification
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
NonSignaturePacket

verifyWithSubpacketChecks ::
     (Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification)
  -> Pkt
  -> PktStreamContext
  -> Maybe UTCTime
  -> SigType
  -> [SigSubPacket]
  -> (SomePKPayload -> SigSubPacketPayload -> Either VerificationError Bool)
  -> Either VerificationError Verification
verifyWithSubpacketChecks :: (Pkt
 -> Maybe UTCTime
 -> ByteString
 -> Either VerificationError Verification)
-> Pkt
-> PktStreamContext
-> Maybe UTCTime
-> SigType
-> [SigSubPacket]
-> (SomePKPayload
    -> SigSubPacketPayload -> Either VerificationError Bool)
-> Either VerificationError Verification
verifyWithSubpacketChecks Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
vf Pkt
sig PktStreamContext
state Maybe UTCTime
mt SigType
sigType [SigSubPacket]
hashedSubpackets SomePKPayload
-> SigSubPacketPayload -> Either VerificationError Bool
checkSubpacket = do
  (SigSubPacket -> Either VerificationError ())
-> [SigSubPacket] -> Either VerificationError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SigType -> SigSubPacket -> Either VerificationError ()
rejectUnsupportedCriticalSubpacket SigType
sigType) [SigSubPacket]
hashedSubpackets
  v <- Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
vf Pkt
sig Maybe UTCTime
mt (SigType -> PktStreamContext -> ByteString
payloadForSig SigType
sigType PktStreamContext
state)
  mapM_ (checkSubpacket (v ^. verificationSigner) . _sspPayload) hashedSubpackets
  warnings <-
    if sigType == SubkeyBindingSig
      then verifySubkeyBackSignatures state mt hashedSubpackets
      else Right []
  isSignatureExpired sig mt *>
    pure
      (v
         { _verificationWarnings =
             _verificationWarnings v ++ warnings
         })

-- | Verify embedded primary-key back-signatures (PrimaryKeyBindingSig, 0x19)
-- found in the hashed subpackets of a SubkeyBindingSig.
--
-- Per RFC 9580 §5.2.3.3, a signing-capable subkey MUST include an embedded
-- PrimaryKeyBindingSig (0x19) made by the subkey.  This requirement is
-- enforced strictly for v6 subkeys.  For v4 subkeys we still verify any
-- embedded back-sigs that are present, but do not reject a missing one —
-- real-world v4 signing subkeys predate the strict cross-certification
-- mandate and widespread interoperability requires accepting them.
verifySubkeyBackSignatures ::
     PktStreamContext
  -> Maybe UTCTime
  -> [SigSubPacket]
  -> Either VerificationError [VerificationWarning]
verifySubkeyBackSignatures :: PktStreamContext
-> Maybe UTCTime
-> [SigSubPacket]
-> Either VerificationError [VerificationWarning]
verifySubkeyBackSignatures PktStreamContext
state Maybe UTCTime
mt [SigSubPacket]
hashedSubpackets = do
  subkeyPKP <-
    Either VerificationError SomePKPayload
-> (SomePKPayload -> Either VerificationError SomePKPayload)
-> Maybe SomePKPayload
-> Either VerificationError SomePKPayload
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
NonSignaturePacket)
      SomePKPayload -> Either VerificationError SomePKPayload
forall a b. b -> Either a b
Right
      (Pkt -> Maybe SomePKPayload
subkeyPKPFromPkt (PktStreamContext -> Pkt
lastSubkey PktStreamContext
state))
  let embeddedSigs =
        [ SignaturePayload
sp
        | SigSubPacket Bool
_ (EmbeddedSignature SignaturePayload
sp) <- [SigSubPacket]
hashedSubpackets
        ]
      isSigningCapable =
        (SigSubPacket -> Bool) -> [SigSubPacket] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
          (\(SigSubPacket Bool
_ SigSubPacketPayload
payload) ->
             case SigSubPacketPayload
payload of
               KeyFlags Set KeyFlag
flags -> KeyFlag
SignDataKey KeyFlag -> Set KeyFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set KeyFlag
flags
               SigSubPacketPayload
_ -> Bool
False)
          [SigSubPacket]
hashedSubpackets
      isV6Subkey = SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
subkeyPKP KeyVersion -> KeyVersion -> Bool
forall a. Eq a => a -> a -> Bool
== KeyVersion
V6
  case embeddedSigs of
    [] ->
      -- Require back-sig only for v6 signing subkeys (RFC 9580 §5.2.3.3).
      if Bool
isSigningCapable Bool -> Bool -> Bool
&& Bool
isV6Subkey
        then [VerificationWarning]
-> Either VerificationError [VerificationWarning]
forall a b. b -> Either a b
Right [VerificationWarning
MissingSubkeyBackSignatureWarning]
        else [VerificationWarning]
-> Either VerificationError [VerificationWarning]
forall a b. b -> Either a b
Right []
    [SignaturePayload]
_ ->
      -- Always verify back-sigs that are present, regardless of key version.
      (SignaturePayload -> Either VerificationError ())
-> [SignaturePayload] -> Either VerificationError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SomePKPayload -> SignaturePayload -> Either VerificationError ()
verifyOneBackSig SomePKPayload
subkeyPKP) [SignaturePayload]
embeddedSigs Either VerificationError ()
-> Either VerificationError [VerificationWarning]
-> Either VerificationError [VerificationWarning]
forall a b.
Either VerificationError a
-> Either VerificationError b -> Either VerificationError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [VerificationWarning]
-> Either VerificationError [VerificationWarning]
forall a b. b -> Either a b
Right []
  where
    verifyOneBackSig :: SomePKPayload -> SignaturePayload -> Either VerificationError ()
verifyOneBackSig SomePKPayload
subkeyPKP SignaturePayload
embSigPayload = do
      let embSigPkt :: Pkt
embSigPkt = SignaturePayload -> Pkt
SignaturePkt SignaturePayload
embSigPayload
          backSigContext :: PktStreamContext
backSigContext =
            PktStreamContext
emptyPSC
              { lastPrimaryKey = lastPrimaryKey state
              , lastSubkey = lastSubkey state
              }
      case SomePKPayload
-> Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyAgainstKey' SomePKPayload
subkeyPKP Pkt
embSigPkt Maybe UTCTime
mt
             (SigType -> PktStreamContext -> ByteString
payloadForSig SigType
PrimaryKeyBindingSig PktStreamContext
backSigContext) of
        Left VerificationError
err -> VerificationError -> Either VerificationError ()
forall a. VerificationError -> Either VerificationError a
verificationError (VerificationError -> VerificationError
InvalidSubkeyBackSignature VerificationError
err)
        Right Verification
_ -> () -> Either VerificationError ()
forall a b. b -> Either a b
Right ()

rejectUnsupportedCriticalSubpacket :: SigType -> SigSubPacket -> Either VerificationError ()
rejectUnsupportedCriticalSubpacket :: SigType -> SigSubPacket -> Either VerificationError ()
rejectUnsupportedCriticalSubpacket SigType
sigType (SigSubPacket Bool
isCritical SigSubPacketPayload
payload)
  | Bool -> Bool
not Bool
isCritical = () -> Either VerificationError ()
forall a b. b -> Either a b
Right ()
  | Bool -> Bool
not (SigType -> Bool
isBindingSignatureType SigType
sigType) = () -> Either VerificationError ()
forall a b. b -> Either a b
Right ()
  | Bool
otherwise =
      case SigSubPacketPayload
payload of
        UserDefinedSigSub {} -> VerificationError -> Either VerificationError ()
forall a. VerificationError -> Either VerificationError a
verificationError (SigType -> VerificationError
UnsupportedCriticalSubpacket SigType
sigType)
        OtherSigSub {} -> VerificationError -> Either VerificationError ()
forall a. VerificationError -> Either VerificationError a
verificationError (SigType -> VerificationError
UnsupportedCriticalSubpacket SigType
sigType)
        SigSubPacketPayload
_ -> () -> Either VerificationError ()
forall a b. b -> Either a b
Right ()

isBindingSignatureType :: SigType -> Bool
isBindingSignatureType :: SigType -> Bool
isBindingSignatureType SigType
SubkeyBindingSig = Bool
True
isBindingSignatureType SigType
PrimaryKeyBindingSig = Bool
True
isBindingSignatureType SigType
_ = Bool
False

checkIssuerSubpacket ::
     Either String EightOctetKeyId
  -> SigSubPacketPayload
  -> Either VerificationError Bool
checkIssuerSubpacket :: Either String EightOctetKeyId
-> SigSubPacketPayload -> Either VerificationError Bool
checkIssuerSubpacket (Right EightOctetKeyId
signer) (Issuer EightOctetKeyId
i)
  | EightOctetKeyId
signer EightOctetKeyId -> EightOctetKeyId -> Bool
forall a. Eq a => a -> a -> Bool
== EightOctetKeyId
i = Bool -> Either VerificationError Bool
forall a b. b -> Either a b
Right Bool
True
  | Bool
otherwise = VerificationError -> Either VerificationError Bool
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
IssuerSubpacketMismatch
checkIssuerSubpacket (Left String
err) (Issuer EightOctetKeyId
_) =
  VerificationError -> Either VerificationError Bool
forall a. VerificationError -> Either VerificationError a
verificationError (String -> VerificationError
IssuerSubpacketUncheckable String
err)
checkIssuerSubpacket Either String EightOctetKeyId
_ SigSubPacketPayload
_ = Bool -> Either VerificationError Bool
forall a b. b -> Either a b
Right Bool
True

checkIssuerFingerprintSubpacket ::
     IssuerFingerprintVersion -> Fingerprint -> SigSubPacketPayload -> Either VerificationError Bool
checkIssuerFingerprintSubpacket :: IssuerFingerprintVersion
-> Fingerprint
-> SigSubPacketPayload
-> Either VerificationError Bool
checkIssuerFingerprintSubpacket IssuerFingerprintVersion
expectedVersion Fingerprint
signer (IssuerFingerprint IssuerFingerprintVersion
kv Fingerprint
i)
  | IssuerFingerprintVersion
kv IssuerFingerprintVersion -> IssuerFingerprintVersion -> Bool
forall a. Eq a => a -> a -> Bool
/= IssuerFingerprintVersion
expectedVersion = VerificationError -> Either VerificationError Bool
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
IssuerFingerprintSubpacketMismatch
  | Fingerprint
signer Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== Fingerprint
i = Bool -> Either VerificationError Bool
forall a b. b -> Either a b
Right Bool
True
  | Bool
otherwise = VerificationError -> Either VerificationError Bool
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
IssuerFingerprintSubpacketMismatch
checkIssuerFingerprintSubpacket IssuerFingerprintVersion
_ Fingerprint
_ SigSubPacketPayload
_ = Bool -> Either VerificationError Bool
forall a b. b -> Either a b
Right Bool
True

verifyTKWith ::
     (Pkt -> PktStreamContext -> Maybe UTCTime -> Either VerificationError Verification)
  -> Maybe UTCTime
  -> TK k
  -> Either VerificationError (TK k)
verifyTKWith :: forall (k :: TKKind).
(Pkt
 -> PktStreamContext
 -> Maybe UTCTime
 -> Either VerificationError Verification)
-> Maybe UTCTime -> TK k -> Either VerificationError (TK k)
verifyTKWith Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either VerificationError Verification
vsf Maybe UTCTime
mt TK k
tk = do
  verifiedUnknown <- (Pkt
 -> PktStreamContext
 -> Maybe UTCTime
 -> Either VerificationError Verification)
-> Maybe UTCTime -> TKUnknown -> Either VerificationError TKUnknown
verifyUnknownTKWith Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either VerificationError Verification
vsf Maybe UTCTime
mt (TK k -> TKUnknown
forall (k :: TKKind). TK k -> TKUnknown
tkToUnknown TK k
tk)
  let typedSubkeys = [(Pkt, KeyPkt (TKKindToKeyPktKind k))]
-> Map Pkt (KeyPkt (TKKindToKeyPktKind k))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (KeyPkt (TKKindToKeyPktKind k) -> Pkt
forall (k :: KeyPktKind). KeyPkt k -> Pkt
keyPktToPkt KeyPkt (TKKindToKeyPktKind k)
kp, KeyPkt (TKKindToKeyPktKind k)
kp) | (KeyPkt (TKKindToKeyPktKind k)
kp, [SignaturePayload]
_) <- TK k
tk TK k
-> Getting
     [(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])]
     (TK k)
     [(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])]
-> [(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])]
  (TK k)
  [(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])]
 -> f [(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])])
-> TK k -> f (TK k)
tkSubs ]
      verifiedTypedSubkeys =
        ((Pkt, [SignaturePayload])
 -> Maybe (KeyPkt (TKKindToKeyPktKind k), [SignaturePayload]))
-> [(Pkt, [SignaturePayload])]
-> [(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
          (\(Pkt
pkt, [SignaturePayload]
sigs) -> (\KeyPkt (TKKindToKeyPktKind k)
kp -> (KeyPkt (TKKindToKeyPktKind k)
kp, [SignaturePayload]
sigs)) (KeyPkt (TKKindToKeyPktKind k)
 -> (KeyPkt (TKKindToKeyPktKind k), [SignaturePayload]))
-> Maybe (KeyPkt (TKKindToKeyPktKind k))
-> Maybe (KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pkt
-> Map Pkt (KeyPkt (TKKindToKeyPktKind k))
-> Maybe (KeyPkt (TKKindToKeyPktKind k))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Pkt
pkt Map Pkt (KeyPkt (TKKindToKeyPktKind k))
typedSubkeys)
          (TKUnknown
verifiedUnknown TKUnknown
-> Getting
     [(Pkt, [SignaturePayload])] TKUnknown [(Pkt, [SignaturePayload])]
-> [(Pkt, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Pkt, [SignaturePayload])] TKUnknown [(Pkt, [SignaturePayload])]
Lens' TKUnknown [(Pkt, [SignaturePayload])]
tkuSubs)
  pure
    TK
      { _tkPrimaryKey = tk ^. tkPrimaryKey
      , _tkRevs = verifiedUnknown ^. tkuRevs
      , _tkUIDs = verifiedUnknown ^. tkuUIDs
      , _tkUAts = verifiedUnknown ^. tkuUAts
      , _tkSubs = verifiedTypedSubkeys
      }

verifyUnknownTKWith ::
     (Pkt -> PktStreamContext -> Maybe UTCTime -> Either VerificationError Verification)
  -> Maybe UTCTime
  -> TKUnknown
  -> Either VerificationError TKUnknown
verifyUnknownTKWith :: (Pkt
 -> PktStreamContext
 -> Maybe UTCTime
 -> Either VerificationError Verification)
-> Maybe UTCTime -> TKUnknown -> Either VerificationError TKUnknown
verifyUnknownTKWith Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either VerificationError Verification
vsf Maybe UTCTime
mt TKUnknown
tk = do
  revokers <- TKUnknown
-> Either VerificationError [(PubKeyAlgorithm, Fingerprint)]
forall {a}. TKUnknown -> Either a [(PubKeyAlgorithm, Fingerprint)]
checkRevokers TKUnknown
tk
  revs <- checkKeyRevocations revokers tk
  let uids = ((Text, [SignaturePayload]) -> Bool)
-> [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Text, [SignaturePayload]) -> Bool)
-> (Text, [SignaturePayload])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SignaturePayload] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SignaturePayload] -> Bool)
-> ((Text, [SignaturePayload]) -> [SignaturePayload])
-> (Text, [SignaturePayload])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [SignaturePayload]) -> [SignaturePayload]
forall a b. (a, b) -> b
snd) ([(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])])
-> ([(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])])
-> [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
checkUidSigs ([(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])])
-> [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
forall a b. (a -> b) -> a -> b
$ TKUnknown
tk TKUnknown
-> Getting
     [(Text, [SignaturePayload])] TKUnknown [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])] TKUnknown [(Text, [SignaturePayload])]
Lens' TKUnknown [(Text, [SignaturePayload])]
tkuUIDs
  let uats = (([UserAttrSubPacket], [SignaturePayload]) -> Bool)
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (([UserAttrSubPacket], [SignaturePayload]) -> Bool)
-> ([UserAttrSubPacket], [SignaturePayload])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SignaturePayload] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SignaturePayload] -> Bool)
-> (([UserAttrSubPacket], [SignaturePayload])
    -> [SignaturePayload])
-> ([UserAttrSubPacket], [SignaturePayload])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([UserAttrSubPacket], [SignaturePayload]) -> [SignaturePayload]
forall a b. (a, b) -> b
snd) ([([UserAttrSubPacket], [SignaturePayload])]
 -> [([UserAttrSubPacket], [SignaturePayload])])
-> ([([UserAttrSubPacket], [SignaturePayload])]
    -> [([UserAttrSubPacket], [SignaturePayload])])
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
checkUAtSigs ([([UserAttrSubPacket], [SignaturePayload])]
 -> [([UserAttrSubPacket], [SignaturePayload])])
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall a b. (a -> b) -> a -> b
$ TKUnknown
tk TKUnknown
-> Getting
     [([UserAttrSubPacket], [SignaturePayload])]
     TKUnknown
     [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [([UserAttrSubPacket], [SignaturePayload])]
  TKUnknown
  [([UserAttrSubPacket], [SignaturePayload])]
Lens' TKUnknown [([UserAttrSubPacket], [SignaturePayload])]
tkuUAts
  let subs = ((Pkt, [SignaturePayload]) -> [(Pkt, [SignaturePayload])])
-> [(Pkt, [SignaturePayload])] -> [(Pkt, [SignaturePayload])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Pkt, [SignaturePayload]) -> [(Pkt, [SignaturePayload])]
checkSub ([(Pkt, [SignaturePayload])] -> [(Pkt, [SignaturePayload])])
-> [(Pkt, [SignaturePayload])] -> [(Pkt, [SignaturePayload])]
forall a b. (a -> b) -> a -> b
$ TKUnknown
tk TKUnknown
-> Getting
     [(Pkt, [SignaturePayload])] TKUnknown [(Pkt, [SignaturePayload])]
-> [(Pkt, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Pkt, [SignaturePayload])] TKUnknown [(Pkt, [SignaturePayload])]
Lens' TKUnknown [(Pkt, [SignaturePayload])]
tkuSubs
  return (TKUnknown (tk ^. tkuKey) revs uids uats subs)
  where
    checkRevokers :: TKUnknown -> Either a [(PubKeyAlgorithm, Fingerprint)]
checkRevokers =
      [(PubKeyAlgorithm, Fingerprint)]
-> Either a [(PubKeyAlgorithm, Fingerprint)]
forall a b. b -> Either a b
Right ([(PubKeyAlgorithm, Fingerprint)]
 -> Either a [(PubKeyAlgorithm, Fingerprint)])
-> (TKUnknown -> [(PubKeyAlgorithm, Fingerprint)])
-> TKUnknown
-> Either a [(PubKeyAlgorithm, Fingerprint)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(PubKeyAlgorithm, Fingerprint)]]
-> [(PubKeyAlgorithm, Fingerprint)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(PubKeyAlgorithm, Fingerprint)]]
 -> [(PubKeyAlgorithm, Fingerprint)])
-> (TKUnknown -> [[(PubKeyAlgorithm, Fingerprint)]])
-> TKUnknown
-> [(PubKeyAlgorithm, Fingerprint)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either VerificationError [(PubKeyAlgorithm, Fingerprint)]]
-> [[(PubKeyAlgorithm, Fingerprint)]]
forall a b. [Either a b] -> [b]
rights ([Either VerificationError [(PubKeyAlgorithm, Fingerprint)]]
 -> [[(PubKeyAlgorithm, Fingerprint)]])
-> (TKUnknown
    -> [Either VerificationError [(PubKeyAlgorithm, Fingerprint)]])
-> TKUnknown
-> [[(PubKeyAlgorithm, Fingerprint)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload
 -> Either VerificationError [(PubKeyAlgorithm, Fingerprint)])
-> [SignaturePayload]
-> [Either VerificationError [(PubKeyAlgorithm, Fingerprint)]]
forall a b. (a -> b) -> [a] -> [b]
map SignaturePayload
-> Either VerificationError [(PubKeyAlgorithm, Fingerprint)]
verifyRevoker ([SignaturePayload]
 -> [Either VerificationError [(PubKeyAlgorithm, Fingerprint)]])
-> (TKUnknown -> [SignaturePayload])
-> TKUnknown
-> [Either VerificationError [(PubKeyAlgorithm, Fingerprint)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter SignaturePayload -> Bool
isRevokerP ([SignaturePayload] -> [SignaturePayload])
-> (TKUnknown -> [SignaturePayload])
-> TKUnknown
-> [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TKUnknown -> [SignaturePayload]
_tkuRevs
    checkKeyRevocations ::
         [(PubKeyAlgorithm, Fingerprint)]
      -> TKUnknown
      -> Either VerificationError [SignaturePayload]
    checkKeyRevocations :: [(PubKeyAlgorithm, Fingerprint)]
-> TKUnknown -> Either VerificationError [SignaturePayload]
checkKeyRevocations [(PubKeyAlgorithm, Fingerprint)]
rs TKUnknown
k =
      [Either VerificationError SignaturePayload]
-> Either VerificationError [SignaturePayload]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
Prelude.sequence ([Either VerificationError SignaturePayload]
 -> Either VerificationError [SignaturePayload])
-> ([SignaturePayload]
    -> [Either VerificationError SignaturePayload])
-> [SignaturePayload]
-> Either VerificationError [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SignaturePayload, Verification)
 -> [Either VerificationError SignaturePayload])
-> [(SignaturePayload, Verification)]
-> [Either VerificationError SignaturePayload]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(PubKeyAlgorithm, Fingerprint)]
-> (SignaturePayload, Verification)
-> [Either VerificationError SignaturePayload]
filterRevs [(PubKeyAlgorithm, Fingerprint)]
rs) ([(SignaturePayload, Verification)]
 -> [Either VerificationError SignaturePayload])
-> ([SignaturePayload] -> [(SignaturePayload, Verification)])
-> [SignaturePayload]
-> [Either VerificationError SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either VerificationError (SignaturePayload, Verification)]
-> [(SignaturePayload, Verification)]
forall a b. [Either a b] -> [b]
rights ([Either VerificationError (SignaturePayload, Verification)]
 -> [(SignaturePayload, Verification)])
-> ([SignaturePayload]
    -> [Either VerificationError (SignaturePayload, Verification)])
-> [SignaturePayload]
-> [(SignaturePayload, Verification)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (SignaturePayload
 -> Either VerificationError (SignaturePayload, Verification))
-> [SignaturePayload]
-> [Either VerificationError (SignaturePayload, Verification)]
forall a b. (a -> b) -> [a] -> [b]
map (((Verification -> (SignaturePayload, Verification))
 -> Either VerificationError Verification
 -> Either VerificationError (SignaturePayload, Verification))
-> (SignaturePayload
    -> Verification -> (SignaturePayload, Verification))
-> (SignaturePayload -> Either VerificationError Verification)
-> SignaturePayload
-> Either VerificationError (SignaturePayload, Verification)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Verification -> (SignaturePayload, Verification))
-> Either VerificationError Verification
-> Either VerificationError (SignaturePayload, Verification)
forall a b.
(a -> b)
-> Either VerificationError a -> Either VerificationError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,) SignaturePayload -> Either VerificationError Verification
vSig) ([SignaturePayload] -> Either VerificationError [SignaturePayload])
-> [SignaturePayload]
-> Either VerificationError [SignaturePayload]
forall a b. (a -> b) -> a -> b
$
      TKUnknown
k TKUnknown
-> Getting [SignaturePayload] TKUnknown [SignaturePayload]
-> [SignaturePayload]
forall s a. s -> Getting a s a -> a
^.
      Getting [SignaturePayload] TKUnknown [SignaturePayload]
Lens' TKUnknown [SignaturePayload]
tkuRevs
    checkUidSigs :: [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
    checkUidSigs :: [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
checkUidSigs =
      ((Text, [SignaturePayload]) -> (Text, [SignaturePayload]))
-> [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
map
        (\(Text
uid, [SignaturePayload]
sps) ->
           let verified :: [(SignaturePayload, Verification)]
verified = [Either VerificationError (SignaturePayload, Verification)]
-> [(SignaturePayload, Verification)]
forall a b. [Either a b] -> [b]
rights ([Either VerificationError (SignaturePayload, Verification)]
 -> [(SignaturePayload, Verification)])
-> ([SignaturePayload]
    -> [Either VerificationError (SignaturePayload, Verification)])
-> [SignaturePayload]
-> [(SignaturePayload, Verification)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload
 -> Either VerificationError (SignaturePayload, Verification))
-> [SignaturePayload]
-> [Either VerificationError (SignaturePayload, Verification)]
forall a b. (a -> b) -> [a] -> [b]
map (\SignaturePayload
sp -> (Verification -> (SignaturePayload, Verification))
-> Either VerificationError Verification
-> Either VerificationError (SignaturePayload, Verification)
forall a b.
(a -> b)
-> Either VerificationError a -> Either VerificationError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) SignaturePayload
sp) ((Text, SignaturePayload) -> Either VerificationError Verification
vUid (Text
uid, SignaturePayload
sp))) ([SignaturePayload] -> [(SignaturePayload, Verification)])
-> [SignaturePayload] -> [(SignaturePayload, Verification)]
forall a b. (a -> b) -> a -> b
$ [SignaturePayload]
sps
            in (Text
uid, Maybe UTCTime
-> [(SignaturePayload, Verification)] -> [SignaturePayload]
retainNonRevokedCertifications Maybe UTCTime
mt [(SignaturePayload, Verification)]
verified))
    checkUAtSigs ::
        [([UserAttrSubPacket], [SignaturePayload])]
      -> [([UserAttrSubPacket], [SignaturePayload])]
    checkUAtSigs :: [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
checkUAtSigs =
      (([UserAttrSubPacket], [SignaturePayload])
 -> ([UserAttrSubPacket], [SignaturePayload]))
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
map
       (\([UserAttrSubPacket]
uat, [SignaturePayload]
sps) ->
          let verified :: [(SignaturePayload, Verification)]
verified = [Either VerificationError (SignaturePayload, Verification)]
-> [(SignaturePayload, Verification)]
forall a b. [Either a b] -> [b]
rights ([Either VerificationError (SignaturePayload, Verification)]
 -> [(SignaturePayload, Verification)])
-> ([SignaturePayload]
    -> [Either VerificationError (SignaturePayload, Verification)])
-> [SignaturePayload]
-> [(SignaturePayload, Verification)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload
 -> Either VerificationError (SignaturePayload, Verification))
-> [SignaturePayload]
-> [Either VerificationError (SignaturePayload, Verification)]
forall a b. (a -> b) -> [a] -> [b]
map (\SignaturePayload
sp -> (Verification -> (SignaturePayload, Verification))
-> Either VerificationError Verification
-> Either VerificationError (SignaturePayload, Verification)
forall a b.
(a -> b)
-> Either VerificationError a -> Either VerificationError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) SignaturePayload
sp) (([UserAttrSubPacket], SignaturePayload)
-> Either VerificationError Verification
vUAt ([UserAttrSubPacket]
uat, SignaturePayload
sp))) ([SignaturePayload] -> [(SignaturePayload, Verification)])
-> [SignaturePayload] -> [(SignaturePayload, Verification)]
forall a b. (a -> b) -> a -> b
$ [SignaturePayload]
sps
           in ([UserAttrSubPacket]
uat, Maybe UTCTime
-> [(SignaturePayload, Verification)] -> [SignaturePayload]
retainNonRevokedCertifications Maybe UTCTime
mt [(SignaturePayload, Verification)]
verified))
    checkSub :: (Pkt, [SignaturePayload]) -> [(Pkt, [SignaturePayload])]
    checkSub :: (Pkt, [SignaturePayload]) -> [(Pkt, [SignaturePayload])]
checkSub (Pkt
pkt, [SignaturePayload]
sps) =
      if Pkt -> [SignaturePayload] -> Bool
revokedSub Pkt
pkt [SignaturePayload]
sps
       then []
       else Pkt -> [SignaturePayload] -> [(Pkt, [SignaturePayload])]
checkSub' Pkt
pkt [SignaturePayload]
sps
    revokedSub :: Pkt -> [SignaturePayload] -> Bool
    revokedSub :: Pkt -> [SignaturePayload] -> Bool
revokedSub Pkt
_ [] = Bool
False
    revokedSub Pkt
p [SignaturePayload]
sigs =
      (SignaturePayload -> Bool) -> [SignaturePayload] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pkt -> SignaturePayload -> Bool
vSubSig Pkt
p) ((SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter SignaturePayload -> Bool
subkeyRevocationEffective [SignaturePayload]
sigs)
    checkSub' :: Pkt -> [SignaturePayload] -> [(Pkt, [SignaturePayload])]
    checkSub' :: Pkt -> [SignaturePayload] -> [(Pkt, [SignaturePayload])]
checkSub' Pkt
p [SignaturePayload]
sps =
      let goodsigs :: [SignaturePayload]
goodsigs =
           (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter (Pkt -> SignaturePayload -> Bool
vSubSig Pkt
p) ([SignaturePayload] -> [SignaturePayload])
-> ([SignaturePayload] -> [SignaturePayload])
-> [SignaturePayload]
-> [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter SignaturePayload -> Bool
signatureKnown ([SignaturePayload] -> [SignaturePayload])
-> ([SignaturePayload] -> [SignaturePayload])
-> [SignaturePayload]
-> [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter SignaturePayload -> Bool
isSubkeyBindingSig ([SignaturePayload] -> [SignaturePayload])
-> [SignaturePayload] -> [SignaturePayload]
forall a b. (a -> b) -> a -> b
$
           [SignaturePayload]
sps
      in if [SignaturePayload] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SignaturePayload]
goodsigs
           then []
           else [(Pkt
p, [SignaturePayload]
goodsigs)]
    getHasheds :: SignaturePayload -> [SigSubPacket]
getHasheds = SignaturePayload -> [SigSubPacket]
signatureHashedSubpackets
    filterRevs ::
         [(PubKeyAlgorithm, Fingerprint)]
      -> (SignaturePayload, Verification)
      -> [Either VerificationError SignaturePayload]
    filterRevs :: [(PubKeyAlgorithm, Fingerprint)]
-> (SignaturePayload, Verification)
-> [Either VerificationError SignaturePayload]
filterRevs [(PubKeyAlgorithm, Fingerprint)]
vokers (SignaturePayload, Verification)
spv =
      case (SignaturePayload, Verification)
spv of
       (SignaturePayload
s, Verification
_)
         | SignaturePayload -> Bool
isV4OrV6Sig SignaturePayload
s Bool -> Bool -> Bool
&& SignaturePayload -> Maybe SigType
sigType SignaturePayload
s Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
SignatureDirectlyOnAKey ->
            [SignaturePayload -> Either VerificationError SignaturePayload
forall a b. b -> Either a b
Right SignaturePayload
s | SignaturePayload -> Bool
signatureKnown SignaturePayload
s]
       (SignaturePayload
s, Verification
v)
         | SignaturePayload -> Bool
isV4OrV6Sig SignaturePayload
s
            , SignaturePayload -> Maybe SigType
sigType SignaturePayload
s Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
KeyRevocationSig
            , Just PubKeyAlgorithm
pka <- SignaturePayload -> Maybe PubKeyAlgorithm
sigPKA SignaturePayload
s ->
          if (Verification
v Verification
-> Getting SomePKPayload Verification SomePKPayload
-> SomePKPayload
forall s a. s -> Getting a s a -> a
^. Getting SomePKPayload Verification SomePKPayload
Lens' Verification SomePKPayload
verificationSigner SomePKPayload -> SomePKPayload -> Bool
forall a. Eq a => a -> a -> Bool
== TKUnknown
tk TKUnknown
-> Getting SomePKPayload TKUnknown SomePKPayload -> SomePKPayload
forall s a. s -> Getting a s a -> a
^. ((SomePKPayload, Maybe SKAddendum)
 -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> TKUnknown -> Const SomePKPayload TKUnknown
Lens' TKUnknown (SomePKPayload, Maybe SKAddendum)
tkuKey (((SomePKPayload, Maybe SKAddendum)
  -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
 -> TKUnknown -> Const SomePKPayload TKUnknown)
-> ((SomePKPayload -> Const SomePKPayload SomePKPayload)
    -> (SomePKPayload, Maybe SKAddendum)
    -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> Getting SomePKPayload TKUnknown SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomePKPayload -> Const SomePKPayload SomePKPayload)
-> (SomePKPayload, Maybe SKAddendum)
-> Const SomePKPayload (SomePKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SomePKPayload, Maybe SKAddendum)
  (SomePKPayload, Maybe SKAddendum)
  SomePKPayload
  SomePKPayload
_1) Bool -> Bool -> Bool
||
             ((PubKeyAlgorithm, Fingerprint) -> Bool)
-> [(PubKeyAlgorithm, Fingerprint)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
               (\(PubKeyAlgorithm
p, Fingerprint
f) ->
                  PubKeyAlgorithm
p PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
pka Bool -> Bool -> Bool
&& Fingerprint
f Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== SomePKPayload -> Fingerprint
fingerprint (Verification
v Verification
-> Getting SomePKPayload Verification SomePKPayload
-> SomePKPayload
forall s a. s -> Getting a s a -> a
^. Getting SomePKPayload Verification SomePKPayload
Lens' Verification SomePKPayload
verificationSigner))
                [(PubKeyAlgorithm, Fingerprint)]
vokers
             then
               if SignaturePayload -> Bool
keyRevocationEffective SignaturePayload
s
                 then [VerificationError -> Either VerificationError SignaturePayload
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
KeyRevoked]
                 else [SignaturePayload -> Either VerificationError SignaturePayload
forall a b. b -> Either a b
Right SignaturePayload
s | SignaturePayload -> Bool
signatureKnown SignaturePayload
s]
             else [SignaturePayload -> Either VerificationError SignaturePayload
forall a b. b -> Either a b
Right SignaturePayload
s | SignaturePayload -> Bool
signatureKnown SignaturePayload
s]
       (SignaturePayload, Verification)
_ -> []
    isV4OrV6Sig :: SignaturePayload -> Bool
isV4OrV6Sig = SignaturePayload -> Bool
isVerifiableSignaturePayload
    vUid :: (Text, SignaturePayload) -> Either VerificationError Verification
    vUid :: (Text, SignaturePayload) -> Either VerificationError Verification
vUid (Text
uid, SignaturePayload
sp) =
      Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either VerificationError Verification
vsf
        (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sp)
        PktStreamContext
emptyPSC
          { lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)
          , lastUIDorUAt = UserIdPkt uid
          }
        Maybe UTCTime
forall a. Maybe a
Nothing
    vUAt ::
         ([UserAttrSubPacket], SignaturePayload) -> Either VerificationError Verification
    vUAt :: ([UserAttrSubPacket], SignaturePayload)
-> Either VerificationError Verification
vUAt ([UserAttrSubPacket]
uat, SignaturePayload
sp) =
      Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either VerificationError Verification
vsf
        (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sp)
        PktStreamContext
emptyPSC
          { lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)
          , lastUIDorUAt = UserAttributePkt uat
          }
        Maybe UTCTime
forall a. Maybe a
Nothing
    vSig :: SignaturePayload -> Either VerificationError Verification
    vSig :: SignaturePayload -> Either VerificationError Verification
vSig SignaturePayload
sp =
      Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either VerificationError Verification
vsf
        (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sp)
        PktStreamContext
emptyPSC {lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)}
        Maybe UTCTime
forall a. Maybe a
Nothing
    vSubSig :: Pkt -> SignaturePayload -> Bool
    vSubSig :: Pkt -> SignaturePayload -> Bool
vSubSig Pkt
sk SignaturePayload
sp =
      Either VerificationError Verification -> Bool
forall a b. Either a b -> Bool
isRight
        (Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either VerificationError Verification
vsf
           (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sp)
           PktStreamContext
emptyPSC
             { lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)
             , lastSubkey = sk
             }
           Maybe UTCTime
mt)
    verifyRevoker ::
         SignaturePayload
      -> Either VerificationError [(PubKeyAlgorithm, Fingerprint)]
    verifyRevoker :: SignaturePayload
-> Either VerificationError [(PubKeyAlgorithm, Fingerprint)]
verifyRevoker SignaturePayload
sp =
      SignaturePayload -> Either VerificationError Verification
vSig SignaturePayload
sp Either VerificationError Verification
-> Either VerificationError [(PubKeyAlgorithm, Fingerprint)]
-> Either VerificationError [(PubKeyAlgorithm, Fingerprint)]
forall a b.
Either VerificationError a
-> Either VerificationError b -> Either VerificationError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      [(PubKeyAlgorithm, Fingerprint)]
-> Either VerificationError [(PubKeyAlgorithm, Fingerprint)]
forall a. a -> Either VerificationError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ((SigSubPacket -> (PubKeyAlgorithm, Fingerprint))
-> [SigSubPacket] -> [(PubKeyAlgorithm, Fingerprint)]
forall a b. (a -> b) -> [a] -> [b]
map (\(SigSubPacket Bool
_ (RevocationKey Set RevocationClass
_ PubKeyAlgorithm
pka Fingerprint
fp)) -> (PubKeyAlgorithm
pka, Fingerprint
fp)) ([SigSubPacket] -> [(PubKeyAlgorithm, Fingerprint)])
-> ([SigSubPacket] -> [SigSubPacket])
-> [SigSubPacket]
-> [(PubKeyAlgorithm, Fingerprint)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (SigSubPacket -> Bool) -> [SigSubPacket] -> [SigSubPacket]
forall a. (a -> Bool) -> [a] -> [a]
filter SigSubPacket -> Bool
isRevocationKeySSP ([SigSubPacket] -> [(PubKeyAlgorithm, Fingerprint)])
-> [SigSubPacket] -> [(PubKeyAlgorithm, Fingerprint)]
forall a b. (a -> b) -> a -> b
$
         SignaturePayload -> [SigSubPacket]
getHasheds SignaturePayload
sp)
    retainNonRevokedCertifications ::
         Maybe UTCTime -> [(SignaturePayload, Verification)] -> [SignaturePayload]
    retainNonRevokedCertifications :: Maybe UTCTime
-> [(SignaturePayload, Verification)] -> [SignaturePayload]
retainNonRevokedCertifications Maybe UTCTime
validationTime [(SignaturePayload, Verification)]
verified =
      ((SignaturePayload, Verification) -> SignaturePayload)
-> [(SignaturePayload, Verification)] -> [SignaturePayload]
forall a b. (a -> b) -> [a] -> [b]
map (SignaturePayload, Verification) -> SignaturePayload
forall a b. (a, b) -> a
fst ([(SignaturePayload, Verification)] -> [SignaturePayload])
-> [(SignaturePayload, Verification)] -> [SignaturePayload]
forall a b. (a -> b) -> a -> b
$
      ((SignaturePayload, Verification) -> Bool)
-> [(SignaturePayload, Verification)]
-> [(SignaturePayload, Verification)]
forall a. (a -> Bool) -> [a] -> [a]
filter
        ((CertificationState -> CertificationState -> Bool
forall a. Eq a => a -> a -> Bool
== CertificationState
CertificationActive) (CertificationState -> Bool)
-> ((SignaturePayload, Verification) -> CertificationState)
-> (SignaturePayload, Verification)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UTCTime
-> [(SignaturePayload, Verification)]
-> (SignaturePayload, Verification)
-> CertificationState
certificationStateAt Maybe UTCTime
validationTime [(SignaturePayload, Verification)]
verified)
        [(SignaturePayload, Verification)]
certifications
      where
        certifications :: [(SignaturePayload, Verification)]
certifications = ((SignaturePayload, Verification) -> Bool)
-> [(SignaturePayload, Verification)]
-> [(SignaturePayload, Verification)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((SignaturePayload, Verification) -> Bool)
-> (SignaturePayload, Verification)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Bool
isCertRevocationSig (SignaturePayload -> Bool)
-> ((SignaturePayload, Verification) -> SignaturePayload)
-> (SignaturePayload, Verification)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload, Verification) -> SignaturePayload
forall a b. (a, b) -> a
fst) [(SignaturePayload, Verification)]
verified
    signatureKnown :: SignaturePayload -> Bool
signatureKnown = Maybe UTCTime -> SignaturePayload -> Bool
signatureKnownAt Maybe UTCTime
mt
    subkeyRevocationEffective :: SignaturePayload -> Bool
subkeyRevocationEffective SignaturePayload
sp = SignaturePayload -> Bool
isSubkeyRevocation SignaturePayload
sp Bool -> Bool -> Bool
&& Maybe UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt Maybe UTCTime
mt SignaturePayload
sp
    keyRevocationEffective :: SignaturePayload -> Bool
keyRevocationEffective SignaturePayload
sp
      | SignaturePayload -> Bool
isHistoricalKeyRevocation SignaturePayload
sp = Maybe UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt Maybe UTCTime
mt SignaturePayload
sp
      | Bool
otherwise = Maybe UTCTime -> SignaturePayload -> Bool
signatureUnexpiredAt Maybe UTCTime
mt SignaturePayload
sp

verifyAgainstKeyring ::
     PublicKeyring -> Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification
verifyAgainstKeyring :: PublicKeyring
-> Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyAgainstKeyring PublicKeyring
kr Pkt
sig Maybe UTCTime
mt ByteString
payload = do
  let allKeys :: [TKUnknown]
allKeys = (TK 'PublicTK -> TKUnknown) -> [TK 'PublicTK] -> [TKUnknown]
forall a b. (a -> b) -> [a] -> [b]
map TK 'PublicTK -> TKUnknown
forall (k :: TKKind). TK k -> TKUnknown
tkToUnknown (PublicKeyring -> [TK 'PublicTK]
forall (ixs :: [*]) a. IxSet ixs a -> [a]
IxSet.toList PublicKeyring
kr)
      signerValidationTime :: Maybe UTCTime
signerValidationTime = Pkt -> Maybe UTCTime
signatureCreationTimeFromPacket Pkt
sig
      ikeys :: Maybe PublicKeyring
ikeys = (PublicKeyring
kr PublicKeyring -> EightOctetKeyId -> PublicKeyring
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@=) (EightOctetKeyId -> PublicKeyring)
-> Maybe EightOctetKeyId -> Maybe PublicKeyring
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pkt -> Maybe EightOctetKeyId
issuer Pkt
sig
      ifpkeys :: Maybe PublicKeyring
ifpkeys = (PublicKeyring
kr PublicKeyring -> Fingerprint -> PublicKeyring
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@=) (Fingerprint -> PublicKeyring)
-> Maybe Fingerprint -> Maybe PublicKeyring
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pkt -> Maybe Fingerprint
issuerFP Pkt
sig
      hintedKeys :: [TKUnknown]
hintedKeys = [TKUnknown]
-> (PublicKeyring -> [TKUnknown])
-> Maybe PublicKeyring
-> [TKUnknown]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((TK 'PublicTK -> TKUnknown) -> [TK 'PublicTK] -> [TKUnknown]
forall a b. (a -> b) -> [a] -> [b]
map TK 'PublicTK -> TKUnknown
forall (k :: TKKind). TK k -> TKUnknown
tkToUnknown ([TK 'PublicTK] -> [TKUnknown])
-> (PublicKeyring -> [TK 'PublicTK])
-> PublicKeyring
-> [TKUnknown]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKeyring -> [TK 'PublicTK]
forall (ixs :: [*]) a. IxSet ixs a -> [a]
IxSet.toList) (Maybe PublicKeyring
ifpkeys Maybe PublicKeyring -> Maybe PublicKeyring -> Maybe PublicKeyring
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe PublicKeyring
ikeys)
      hintedResult :: Either VerificationError Verification
hintedResult =
        if [TKUnknown] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TKUnknown]
hintedKeys
          then VerificationError -> Either VerificationError Verification
forall a b. a -> Either a b
Left VerificationError
MissingIssuer
          else [TKUnknown]
-> [TKUnknown]
-> Pkt
-> Maybe UTCTime
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyFromCandidates [TKUnknown]
allKeys [TKUnknown]
hintedKeys Pkt
sig Maybe UTCTime
signerValidationTime Maybe UTCTime
mt ByteString
payload
   in case Either VerificationError Verification
hintedResult of
        Right Verification
v -> Verification -> Either VerificationError Verification
forall a b. b -> Either a b
Right Verification
v
        Left VerificationError
hintedErr ->
          let fallbackResult :: Either VerificationError Verification
fallbackResult =
                [TKUnknown]
-> [TKUnknown]
-> Pkt
-> Maybe UTCTime
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyFromCandidates [TKUnknown]
allKeys [TKUnknown]
allKeys Pkt
sig Maybe UTCTime
signerValidationTime Maybe UTCTime
mt ByteString
payload
           in if [TKUnknown] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TKUnknown]
hintedKeys
                then
                  case Either VerificationError Verification
fallbackResult of
                    Right Verification
v -> Verification -> Either VerificationError Verification
forall a b. b -> Either a b
Right Verification
v
                    Left VerificationError
_ ->
                      VerificationError -> Either VerificationError Verification
forall a. VerificationError -> Either VerificationError a
verificationError (Maybe EightOctetKeyId -> Maybe Fingerprint -> VerificationError
SigningKeyNotFound (Pkt -> Maybe EightOctetKeyId
issuer Pkt
sig) (Pkt -> Maybe Fingerprint
issuerFP Pkt
sig))
                else
                  case Either VerificationError Verification
fallbackResult of
                    Right Verification
v -> Verification -> Either VerificationError Verification
forall a b. b -> Either a b
Right Verification
v
                    Left VerificationError
_ -> VerificationError -> Either VerificationError Verification
forall a b. a -> Either a b
Left VerificationError
hintedErr

verifyFromCandidates ::
     [TKUnknown]
  -> [TKUnknown]
  -> Pkt
  -> Maybe UTCTime
  -> Maybe UTCTime
  -> ByteString
  -> Either VerificationError Verification
verifyFromCandidates :: [TKUnknown]
-> [TKUnknown]
-> Pkt
-> Maybe UTCTime
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyFromCandidates [TKUnknown]
allKeys [TKUnknown]
candidateTks Pkt
sig Maybe UTCTime
signerValidationTime Maybe UTCTime
verificationTime ByteString
payload =
  let candidateResults :: [([VerificationError], [SomePKPayload])]
candidateResults =
        (TKUnknown -> ([VerificationError], [SomePKPayload]))
-> [TKUnknown] -> [([VerificationError], [SomePKPayload])]
forall a b. (a -> b) -> [a] -> [b]
map
          ([TKUnknown]
-> Pkt
-> Maybe UTCTime
-> (SomePKPayload -> Bool)
-> TKUnknown
-> ([VerificationError], [SomePKPayload])
resolveCandidateSignerPKPs [TKUnknown]
allKeys Pkt
sig Maybe UTCTime
signerValidationTime (Bool -> SomePKPayload -> Bool
forall a b. a -> b -> a
const Bool
True))
          [TKUnknown]
candidateTks
      candidateErrors :: [VerificationError]
candidateErrors = (([VerificationError], [SomePKPayload]) -> [VerificationError])
-> [([VerificationError], [SomePKPayload])] -> [VerificationError]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([VerificationError], [SomePKPayload]) -> [VerificationError]
forall a b. (a, b) -> a
fst [([VerificationError], [SomePKPayload])]
candidateResults
      usablePkps :: [SomePKPayload]
usablePkps = (([VerificationError], [SomePKPayload]) -> [SomePKPayload])
-> [([VerificationError], [SomePKPayload])] -> [SomePKPayload]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([VerificationError], [SomePKPayload]) -> [SomePKPayload]
forall a b. (a, b) -> b
snd [([VerificationError], [SomePKPayload])]
candidateResults
   in if [SomePKPayload] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SomePKPayload]
usablePkps
        then
          if [VerificationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VerificationError]
candidateErrors
            then VerificationError -> Either VerificationError Verification
forall a. VerificationError -> Either VerificationError a
verificationError (Maybe EightOctetKeyId -> Maybe Fingerprint -> VerificationError
SigningKeyNotFound (Pkt -> Maybe EightOctetKeyId
issuer Pkt
sig) (Pkt -> Maybe Fingerprint
issuerFP Pkt
sig))
            else VerificationError -> Either VerificationError Verification
forall a. VerificationError -> Either VerificationError a
verificationError ([VerificationError] -> VerificationError
CandidateKeyFailures [VerificationError]
candidateErrors)
        else
          case [SomePKPayload]
-> Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyAgainstPKPs [SomePKPayload]
usablePkps Pkt
sig Maybe UTCTime
verificationTime ByteString
payload of
            Left (CandidateKeyFailures [VerificationError]
errs)
              | Bool -> Bool
not ([VerificationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VerificationError]
candidateErrors) ->
                  VerificationError -> Either VerificationError Verification
forall a. VerificationError -> Either VerificationError a
verificationError ([VerificationError] -> VerificationError
CandidateKeyFailures ([VerificationError]
candidateErrors [VerificationError] -> [VerificationError] -> [VerificationError]
forall a. [a] -> [a] -> [a]
++ [VerificationError]
errs))
            Either VerificationError Verification
other -> Either VerificationError Verification
other

verifyAgainstKeys ::
     [TKUnknown] -> Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification
verifyAgainstKeys :: [TKUnknown]
-> Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyAgainstKeys [TKUnknown]
ks Pkt
sig Maybe UTCTime
mt ByteString
payload = do
  let allpkps :: [SomePKPayload]
allpkps =
        (SomePKPayload -> Bool) -> [SomePKPayload] -> [SomePKPayload]
forall a. (a -> Bool) -> [a] -> [a]
filter
          (\SomePKPayload
x ->
             (((SomePKPayload -> Fingerprint
fingerprint SomePKPayload
x Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
==) (Fingerprint -> Bool) -> Maybe Fingerprint -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pkt -> Maybe Fingerprint
issuerFP Pkt
sig) Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) Bool -> Bool -> Bool
||
             (EightOctetKeyId -> EightOctetKeyId -> Bool
forall a. Eq a => a -> a -> Bool
(==) (EightOctetKeyId -> EightOctetKeyId -> Bool)
-> Maybe EightOctetKeyId -> Maybe (EightOctetKeyId -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pkt -> Maybe EightOctetKeyId
issuer Pkt
sig Maybe (EightOctetKeyId -> Bool)
-> Maybe EightOctetKeyId -> Maybe Bool
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String EightOctetKeyId -> Maybe EightOctetKeyId
forall a b. Either a b -> Maybe b
hush (SomePKPayload -> Either String EightOctetKeyId
eightOctetKeyID SomePKPayload
x)) Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
==
             Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
          ((TKUnknown -> [SomePKPayload]) -> [TKUnknown] -> [SomePKPayload]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\TKUnknown
x -> (TKUnknown
x TKUnknown
-> Getting SomePKPayload TKUnknown SomePKPayload -> SomePKPayload
forall s a. s -> Getting a s a -> a
^. ((SomePKPayload, Maybe SKAddendum)
 -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> TKUnknown -> Const SomePKPayload TKUnknown
Lens' TKUnknown (SomePKPayload, Maybe SKAddendum)
tkuKey (((SomePKPayload, Maybe SKAddendum)
  -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
 -> TKUnknown -> Const SomePKPayload TKUnknown)
-> ((SomePKPayload -> Const SomePKPayload SomePKPayload)
    -> (SomePKPayload, Maybe SKAddendum)
    -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> Getting SomePKPayload TKUnknown SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomePKPayload -> Const SomePKPayload SomePKPayload)
-> (SomePKPayload, Maybe SKAddendum)
-> Const SomePKPayload (SomePKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SomePKPayload, Maybe SKAddendum)
  (SomePKPayload, Maybe SKAddendum)
  SomePKPayload
  SomePKPayload
_1) SomePKPayload -> [SomePKPayload] -> [SomePKPayload]
forall a. a -> [a] -> [a]
: ((Pkt, [SignaturePayload]) -> Maybe SomePKPayload)
-> [(Pkt, [SignaturePayload])] -> [SomePKPayload]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Pkt -> Maybe SomePKPayload
subkeyPKPFromPkt (Pkt -> Maybe SomePKPayload)
-> ((Pkt, [SignaturePayload]) -> Pkt)
-> (Pkt, [SignaturePayload])
-> Maybe SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt, [SignaturePayload]) -> Pkt
forall a b. (a, b) -> a
fst) (TKUnknown -> [(Pkt, [SignaturePayload])]
_tkuSubs TKUnknown
x)) [TKUnknown]
ks)
      allCandidatePkps :: [SomePKPayload]
allCandidatePkps =
        (TKUnknown -> [SomePKPayload]) -> [TKUnknown] -> [SomePKPayload]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\TKUnknown
x -> (TKUnknown
x TKUnknown
-> Getting SomePKPayload TKUnknown SomePKPayload -> SomePKPayload
forall s a. s -> Getting a s a -> a
^. ((SomePKPayload, Maybe SKAddendum)
 -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> TKUnknown -> Const SomePKPayload TKUnknown
Lens' TKUnknown (SomePKPayload, Maybe SKAddendum)
tkuKey (((SomePKPayload, Maybe SKAddendum)
  -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
 -> TKUnknown -> Const SomePKPayload TKUnknown)
-> ((SomePKPayload -> Const SomePKPayload SomePKPayload)
    -> (SomePKPayload, Maybe SKAddendum)
    -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> Getting SomePKPayload TKUnknown SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomePKPayload -> Const SomePKPayload SomePKPayload)
-> (SomePKPayload, Maybe SKAddendum)
-> Const SomePKPayload (SomePKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SomePKPayload, Maybe SKAddendum)
  (SomePKPayload, Maybe SKAddendum)
  SomePKPayload
  SomePKPayload
_1) SomePKPayload -> [SomePKPayload] -> [SomePKPayload]
forall a. a -> [a] -> [a]
: ((Pkt, [SignaturePayload]) -> Maybe SomePKPayload)
-> [(Pkt, [SignaturePayload])] -> [SomePKPayload]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Pkt -> Maybe SomePKPayload
subkeyPKPFromPkt (Pkt -> Maybe SomePKPayload)
-> ((Pkt, [SignaturePayload]) -> Pkt)
-> (Pkt, [SignaturePayload])
-> Maybe SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt, [SignaturePayload]) -> Pkt
forall a b. (a, b) -> a
fst) (TKUnknown -> [(Pkt, [SignaturePayload])]
_tkuSubs TKUnknown
x)) [TKUnknown]
ks
      normalizedCandidates :: [SomePKPayload]
normalizedCandidates
        | [SomePKPayload] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SomePKPayload]
allpkps = [SomePKPayload]
allCandidatePkps
        | Bool
otherwise = [SomePKPayload]
allpkps
  [SomePKPayload]
-> Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyAgainstPKPs [SomePKPayload]
normalizedCandidates Pkt
sig Maybe UTCTime
mt ByteString
payload

verifyAgainstPKPs ::
     [SomePKPayload] -> Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification
verifyAgainstPKPs :: [SomePKPayload]
-> Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyAgainstPKPs [SomePKPayload]
pkps Pkt
sig Maybe UTCTime
mt ByteString
payload =
  case [Either VerificationError Verification] -> [Verification]
forall a b. [Either a b] -> [b]
rights [Either VerificationError Verification]
results of
    [] -> VerificationError -> Either VerificationError Verification
forall a. VerificationError -> Either VerificationError a
verificationError ([VerificationError] -> VerificationError
CandidateKeyFailures ([Either VerificationError Verification] -> [VerificationError]
forall a b. [Either a b] -> [a]
lefts [Either VerificationError Verification]
results))
    [Verification
r] -> Pkt -> Maybe UTCTime -> Either VerificationError Bool
isSignatureExpired Pkt
sig Maybe UTCTime
mt Either VerificationError Bool
-> Either VerificationError Verification
-> Either VerificationError Verification
forall a b.
Either VerificationError a
-> Either VerificationError b -> Either VerificationError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Verification -> Either VerificationError Verification
forall a. a -> Either VerificationError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verification
r
    [Verification]
rs -> VerificationError -> Either VerificationError Verification
forall a. VerificationError -> Either VerificationError a
verificationError (Int -> VerificationError
MultipleVerificationSuccesses ([Verification] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Verification]
rs))
  where
    results :: [Either VerificationError Verification]
results = (SomePKPayload -> Either VerificationError Verification)
-> [SomePKPayload] -> [Either VerificationError Verification]
forall a b. (a -> b) -> [a] -> [b]
map (\SomePKPayload
pkp -> SomePKPayload
-> Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyAgainstKey' SomePKPayload
pkp Pkt
sig Maybe UTCTime
mt ByteString
payload) [SomePKPayload]
pkps

resolveCandidateSignerPKPs ::
     [TKUnknown]
  -> Pkt
  -> Maybe UTCTime
  -> (SomePKPayload -> Bool)
  -> TKUnknown
  -> ([VerificationError], [SomePKPayload])
resolveCandidateSignerPKPs :: [TKUnknown]
-> Pkt
-> Maybe UTCTime
-> (SomePKPayload -> Bool)
-> TKUnknown
-> ([VerificationError], [SomePKPayload])
resolveCandidateSignerPKPs [TKUnknown]
_ Pkt
_ Maybe UTCTime
Nothing SomePKPayload -> Bool
matchesP TKUnknown
tk =
  ([], (SomePKPayload -> Bool) -> [SomePKPayload] -> [SomePKPayload]
forall a. (a -> Bool) -> [a] -> [a]
filter SomePKPayload -> Bool
matchesP (TKUnknown -> [SomePKPayload]
candidatePKPs TKUnknown
tk))
resolveCandidateSignerPKPs [TKUnknown]
allKeys Pkt
_ (Just UTCTime
validationTime) SomePKPayload -> Bool
matchesP TKUnknown
tk =
  let rawMatches :: [SomePKPayload]
rawMatches = (SomePKPayload -> Bool) -> [SomePKPayload] -> [SomePKPayload]
forall a. (a -> Bool) -> [a] -> [a]
filter SomePKPayload -> Bool
matchesP (TKUnknown -> [SomePKPayload]
candidatePKPs TKUnknown
tk)
  in case (Pkt
 -> PktStreamContext
 -> Maybe UTCTime
 -> Either VerificationError Verification)
-> Maybe UTCTime -> TKUnknown -> Either VerificationError TKUnknown
verifyUnknownTKWith ((Pkt
 -> Maybe UTCTime
 -> ByteString
 -> Either VerificationError Verification)
-> Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either VerificationError Verification
verifySigWith ([TKUnknown]
-> Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyAgainstKeys [TKUnknown]
allKeys)) (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
validationTime) TKUnknown
tk of
        Left VerificationError
err -> (Int -> VerificationError -> [VerificationError]
forall a. Int -> a -> [a]
replicate ([SomePKPayload] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SomePKPayload]
rawMatches) VerificationError
err, [])
        Right TKUnknown
verifiedTK ->
          let verifiedMatches :: [Either VerificationError SomePKPayload]
verifiedMatches =
               (SomePKPayload -> Either VerificationError SomePKPayload)
-> [SomePKPayload] -> [Either VerificationError SomePKPayload]
forall a b. (a -> b) -> [a] -> [b]
map
                 (\SomePKPayload
pkp ->
                    case UTCTime
-> TKUnknown -> SomePKPayload -> Either VerificationError ()
historicallyValidSigner UTCTime
validationTime (SomePKPayload -> TKUnknown -> TKUnknown
timelineValidationTK SomePKPayload
pkp TKUnknown
verifiedTK) SomePKPayload
pkp of
                      Right () -> SomePKPayload -> Either VerificationError SomePKPayload
forall a b. b -> Either a b
Right SomePKPayload
pkp
                      Left VerificationError
err -> VerificationError -> Either VerificationError SomePKPayload
forall a b. a -> Either a b
Left VerificationError
err)
                 [SomePKPayload]
rawMatches
          in ([Either VerificationError SomePKPayload] -> [VerificationError]
forall a b. [Either a b] -> [a]
lefts [Either VerificationError SomePKPayload]
verifiedMatches, [Either VerificationError SomePKPayload] -> [SomePKPayload]
forall a b. [Either a b] -> [b]
rights [Either VerificationError SomePKPayload]
verifiedMatches)
        where
          timelineValidationTK :: SomePKPayload -> TKUnknown -> TKUnknown
timelineValidationTK SomePKPayload
pkp TKUnknown
verifiedTK'
            | SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pkp Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== SomePKPayload -> Fingerprint
fingerprint (TKUnknown
tk TKUnknown
-> Getting SomePKPayload TKUnknown SomePKPayload -> SomePKPayload
forall s a. s -> Getting a s a -> a
^. ((SomePKPayload, Maybe SKAddendum)
 -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> TKUnknown -> Const SomePKPayload TKUnknown
Lens' TKUnknown (SomePKPayload, Maybe SKAddendum)
tkuKey (((SomePKPayload, Maybe SKAddendum)
  -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
 -> TKUnknown -> Const SomePKPayload TKUnknown)
-> ((SomePKPayload -> Const SomePKPayload SomePKPayload)
    -> (SomePKPayload, Maybe SKAddendum)
    -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> Getting SomePKPayload TKUnknown SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomePKPayload -> Const SomePKPayload SomePKPayload)
-> (SomePKPayload, Maybe SKAddendum)
-> Const SomePKPayload (SomePKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SomePKPayload, Maybe SKAddendum)
  (SomePKPayload, Maybe SKAddendum)
  SomePKPayload
  SomePKPayload
_1) = TKUnknown
tk
            | Bool
otherwise = TKUnknown
verifiedTK'

candidatePKPs :: TKUnknown -> [SomePKPayload]
candidatePKPs :: TKUnknown -> [SomePKPayload]
candidatePKPs TKUnknown
tk = (TKUnknown
tk TKUnknown
-> Getting SomePKPayload TKUnknown SomePKPayload -> SomePKPayload
forall s a. s -> Getting a s a -> a
^. ((SomePKPayload, Maybe SKAddendum)
 -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> TKUnknown -> Const SomePKPayload TKUnknown
Lens' TKUnknown (SomePKPayload, Maybe SKAddendum)
tkuKey (((SomePKPayload, Maybe SKAddendum)
  -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
 -> TKUnknown -> Const SomePKPayload TKUnknown)
-> ((SomePKPayload -> Const SomePKPayload SomePKPayload)
    -> (SomePKPayload, Maybe SKAddendum)
    -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> Getting SomePKPayload TKUnknown SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomePKPayload -> Const SomePKPayload SomePKPayload)
-> (SomePKPayload, Maybe SKAddendum)
-> Const SomePKPayload (SomePKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SomePKPayload, Maybe SKAddendum)
  (SomePKPayload, Maybe SKAddendum)
  SomePKPayload
  SomePKPayload
_1) SomePKPayload -> [SomePKPayload] -> [SomePKPayload]
forall a. a -> [a] -> [a]
: ((Pkt, [SignaturePayload]) -> Maybe SomePKPayload)
-> [(Pkt, [SignaturePayload])] -> [SomePKPayload]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Pkt -> Maybe SomePKPayload
subkeyPKPFromPkt (Pkt -> Maybe SomePKPayload)
-> ((Pkt, [SignaturePayload]) -> Pkt)
-> (Pkt, [SignaturePayload])
-> Maybe SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt, [SignaturePayload]) -> Pkt
forall a b. (a, b) -> a
fst) (TKUnknown
tk TKUnknown
-> Getting
     [(Pkt, [SignaturePayload])] TKUnknown [(Pkt, [SignaturePayload])]
-> [(Pkt, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Pkt, [SignaturePayload])] TKUnknown [(Pkt, [SignaturePayload])]
Lens' TKUnknown [(Pkt, [SignaturePayload])]
tkuSubs)

historicallyValidSigner ::   
     UTCTime -> TKUnknown -> SomePKPayload -> Either VerificationError ()
historicallyValidSigner :: UTCTime
-> TKUnknown -> SomePKPayload -> Either VerificationError ()
historicallyValidSigner UTCTime
validationTime TKUnknown
tk SomePKPayload
pkp
  | SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pkp Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== SomePKPayload -> Fingerprint
fingerprint (TKUnknown
tk TKUnknown
-> Getting SomePKPayload TKUnknown SomePKPayload -> SomePKPayload
forall s a. s -> Getting a s a -> a
^. ((SomePKPayload, Maybe SKAddendum)
 -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> TKUnknown -> Const SomePKPayload TKUnknown
Lens' TKUnknown (SomePKPayload, Maybe SKAddendum)
tkuKey (((SomePKPayload, Maybe SKAddendum)
  -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
 -> TKUnknown -> Const SomePKPayload TKUnknown)
-> ((SomePKPayload -> Const SomePKPayload SomePKPayload)
    -> (SomePKPayload, Maybe SKAddendum)
    -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> Getting SomePKPayload TKUnknown SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomePKPayload -> Const SomePKPayload SomePKPayload)
-> (SomePKPayload, Maybe SKAddendum)
-> Const SomePKPayload (SomePKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SomePKPayload, Maybe SKAddendum)
  (SomePKPayload, Maybe SKAddendum)
  SomePKPayload
  SomePKPayload
_1) =
      if KeyState -> Bool
keyStateValid (UTCTime -> TKUnknown -> KeyState
keyStateAt UTCTime
validationTime TKUnknown
tk)
         then () -> Either VerificationError ()
forall a b. b -> Either a b
Right ()
         else VerificationError -> Either VerificationError ()
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
SigningKeyUnavailableAtSignatureTime
  | Bool
otherwise =
      case ((Pkt, [SignaturePayload]) -> Bool)
-> [(Pkt, [SignaturePayload])] -> Maybe (Pkt, [SignaturePayload])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Pkt
pkt, [SignaturePayload]
_) -> Bool -> (SomePKPayload -> Bool) -> Maybe SomePKPayload -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pkp) (Fingerprint -> Bool)
-> (SomePKPayload -> Fingerprint) -> SomePKPayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomePKPayload -> Fingerprint
fingerprint) (Pkt -> Maybe SomePKPayload
subkeyPKPFromPkt Pkt
pkt)) (TKUnknown
tk TKUnknown
-> Getting
     [(Pkt, [SignaturePayload])] TKUnknown [(Pkt, [SignaturePayload])]
-> [(Pkt, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Pkt, [SignaturePayload])] TKUnknown [(Pkt, [SignaturePayload])]
Lens' TKUnknown [(Pkt, [SignaturePayload])]
tkuSubs) of
        Maybe (Pkt, [SignaturePayload])
Nothing -> VerificationError -> Either VerificationError ()
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
SigningKeyUnavailableAtSignatureTime
        Just (Pkt
subPkt, [SignaturePayload]
sigs) ->
          case Pkt -> Maybe SomePKPayload
subkeyPKPFromPkt Pkt
subPkt of
            Maybe SomePKPayload
Nothing -> VerificationError -> Either VerificationError ()
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
SigningKeyUnavailableAtSignatureTime
            Just SomePKPayload
subPKP ->
              if UTCTime -> SomePKPayload -> [SignaturePayload] -> Bool
isPKTimeValidWithSelfSignatures UTCTime
validationTime SomePKPayload
subPKP [SignaturePayload]
sigs
                then () -> Either VerificationError ()
forall a b. b -> Either a b
Right ()
                else VerificationError -> Either VerificationError ()
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
SigningKeyUnavailableAtSignatureTime

signatureCreationTimeFromPacket :: Pkt -> Maybe UTCTime
signatureCreationTimeFromPacket :: Pkt -> Maybe UTCTime
signatureCreationTimeFromPacket (SignaturePkt SignaturePayload
sigPayload) = SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
sigPayload
signatureCreationTimeFromPacket Pkt
_ = Maybe UTCTime
forall a. Maybe a
Nothing

signatureCreationTime :: SignaturePayload -> Maybe UTCTime
signatureCreationTime :: SignaturePayload -> Maybe UTCTime
signatureCreationTime =
  (ThirtyTwoBitTimeStamp -> UTCTime)
-> Maybe ThirtyTwoBitTimeStamp -> Maybe UTCTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> (ThirtyTwoBitTimeStamp -> NominalDiffTime)
-> ThirtyTwoBitTimeStamp
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Word32 -> NominalDiffTime)
-> (ThirtyTwoBitTimeStamp -> Word32)
-> ThirtyTwoBitTimeStamp
-> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitTimeStamp -> Word32
unThirtyTwoBitTimeStamp) (Maybe ThirtyTwoBitTimeStamp -> Maybe UTCTime)
-> (SignaturePayload -> Maybe ThirtyTwoBitTimeStamp)
-> SignaturePayload
-> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe ThirtyTwoBitTimeStamp
sigCT

signatureKnownAt :: Maybe UTCTime -> SignaturePayload -> Bool
signatureKnownAt :: Maybe UTCTime -> SignaturePayload -> Bool
signatureKnownAt Maybe UTCTime
Nothing SignaturePayload
_ = Bool
True
signatureKnownAt (Just UTCTime
validationTime) SignaturePayload
sigPayload =
  Bool -> (UTCTime -> Bool) -> Maybe UTCTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
validationTime) (SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
sigPayload)

signatureEffectiveAt :: Maybe UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt :: Maybe UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt Maybe UTCTime
Nothing SignaturePayload
_ = Bool
True
signatureEffectiveAt (Just UTCTime
validationTime) SignaturePayload
sigPayload =
  Maybe UTCTime -> SignaturePayload -> Bool
signatureKnownAt (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
validationTime) SignaturePayload
sigPayload Bool -> Bool -> Bool
&&
  Bool -> (UTCTime -> Bool) -> Maybe UTCTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (UTCTime
validationTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<) (SignaturePayload -> Maybe UTCTime
signatureExpirationTime SignaturePayload
sigPayload)

signatureUnexpiredAt :: Maybe UTCTime -> SignaturePayload -> Bool
signatureUnexpiredAt :: Maybe UTCTime -> SignaturePayload -> Bool
signatureUnexpiredAt Maybe UTCTime
Nothing SignaturePayload
_ = Bool
True
signatureUnexpiredAt (Just UTCTime
validationTime) SignaturePayload
sigPayload =
  Bool -> (UTCTime -> Bool) -> Maybe UTCTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (UTCTime
validationTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<) (SignaturePayload -> Maybe UTCTime
signatureExpirationTime SignaturePayload
sigPayload)

signatureExpirationTime :: SignaturePayload -> Maybe UTCTime
signatureExpirationTime :: SignaturePayload -> Maybe UTCTime
signatureExpirationTime SignaturePayload
sigPayload =
  UTCTime -> ThirtyTwoBitDuration -> UTCTime
addDurationToTime (UTCTime -> ThirtyTwoBitDuration -> UTCTime)
-> Maybe UTCTime -> Maybe (ThirtyTwoBitDuration -> UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
sigPayload Maybe (ThirtyTwoBitDuration -> UTCTime)
-> Maybe ThirtyTwoBitDuration -> Maybe UTCTime
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  SignaturePayload -> Maybe ThirtyTwoBitDuration
signatureExpirationDuration SignaturePayload
sigPayload

signatureExpirationDuration :: SignaturePayload -> Maybe ThirtyTwoBitDuration
signatureExpirationDuration :: SignaturePayload -> Maybe ThirtyTwoBitDuration
signatureExpirationDuration SignaturePayload
sigPayload =
  SignaturePayload -> Maybe [SigSubPacket]
signatureHashedSubpacketsKnown SignaturePayload
sigPayload Maybe [SigSubPacket]
-> ([SigSubPacket] -> Maybe ThirtyTwoBitDuration)
-> Maybe ThirtyTwoBitDuration
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SigSubPacket] -> Maybe ThirtyTwoBitDuration
firstSignatureExpirationDuration

firstSignatureExpirationDuration :: [SigSubPacket] -> Maybe ThirtyTwoBitDuration
firstSignatureExpirationDuration :: [SigSubPacket] -> Maybe ThirtyTwoBitDuration
firstSignatureExpirationDuration =
  (SigSubPacket
 -> Maybe ThirtyTwoBitDuration -> Maybe ThirtyTwoBitDuration)
-> Maybe ThirtyTwoBitDuration
-> [SigSubPacket]
-> Maybe ThirtyTwoBitDuration
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (\SigSubPacket
subpacket Maybe ThirtyTwoBitDuration
acc ->
       case SigSubPacket
subpacket of
         SigSubPacket Bool
_ (SigExpirationTime ThirtyTwoBitDuration
duration) -> ThirtyTwoBitDuration -> Maybe ThirtyTwoBitDuration
forall a. a -> Maybe a
Just ThirtyTwoBitDuration
duration
         SigSubPacket
_ -> Maybe ThirtyTwoBitDuration
acc)
    Maybe ThirtyTwoBitDuration
forall a. Maybe a
Nothing

addDurationToTime :: UTCTime -> ThirtyTwoBitDuration -> UTCTime
addDurationToTime :: UTCTime -> ThirtyTwoBitDuration -> UTCTime
addDurationToTime UTCTime
baseTime ThirtyTwoBitDuration
duration =
  NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Word32 -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ThirtyTwoBitDuration -> Word32
unThirtyTwoBitDuration ThirtyTwoBitDuration
duration)) UTCTime
baseTime

certificationStateAt ::
     Maybe UTCTime
  -> [(SignaturePayload, Verification)]
  -> (SignaturePayload, Verification)
  -> CertificationState
certificationStateAt :: Maybe UTCTime
-> [(SignaturePayload, Verification)]
-> (SignaturePayload, Verification)
-> CertificationState
certificationStateAt Maybe UTCTime
validationTime [(SignaturePayload, Verification)]
verified certification :: (SignaturePayload, Verification)
certification@(SignaturePayload
certificationSig, Verification
_)
  | Bool -> Bool
not (Maybe UTCTime -> SignaturePayload -> Bool
signatureKnownAt Maybe UTCTime
validationTime SignaturePayload
certificationSig) = CertificationState
CertificationNotYetKnown
  | Bool -> Bool
not (Maybe UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt Maybe UTCTime
validationTime SignaturePayload
certificationSig) = CertificationState
CertificationRevoked
  | ((SignaturePayload, Verification) -> Bool)
-> [(SignaturePayload, Verification)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((SignaturePayload, Verification)
-> (SignaturePayload, Verification) -> Bool
`revokesCertification` (SignaturePayload, Verification)
certification) [(SignaturePayload, Verification)]
visibleRevocations = CertificationState
CertificationRevoked
  | Bool
otherwise = CertificationState
CertificationActive
  where
    visibleRevocations :: [(SignaturePayload, Verification)]
visibleRevocations =
      ((SignaturePayload, Verification) -> Bool)
-> [(SignaturePayload, Verification)]
-> [(SignaturePayload, Verification)]
forall a. (a -> Bool) -> [a] -> [a]
filter
        (Maybe UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt Maybe UTCTime
validationTime (SignaturePayload -> Bool)
-> ((SignaturePayload, Verification) -> SignaturePayload)
-> (SignaturePayload, Verification)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload, Verification) -> SignaturePayload
forall a b. (a, b) -> a
fst)
        (((SignaturePayload, Verification) -> Bool)
-> [(SignaturePayload, Verification)]
-> [(SignaturePayload, Verification)]
forall a. (a -> Bool) -> [a] -> [a]
filter (SignaturePayload -> Bool
isCertRevocationSig (SignaturePayload -> Bool)
-> ((SignaturePayload, Verification) -> SignaturePayload)
-> (SignaturePayload, Verification)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload, Verification) -> SignaturePayload
forall a b. (a, b) -> a
fst) [(SignaturePayload, Verification)]
verified)

revokesCertification ::
     (SignaturePayload, Verification)
  -> (SignaturePayload, Verification)
  -> Bool
revokesCertification :: (SignaturePayload, Verification)
-> (SignaturePayload, Verification) -> Bool
revokesCertification (SignaturePayload
revocationSig, Verification
revocationVerification) (SignaturePayload
certificationSig, Verification
certificationVerification) =
  Bool
sameSigner Bool -> Bool -> Bool
&& SignaturePayload -> SignaturePayload -> Bool
certificationPrecedesRevocation SignaturePayload
certificationSig SignaturePayload
revocationSig
  where
    sameSigner :: Bool
sameSigner =
      SomePKPayload -> Fingerprint
fingerprint (Verification
revocationVerification Verification
-> Getting SomePKPayload Verification SomePKPayload
-> SomePKPayload
forall s a. s -> Getting a s a -> a
^. Getting SomePKPayload Verification SomePKPayload
Lens' Verification SomePKPayload
verificationSigner) Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
==
      SomePKPayload -> Fingerprint
fingerprint (Verification
certificationVerification Verification
-> Getting SomePKPayload Verification SomePKPayload
-> SomePKPayload
forall s a. s -> Getting a s a -> a
^. Getting SomePKPayload Verification SomePKPayload
Lens' Verification SomePKPayload
verificationSigner)

certificationPrecedesRevocation ::
     SignaturePayload -> SignaturePayload -> Bool
certificationPrecedesRevocation :: SignaturePayload -> SignaturePayload -> Bool
certificationPrecedesRevocation SignaturePayload
certificationSig SignaturePayload
revocationSig =
  case (SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
certificationSig, SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
revocationSig) of
    (Just UTCTime
certificationTime, Just UTCTime
revocationTime) ->
      UTCTime
certificationTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
revocationTime
    (Maybe UTCTime, Maybe UTCTime)
_ -> Bool
False

isHistoricalKeyRevocation :: SignaturePayload -> Bool
isHistoricalKeyRevocation :: SignaturePayload -> Bool
isHistoricalKeyRevocation SignaturePayload
sigPayload =
  case SignaturePayload -> Maybe RevocationCode
revocationReasonCode SignaturePayload
sigPayload of
    Just RevocationCode
KeySuperseded -> Bool
True
    Just RevocationCode
KeyRetiredAndNoLongerUsed -> Bool
True
    Just RevocationCode
UserIdInfoNoLongerValid -> Bool
True
    Maybe RevocationCode
_ -> Bool
False

revocationReasonCode :: SignaturePayload -> Maybe RevocationCode
revocationReasonCode :: SignaturePayload -> Maybe RevocationCode
revocationReasonCode SignaturePayload
sigPayload =
  (\(SigSubPacket Bool
_ (ReasonForRevocation RevocationCode
reasonCode Text
_)) -> RevocationCode
reasonCode) (SigSubPacket -> RevocationCode)
-> Maybe SigSubPacket -> Maybe RevocationCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (SigSubPacket -> Bool) -> [SigSubPacket] -> Maybe SigSubPacket
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find SigSubPacket -> Bool
isReasonForRevocation (SignaturePayload -> [SigSubPacket]
signatureSubpackets SignaturePayload
sigPayload)
  where
    isReasonForRevocation :: SigSubPacket -> Bool
isReasonForRevocation (SigSubPacket Bool
_ ReasonForRevocation {}) = Bool
True
    isReasonForRevocation SigSubPacket
_ = Bool
False

signatureSubpackets :: SignaturePayload -> [SigSubPacket]
signatureSubpackets :: SignaturePayload -> [SigSubPacket]
signatureSubpackets SignaturePayload
sigPayload =
  case SignaturePayload -> Maybe ([SigSubPacket], [SigSubPacket])
signatureSubpacketListsKnown SignaturePayload
sigPayload of
    Just ([SigSubPacket]
hashed, [SigSubPacket]
unhashed) -> [SigSubPacket]
hashed [SigSubPacket] -> [SigSubPacket] -> [SigSubPacket]
forall a. [a] -> [a] -> [a]
++ [SigSubPacket]
unhashed
    Maybe ([SigSubPacket], [SigSubPacket])
Nothing -> []

signatureHashedSubpackets :: SignaturePayload -> [SigSubPacket]
signatureHashedSubpackets :: SignaturePayload -> [SigSubPacket]
signatureHashedSubpackets SignaturePayload
sigPayload =
  [SigSubPacket]
-> ([SigSubPacket] -> [SigSubPacket])
-> Maybe [SigSubPacket]
-> [SigSubPacket]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [SigSubPacket] -> [SigSubPacket]
forall a. a -> a
id (SignaturePayload -> Maybe [SigSubPacket]
signatureHashedSubpacketsKnown SignaturePayload
sigPayload)

subkeyPKPFromPkt :: Pkt -> Maybe SomePKPayload
subkeyPKPFromPkt :: Pkt -> Maybe SomePKPayload
subkeyPKPFromPkt (PublicSubkeyPkt SomePKPayload
p) = SomePKPayload -> Maybe SomePKPayload
forall a. a -> Maybe a
Just SomePKPayload
p
subkeyPKPFromPkt (SecretSubkeyPkt SomePKPayload
p SKAddendum
_) = SomePKPayload -> Maybe SomePKPayload
forall a. a -> Maybe a
Just SomePKPayload
p
subkeyPKPFromPkt Pkt
_ = Maybe SomePKPayload
forall a. Maybe a
Nothing

verifyAgainstKey' :: SomePKPayload -> Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification
verifyAgainstKey' :: SomePKPayload
-> Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyAgainstKey' SomePKPayload
pkp Pkt
sig Maybe UTCTime
mt ByteString
payload = do
      sigClass <-
        (String -> Either VerificationError SomeSignatureV)
-> (SomeSignatureV -> Either VerificationError SomeSignatureV)
-> Either String SomeSignatureV
-> Either VerificationError SomeSignatureV
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
          (VerificationError -> Either VerificationError SomeSignatureV
forall a. VerificationError -> Either VerificationError a
verificationError (VerificationError -> Either VerificationError SomeSignatureV)
-> (String -> VerificationError)
-> String
-> Either VerificationError SomeSignatureV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> String -> VerificationError
forall a b. a -> b -> a
const VerificationError
NonSignaturePacket)
          SomeSignatureV -> Either VerificationError SomeSignatureV
forall a b. b -> Either a b
Right
          (Pkt -> Either String SomeSignatureV
fromPktEitherSomeSignatureV Pkt
sig)
      let sigPayload =
            case SomeSignatureV
sigClass of
              SomeSignatureV SignatureV v
typedSig -> SignatureV v -> SignaturePayload
forall (v :: SignaturePayloadVersion).
SignatureV v -> SignaturePayload
signaturePayloadFromSignatureV SignatureV v
typedSig
      sigHash <-
        maybe
          (verificationError MissingHashAlgorithm)
          Right
          (sigHA sigPayload)
      sigDetails <- signaturePKAAndMPIsFromClass sigClass
      enforcePKACompatibility sigPayload
      enforceSignatureHashPolicy sigHash
      _ <- isSignatureExpired sig mt
      let signedPayload = ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload Pkt
sig ByteString
payload)
      enforceLeft16Prefix sigClass sigHash signedPayload
      (\SomePKPayload
verifiedSigner -> SomePKPayload
-> SignaturePayload -> [VerificationWarning] -> Verification
Verification SomePKPayload
verifiedSigner SignaturePayload
sigPayload []) <$>
        verify' sigDetails pkp sigHash signedPayload
  where
    enforcePKACompatibility :: SignaturePayload -> Either VerificationError ()
enforcePKACompatibility SignaturePayload
sigPayload =
      let sigPka :: PubKeyAlgorithm
sigPka = PubKeyAlgorithm
-> (PubKeyAlgorithm -> PubKeyAlgorithm)
-> Maybe PubKeyAlgorithm
-> PubKeyAlgorithm
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Word8 -> PubKeyAlgorithm
OtherPKA Word8
0) PubKeyAlgorithm -> PubKeyAlgorithm
forall a. a -> a
id (SignaturePayload -> Maybe PubKeyAlgorithm
sigPKA SignaturePayload
sigPayload)
          keyPka :: PubKeyAlgorithm
keyPka = SomePKPayload -> PubKeyAlgorithm
_pkalgo SomePKPayload
pkp
       in if PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
pkaCompatible PubKeyAlgorithm
sigPka PubKeyAlgorithm
keyPka
            then () -> Either VerificationError ()
forall a b. b -> Either a b
Right ()
            else VerificationError -> Either VerificationError ()
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> PubKeyAlgorithm -> VerificationError
SignaturePolicyPKAMismatch PubKeyAlgorithm
sigPka PubKeyAlgorithm
keyPka)
    enforceSignatureHashPolicy :: HashAlgorithm -> Either VerificationError ()
enforceSignatureHashPolicy HashAlgorithm
sigHash =
      case HashAlgorithm
sigHash of
        OtherHA {} -> VerificationError -> Either VerificationError ()
forall a. VerificationError -> Either VerificationError a
verificationError (HashAlgorithm -> VerificationError
SignaturePolicyHashUnsupported HashAlgorithm
sigHash)
        HashAlgorithm
_ -> () -> Either VerificationError ()
forall a b. b -> Either a b
Right ()
    enforceLeft16Prefix :: SomeSignatureV
-> HashAlgorithm -> ByteString -> Either VerificationError ()
enforceLeft16Prefix SomeSignatureV
sigClass HashAlgorithm
sigHash ByteString
signedPayload = do
      expectedLeft16 <-
        (String -> Either VerificationError Word16)
-> (Word16 -> Either VerificationError Word16)
-> Either String Word16
-> Either VerificationError Word16
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
          (VerificationError -> Either VerificationError Word16
forall a. VerificationError -> Either VerificationError a
verificationError (VerificationError -> Either VerificationError Word16)
-> (String -> VerificationError)
-> String
-> Either VerificationError Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VerificationError
HashComputationFailed)
          Word16 -> Either VerificationError Word16
forall a b. b -> Either a b
Right
          (HashAlgorithm -> ByteString -> Either String Word16
left16FromSignedPayload HashAlgorithm
sigHash ByteString
signedPayload)
      actualLeft16 <- signatureLeft16FromClass sigClass
      if actualLeft16 == expectedLeft16
        then Right ()
        else
          verificationError
            (SignatureMismatch (_pkalgo pkp) (fingerprint pkp))
    pkaCompatible :: PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
pkaCompatible PubKeyAlgorithm
RSA PubKeyAlgorithm
keyPka =
      PubKeyAlgorithm
keyPka PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
RSA, PubKeyAlgorithm
DeprecatedRSAEncryptOnly, PubKeyAlgorithm
DeprecatedRSASignOnly]
    pkaCompatible PubKeyAlgorithm
DeprecatedRSASignOnly PubKeyAlgorithm
keyPka =
      PubKeyAlgorithm
keyPka PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
RSA, PubKeyAlgorithm
DeprecatedRSASignOnly]
    pkaCompatible PubKeyAlgorithm
PKA.EdDSA PubKeyAlgorithm
keyPka =
      PubKeyAlgorithm
keyPka PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
PKA.EdDSA, PubKeyAlgorithm
PKA.Ed25519, PubKeyAlgorithm
PKA.Ed448]
    pkaCompatible PubKeyAlgorithm
PKA.Ed25519 PubKeyAlgorithm
keyPka =
      PubKeyAlgorithm
keyPka PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
PKA.EdDSA, PubKeyAlgorithm
PKA.Ed25519]
    pkaCompatible PubKeyAlgorithm
PKA.Ed448 PubKeyAlgorithm
keyPka =
      PubKeyAlgorithm
keyPka PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
PKA.EdDSA, PubKeyAlgorithm
PKA.Ed448]
    pkaCompatible PubKeyAlgorithm
sigPka PubKeyAlgorithm
keyPka = PubKeyAlgorithm
sigPka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
keyPka
    verify' :: (PubKeyAlgorithm, NonEmpty MPI)
-> SomePKPayload
-> HashAlgorithm
-> ByteString
-> Either VerificationError SomePKPayload
verify' (PubKeyAlgorithm, NonEmpty MPI)
details pub :: SomePKPayload
pub@(PKPayload KeyVersion
V4 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
_ PKey
pkey) HashAlgorithm
ha ByteString
pl =
      (PubKeyAlgorithm, NonEmpty MPI)
-> SomePKPayload
-> PKey
-> HashAlgorithm
-> ByteString
-> Either VerificationError SomePKPayload
verifyByHash (PubKeyAlgorithm, NonEmpty MPI)
details SomePKPayload
pub PKey
pkey HashAlgorithm
ha ByteString
pl
    verify' (PubKeyAlgorithm, NonEmpty MPI)
details pub :: SomePKPayload
pub@(PKPayload KeyVersion
V6 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
_ PKey
pkey) HashAlgorithm
ha ByteString
pl =
      (PubKeyAlgorithm, NonEmpty MPI)
-> SomePKPayload
-> PKey
-> HashAlgorithm
-> ByteString
-> Either VerificationError SomePKPayload
verifyByHash (PubKeyAlgorithm, NonEmpty MPI)
details SomePKPayload
pub PKey
pkey HashAlgorithm
ha ByteString
pl
    verify' (PubKeyAlgorithm, NonEmpty MPI)
_ SomePKPayload
_ HashAlgorithm
_ ByteString
_ =
      VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError VerificationError
UnexpectedKeyVersion
    verifyByHash :: (PubKeyAlgorithm, NonEmpty MPI)
-> SomePKPayload
-> PKey
-> HashAlgorithm
-> ByteString
-> Either VerificationError SomePKPayload
verifyByHash (PubKeyAlgorithm, NonEmpty MPI)
details SomePKPayload
pub PKey
pkey HashAlgorithm
ha ByteString
pl =
      case HashAlgorithm
ha of
        HashAlgorithm
SHA1 -> (PubKeyAlgorithm, NonEmpty MPI)
-> SHA1
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
forall {hashAlg}.
HashAlgorithmASN1 hashAlg =>
(PubKeyAlgorithm, NonEmpty MPI)
-> hashAlg
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
verify'' (PubKeyAlgorithm, NonEmpty MPI)
details SHA1
CHA.SHA1 SomePKPayload
pub PKey
pkey ByteString
pl
        HashAlgorithm
RIPEMD160 -> (PubKeyAlgorithm, NonEmpty MPI)
-> RIPEMD160
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
forall {hashAlg}.
HashAlgorithmASN1 hashAlg =>
(PubKeyAlgorithm, NonEmpty MPI)
-> hashAlg
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
verify'' (PubKeyAlgorithm, NonEmpty MPI)
details RIPEMD160
CHA.RIPEMD160 SomePKPayload
pub PKey
pkey ByteString
pl
        HashAlgorithm
SHA224 -> (PubKeyAlgorithm, NonEmpty MPI)
-> SHA224
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
forall {hashAlg}.
HashAlgorithmASN1 hashAlg =>
(PubKeyAlgorithm, NonEmpty MPI)
-> hashAlg
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
verify'' (PubKeyAlgorithm, NonEmpty MPI)
details SHA224
CHA.SHA224 SomePKPayload
pub PKey
pkey ByteString
pl
        HashAlgorithm
SHA256 -> (PubKeyAlgorithm, NonEmpty MPI)
-> SHA256
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
forall {hashAlg}.
HashAlgorithmASN1 hashAlg =>
(PubKeyAlgorithm, NonEmpty MPI)
-> hashAlg
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
verify'' (PubKeyAlgorithm, NonEmpty MPI)
details SHA256
CHA.SHA256 SomePKPayload
pub PKey
pkey ByteString
pl
        HashAlgorithm
SHA384 -> (PubKeyAlgorithm, NonEmpty MPI)
-> SHA384
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
forall {hashAlg}.
HashAlgorithmASN1 hashAlg =>
(PubKeyAlgorithm, NonEmpty MPI)
-> hashAlg
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
verify'' (PubKeyAlgorithm, NonEmpty MPI)
details SHA384
CHA.SHA384 SomePKPayload
pub PKey
pkey ByteString
pl
        HashAlgorithm
SHA512 -> (PubKeyAlgorithm, NonEmpty MPI)
-> SHA512
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
forall {hashAlg}.
HashAlgorithmASN1 hashAlg =>
(PubKeyAlgorithm, NonEmpty MPI)
-> hashAlg
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
verify'' (PubKeyAlgorithm, NonEmpty MPI)
details SHA512
CHA.SHA512 SomePKPayload
pub PKey
pkey ByteString
pl
        HashAlgorithm
SHA3_256 -> HashAlgorithm
-> (PubKeyAlgorithm, NonEmpty MPI)
-> SHA3_256
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
forall {a} {alg}.
(ByteArrayAccess a, HashAlgorithm alg) =>
HashAlgorithm
-> (PubKeyAlgorithm, NonEmpty MPI)
-> alg
-> SomePKPayload
-> PKey
-> a
-> Either VerificationError SomePKPayload
verifyNoRSA HashAlgorithm
SHA3_256 (PubKeyAlgorithm, NonEmpty MPI)
details SHA3_256
CHA.SHA3_256 SomePKPayload
pub PKey
pkey ByteString
pl
        HashAlgorithm
SHA3_512 -> HashAlgorithm
-> (PubKeyAlgorithm, NonEmpty MPI)
-> SHA3_512
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
forall {a} {alg}.
(ByteArrayAccess a, HashAlgorithm alg) =>
HashAlgorithm
-> (PubKeyAlgorithm, NonEmpty MPI)
-> alg
-> SomePKPayload
-> PKey
-> a
-> Either VerificationError SomePKPayload
verifyNoRSA HashAlgorithm
SHA3_512 (PubKeyAlgorithm, NonEmpty MPI)
details SHA3_512
CHA.SHA3_512 SomePKPayload
pub PKey
pkey ByteString
pl
        HashAlgorithm
DeprecatedMD5 -> (PubKeyAlgorithm, NonEmpty MPI)
-> MD5
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
forall {hashAlg}.
HashAlgorithmASN1 hashAlg =>
(PubKeyAlgorithm, NonEmpty MPI)
-> hashAlg
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
verify'' (PubKeyAlgorithm, NonEmpty MPI)
details MD5
CHA.MD5 SomePKPayload
pub PKey
pkey ByteString
pl
        HashAlgorithm
_ ->
          VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (HashAlgorithm -> VerificationError
SignaturePolicyHashUnsupported HashAlgorithm
ha)
    verify'' :: (PubKeyAlgorithm, NonEmpty MPI)
-> hashAlg
-> SomePKPayload
-> PKey
-> ByteString
-> Either VerificationError SomePKPayload
verify'' (PubKeyAlgorithm
DSA, NonEmpty MPI
mpis) hashAlg
hd SomePKPayload
pub (DSAPubKey (DSA_PublicKey PublicKey
pkey)) ByteString
bs =
      SomePKPayload
-> NonEmpty MPI
-> hashAlg
-> PublicKey
-> ByteString
-> Either VerificationError SomePKPayload
forall {msg} {hash}.
(ByteArrayAccess msg, HashAlgorithm hash) =>
SomePKPayload
-> NonEmpty MPI
-> hash
-> PublicKey
-> msg
-> Either VerificationError SomePKPayload
dsaVerify SomePKPayload
pub NonEmpty MPI
mpis hashAlg
hd PublicKey
pkey ByteString
bs
    verify'' (PubKeyAlgorithm
ECDSA, NonEmpty MPI
mpis) hashAlg
hd SomePKPayload
pub (ECDSAPubKey (ECDSA_PublicKey PublicKey
pkey)) ByteString
bs =
      SomePKPayload
-> NonEmpty MPI
-> hashAlg
-> PublicKey
-> ByteString
-> Either VerificationError SomePKPayload
forall {msg} {hash}.
(ByteArrayAccess msg, HashAlgorithm hash) =>
SomePKPayload
-> NonEmpty MPI
-> hash
-> PublicKey
-> msg
-> Either VerificationError SomePKPayload
ecdsaVerify SomePKPayload
pub NonEmpty MPI
mpis hashAlg
hd PublicKey
pkey ByteString
bs
    verify'' (PubKeyAlgorithm
sigPka, NonEmpty MPI
mpis) hashAlg
hd SomePKPayload
pub (EdDSAPubKey EdSigningCurve
Ed25519 EdPoint
pkey) ByteString
bs
      | PubKeyAlgorithm
sigPka PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
EdDSA, PubKeyAlgorithm
PKA.Ed25519] =
          PubKeyAlgorithm
-> SomePKPayload
-> NonEmpty MPI
-> hashAlg
-> EdPoint
-> ByteString
-> Either VerificationError SomePKPayload
forall {alg} {a}.
(HashAlgorithm alg, ByteArrayAccess a) =>
PubKeyAlgorithm
-> SomePKPayload
-> NonEmpty MPI
-> alg
-> EdPoint
-> a
-> Either VerificationError SomePKPayload
ed25519Verify PubKeyAlgorithm
sigPka SomePKPayload
pub NonEmpty MPI
mpis hashAlg
hd EdPoint
pkey ByteString
bs
    verify'' (PubKeyAlgorithm
sigPka, NonEmpty MPI
mpis) hashAlg
hd SomePKPayload
pub (EdDSAPubKey EdSigningCurve
Ed448 EdPoint
pkey) ByteString
bs
      | PubKeyAlgorithm
sigPka PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
EdDSA, PubKeyAlgorithm
PKA.Ed448] =
          PubKeyAlgorithm
-> SomePKPayload
-> NonEmpty MPI
-> hashAlg
-> EdPoint
-> ByteString
-> Either VerificationError SomePKPayload
forall {alg} {a}.
(HashAlgorithm alg, ByteArrayAccess a) =>
PubKeyAlgorithm
-> SomePKPayload
-> NonEmpty MPI
-> alg
-> EdPoint
-> a
-> Either VerificationError SomePKPayload
ed448Verify PubKeyAlgorithm
sigPka SomePKPayload
pub NonEmpty MPI
mpis hashAlg
hd EdPoint
pkey ByteString
bs
    verify'' (PubKeyAlgorithm
RSA, NonEmpty MPI
mpis) hashAlg
hd SomePKPayload
pub (RSAPubKey (RSA_PublicKey PublicKey
pkey)) ByteString
bs =
      SomePKPayload
-> NonEmpty MPI
-> hashAlg
-> PublicKey
-> ByteString
-> Either VerificationError SomePKPayload
forall {hashAlg}.
HashAlgorithmASN1 hashAlg =>
SomePKPayload
-> NonEmpty MPI
-> hashAlg
-> PublicKey
-> ByteString
-> Either VerificationError SomePKPayload
rsaVerify SomePKPayload
pub NonEmpty MPI
mpis hashAlg
hd PublicKey
pkey ByteString
bs
    verify'' (PubKeyAlgorithm
pka, NonEmpty MPI
_) hashAlg
_ SomePKPayload
_ PKey
_ ByteString
_ = VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> VerificationError
UnsupportedKeyType PubKeyAlgorithm
pka)
    verifyNoRSA :: HashAlgorithm
-> (PubKeyAlgorithm, NonEmpty MPI)
-> alg
-> SomePKPayload
-> PKey
-> a
-> Either VerificationError SomePKPayload
verifyNoRSA HashAlgorithm
ha' (PubKeyAlgorithm
DSA, NonEmpty MPI
mpis) alg
hd SomePKPayload
pub (DSAPubKey (DSA_PublicKey PublicKey
pkey)) a
bs =
      SomePKPayload
-> NonEmpty MPI
-> alg
-> PublicKey
-> a
-> Either VerificationError SomePKPayload
forall {msg} {hash}.
(ByteArrayAccess msg, HashAlgorithm hash) =>
SomePKPayload
-> NonEmpty MPI
-> hash
-> PublicKey
-> msg
-> Either VerificationError SomePKPayload
dsaVerify SomePKPayload
pub NonEmpty MPI
mpis alg
hd PublicKey
pkey a
bs
    verifyNoRSA HashAlgorithm
ha' (PubKeyAlgorithm
ECDSA, NonEmpty MPI
mpis) alg
hd SomePKPayload
pub (ECDSAPubKey (ECDSA_PublicKey PublicKey
pkey)) a
bs =
      SomePKPayload
-> NonEmpty MPI
-> alg
-> PublicKey
-> a
-> Either VerificationError SomePKPayload
forall {msg} {hash}.
(ByteArrayAccess msg, HashAlgorithm hash) =>
SomePKPayload
-> NonEmpty MPI
-> hash
-> PublicKey
-> msg
-> Either VerificationError SomePKPayload
ecdsaVerify SomePKPayload
pub NonEmpty MPI
mpis alg
hd PublicKey
pkey a
bs
    verifyNoRSA HashAlgorithm
ha' (PubKeyAlgorithm
sigPka, NonEmpty MPI
mpis) alg
hd SomePKPayload
pub (EdDSAPubKey EdSigningCurve
Ed25519 EdPoint
pkey) a
bs
      | PubKeyAlgorithm
sigPka PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
EdDSA, PubKeyAlgorithm
PKA.Ed25519] =
          PubKeyAlgorithm
-> SomePKPayload
-> NonEmpty MPI
-> alg
-> EdPoint
-> a
-> Either VerificationError SomePKPayload
forall {alg} {a}.
(HashAlgorithm alg, ByteArrayAccess a) =>
PubKeyAlgorithm
-> SomePKPayload
-> NonEmpty MPI
-> alg
-> EdPoint
-> a
-> Either VerificationError SomePKPayload
ed25519Verify PubKeyAlgorithm
sigPka SomePKPayload
pub NonEmpty MPI
mpis alg
hd EdPoint
pkey a
bs
    verifyNoRSA HashAlgorithm
ha' (PubKeyAlgorithm
sigPka, NonEmpty MPI
mpis) alg
hd SomePKPayload
pub (EdDSAPubKey EdSigningCurve
Ed448 EdPoint
pkey) a
bs
      | PubKeyAlgorithm
sigPka PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
EdDSA, PubKeyAlgorithm
PKA.Ed448] =
          PubKeyAlgorithm
-> SomePKPayload
-> NonEmpty MPI
-> alg
-> EdPoint
-> a
-> Either VerificationError SomePKPayload
forall {alg} {a}.
(HashAlgorithm alg, ByteArrayAccess a) =>
PubKeyAlgorithm
-> SomePKPayload
-> NonEmpty MPI
-> alg
-> EdPoint
-> a
-> Either VerificationError SomePKPayload
ed448Verify PubKeyAlgorithm
sigPka SomePKPayload
pub NonEmpty MPI
mpis alg
hd EdPoint
pkey a
bs
    verifyNoRSA HashAlgorithm
ha' (PubKeyAlgorithm
RSA, NonEmpty MPI
_) alg
_ SomePKPayload
_ PKey
_ a
_ =
      VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (HashAlgorithm -> PubKeyAlgorithm -> VerificationError
SignatureHashUnsupportedByAlgorithm HashAlgorithm
ha' PubKeyAlgorithm
RSA)
    verifyNoRSA HashAlgorithm
_ (PubKeyAlgorithm
pka, NonEmpty MPI
_) alg
_ SomePKPayload
_ PKey
_ a
_ = VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> VerificationError
UnsupportedKeyType PubKeyAlgorithm
pka)
    dsaVerify :: SomePKPayload
-> NonEmpty MPI
-> hash
-> PublicKey
-> msg
-> Either VerificationError SomePKPayload
dsaVerify SomePKPayload
pub (MPI
r :| [MPI
s]) hash
hd PublicKey
pkey msg
bs =
      if hash -> PublicKey -> Signature -> msg -> Bool
forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
DSA.verify hash
hd PublicKey
pkey (MPI -> MPI -> Signature
dsaMPIsToSig MPI
r MPI
s) msg
bs
        then SomePKPayload -> Either VerificationError SomePKPayload
forall a b. b -> Either a b
Right SomePKPayload
pub
        else VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> Fingerprint -> VerificationError
SignatureMismatch PubKeyAlgorithm
DSA (SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pub))
    dsaVerify SomePKPayload
_ NonEmpty MPI
_ hash
_ PublicKey
_ msg
_ = VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> VerificationError
SignatureShapeMismatch PubKeyAlgorithm
DSA)
    ecdsaVerify :: SomePKPayload
-> NonEmpty MPI
-> hash
-> PublicKey
-> msg
-> Either VerificationError SomePKPayload
ecdsaVerify SomePKPayload
pub (MPI
r :| [MPI
s]) hash
hd PublicKey
pkey msg
bs =
      if hash -> PublicKey -> Signature -> msg -> Bool
forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
ECDSA.verify hash
hd PublicKey
pkey (MPI -> MPI -> Signature
ecdsaMPIsToSig MPI
r MPI
s) msg
bs
        then SomePKPayload -> Either VerificationError SomePKPayload
forall a b. b -> Either a b
Right SomePKPayload
pub
        else VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> Fingerprint -> VerificationError
SignatureMismatch PubKeyAlgorithm
ECDSA (SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pub))
    ecdsaVerify SomePKPayload
_ NonEmpty MPI
_ hash
_ PublicKey
_ msg
_ = VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> VerificationError
SignatureShapeMismatch PubKeyAlgorithm
ECDSA)
    ed25519Verify :: PubKeyAlgorithm
-> SomePKPayload
-> NonEmpty MPI
-> alg
-> EdPoint
-> a
-> Either VerificationError SomePKPayload
ed25519Verify PubKeyAlgorithm
sigPka SomePKPayload
pub (MPI
r :| [MPI
s]) alg
hd EdPoint
pkey a
bs =
      case Int -> EdPoint -> Either String ByteString
edPointToRawPublic Int
32 EdPoint
pkey of
        Left String
err ->
          VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> String -> VerificationError
SignatureEncodingInvalid PubKeyAlgorithm
sigPka String
err)
        Right ByteString
rawPub ->
          case CryptoFailable PublicKey -> Either String PublicKey
forall {b}. CryptoFailable b -> Either String b
cf2es (ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey ByteString
rawPub) of
            Left String
err ->
              VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> String -> VerificationError
SignatureEncodingInvalid PubKeyAlgorithm
sigPka String
err)
            Right PublicKey
ep ->
              case CryptoFailable Signature -> Either String Signature
forall {b}. CryptoFailable b -> Either String b
cf2es (ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature (ByteString -> ByteString
pad32 (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp (MPI -> Integer
unMPI MPI
r)) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
pad32 (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp (MPI -> Integer
unMPI MPI
s)))) of
                Left String
err ->
                  VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> String -> VerificationError
SignatureEncodingInvalid PubKeyAlgorithm
sigPka String
err)
                Right Signature
es ->
                  let prehash :: ByteString
prehash = alg -> a -> ByteString
forall {c} {alg} {a}.
(ByteArray c, HashAlgorithm alg, ByteArrayAccess a) =>
alg -> a -> c
crazyHash alg
hd a
bs :: B.ByteString
                   in if PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
ep ByteString
prehash Signature
es
                        then SomePKPayload -> Either VerificationError SomePKPayload
forall a b. b -> Either a b
Right SomePKPayload
pub
                        else VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> Fingerprint -> VerificationError
SignatureMismatch PubKeyAlgorithm
sigPka (SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pub))
    ed25519Verify PubKeyAlgorithm
sigPka SomePKPayload
_ NonEmpty MPI
_ alg
_ EdPoint
_ a
_ =
      VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> VerificationError
SignatureShapeMismatch PubKeyAlgorithm
sigPka)
    ed448Verify :: PubKeyAlgorithm
-> SomePKPayload
-> NonEmpty MPI
-> alg
-> EdPoint
-> a
-> Either VerificationError SomePKPayload
ed448Verify PubKeyAlgorithm
sigPka SomePKPayload
pub (MPI
r :| [MPI
s]) alg
hd EdPoint
pkey a
bs =
      case Int -> EdPoint -> Either String ByteString
edPointToRawPublic Int
57 EdPoint
pkey of
        Left String
err ->
          VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> String -> VerificationError
SignatureEncodingInvalid PubKeyAlgorithm
sigPka String
err)
        Right ByteString
rawPub ->
          case CryptoFailable PublicKey -> Either String PublicKey
forall {b}. CryptoFailable b -> Either String b
cf2es (ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed448.publicKey ByteString
rawPub) of
            Left String
err ->
              VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> String -> VerificationError
SignatureEncodingInvalid PubKeyAlgorithm
sigPka String
err)
            Right PublicKey
ep ->
              case CryptoFailable Signature -> Either String Signature
forall {b}. CryptoFailable b -> Either String b
cf2es (ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed448.signature (Int -> ByteString -> ByteString
padN Int
57 (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp (MPI -> Integer
unMPI MPI
r)) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
padN Int
57 (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp (MPI -> Integer
unMPI MPI
s)))) of
                Left String
err ->
                  VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> String -> VerificationError
SignatureEncodingInvalid PubKeyAlgorithm
sigPka String
err)
                Right Signature
es ->
                  let prehash :: ByteString
prehash = alg -> a -> ByteString
forall {c} {alg} {a}.
(ByteArray c, HashAlgorithm alg, ByteArrayAccess a) =>
alg -> a -> c
crazyHash alg
hd a
bs :: B.ByteString
                   in if PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed448.verify PublicKey
ep ByteString
prehash Signature
es
                        then SomePKPayload -> Either VerificationError SomePKPayload
forall a b. b -> Either a b
Right SomePKPayload
pub
                        else VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> Fingerprint -> VerificationError
SignatureMismatch PubKeyAlgorithm
sigPka (SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pub))
    ed448Verify PubKeyAlgorithm
sigPka SomePKPayload
_ NonEmpty MPI
_ alg
_ EdPoint
_ a
_ =
      VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> VerificationError
SignatureShapeMismatch PubKeyAlgorithm
sigPka)
    edPointToRawPublic :: Int -> EdPoint -> Either String ByteString
edPointToRawPublic Int
expectedLen (NativeEPoint (EPoint Integer
x)) =
      Int -> String -> ByteString -> Either String ByteString
exactLengthPublic Int
expectedLen String
"native" (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
x)
    edPointToRawPublic Int
expectedLen (PrefixedNativeEPoint (EPoint Integer
x)) = do
      prefixed <- Int -> String -> ByteString -> Either String ByteString
exactLengthPublic (Int
expectedLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
"prefixed-native" (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
x)
      if B.head prefixed /= 0x40
        then Left "prefixed-native EdDSA public key is missing the 0x40 prefix"
        else Right (B.tail prefixed)
    exactLengthPublic :: Int -> String -> ByteString -> Either String ByteString
exactLengthPublic Int
expectedLen String
label ByteString
bs
      | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expectedLen = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
bs
      | Bool
otherwise =
          String -> Either String ByteString
forall a b. a -> Either a b
Left
            (String
"invalid " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" EdDSA public key length: expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++
             Int -> String
forall a. Show a => a -> String
show Int
expectedLen String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" octets, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
B.length ByteString
bs))
    pad32 :: ByteString -> ByteString
pad32 ByteString
bs =
      let l :: Int
l = ByteString -> Int
B.length ByteString
bs
       in if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32
            then ByteString
bs
            else Int -> Word8 -> ByteString
B.replicate (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Word8
0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
    padN :: Int -> ByteString -> ByteString
padN Int
n ByteString
bs =
      let l :: Int
l = ByteString -> Int
B.length ByteString
bs
       in if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
            then ByteString
bs
            else Int -> Word8 -> ByteString
B.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Word8
0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
    cf2es :: CryptoFailable b -> Either String b
cf2es = (CryptoError -> Either String b)
-> (b -> Either String b)
-> Either CryptoError b
-> Either String b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b)
-> (CryptoError -> String) -> CryptoError -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> String
forall a. Show a => a -> String
show) b -> Either String b
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CryptoError b -> Either String b)
-> (CryptoFailable b -> Either CryptoError b)
-> CryptoFailable b
-> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable b -> Either CryptoError b
forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError
    rsaVerify :: SomePKPayload
-> NonEmpty MPI
-> hashAlg
-> PublicKey
-> ByteString
-> Either VerificationError SomePKPayload
rsaVerify SomePKPayload
pub NonEmpty MPI
mpis hashAlg
hd PublicKey
pkey ByteString
bs =
      if Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
P15.verify (hashAlg -> Maybe hashAlg
forall a. a -> Maybe a
Just hashAlg
hd) PublicKey
pkey ByteString
bs (PublicKey -> NonEmpty MPI -> ByteString
rsaMPItoSig PublicKey
pkey NonEmpty MPI
mpis)
        then SomePKPayload -> Either VerificationError SomePKPayload
forall a b. b -> Either a b
Right SomePKPayload
pub
        else VerificationError -> Either VerificationError SomePKPayload
forall a. VerificationError -> Either VerificationError a
verificationError (PubKeyAlgorithm -> Fingerprint -> VerificationError
SignatureMismatch PubKeyAlgorithm
RSA (SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pub))
    dsaMPIsToSig :: MPI -> MPI -> Signature
dsaMPIsToSig MPI
r MPI
s = Integer -> Integer -> Signature
DSA.Signature (MPI -> Integer
unMPI MPI
r) (MPI -> Integer
unMPI MPI
s)
    ecdsaMPIsToSig :: MPI -> MPI -> Signature
ecdsaMPIsToSig MPI
r MPI
s = Integer -> Integer -> Signature
ECDSA.Signature (MPI -> Integer
unMPI MPI
r) (MPI -> Integer
unMPI MPI
s)
    rsaMPItoSig :: PublicKey -> NonEmpty MPI -> ByteString
rsaMPItoSig PublicKey
pkey (MPI
s :| []) =
      let sz :: Int
sz  = PublicKey -> Int
RSATypes.public_size PublicKey
pkey
          raw :: ByteString
raw = Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp (MPI -> Integer
unMPI MPI
s)
          pad :: Int
pad = Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
raw
      in Int -> Word8 -> ByteString
B.replicate Int
pad Word8
0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
raw
    crazyHash :: alg -> a -> c
crazyHash alg
h = Digest alg -> c
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest alg -> c) -> (a -> Digest alg) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. alg -> a -> Digest alg
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith alg
h

isSignatureExpired :: Pkt -> Maybe UTCTime -> Either VerificationError Bool
isSignatureExpired :: Pkt -> Maybe UTCTime -> Either VerificationError Bool
isSignatureExpired Pkt
_ Maybe UTCTime
Nothing = Bool -> Either VerificationError Bool
forall a. a -> Either VerificationError a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isSignatureExpired Pkt
s (Just UTCTime
t) =
      do
        sigClass <-
          (String -> Either VerificationError SomeSignatureV)
-> (SomeSignatureV -> Either VerificationError SomeSignatureV)
-> Either String SomeSignatureV
-> Either VerificationError SomeSignatureV
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (VerificationError -> Either VerificationError SomeSignatureV
forall a. VerificationError -> Either VerificationError a
verificationError (VerificationError -> Either VerificationError SomeSignatureV)
-> (String -> VerificationError)
-> String
-> Either VerificationError SomeSignatureV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> String -> VerificationError
forall a b. a -> b -> a
const VerificationError
NonSignaturePacket)
            SomeSignatureV -> Either VerificationError SomeSignatureV
forall a b. b -> Either a b
Right
            (Pkt -> Either String SomeSignatureV
fromPktEitherSomeSignatureV Pkt
s)
        if any
             (expiredBefore t)
             (signatureHashedSubpackets
                (case sigClass of
                   SomeSignatureV SignatureV v
typedSig -> SignatureV v -> SignaturePayload
forall (v :: SignaturePayloadVersion).
SignatureV v -> SignaturePayload
signaturePayloadFromSignatureV SignatureV v
typedSig))
          then verificationError SignatureExpired
          else return True
  where
    expiredBefore :: UTCTime -> SigSubPacket -> Bool
    expiredBefore :: UTCTime -> SigSubPacket -> Bool
expiredBefore UTCTime
ct (SigSubPacket Bool
_ (SigExpirationTime ThirtyTwoBitDuration
et)) =
      NominalDiffTime -> Int
forall a. Enum a => a -> Int
fromEnum ((NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> (ThirtyTwoBitDuration -> NominalDiffTime)
-> ThirtyTwoBitDuration
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> NominalDiffTime
forall a. Enum a => Int -> a
toEnum (Int -> NominalDiffTime)
-> (ThirtyTwoBitDuration -> Int)
-> ThirtyTwoBitDuration
-> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitDuration -> Int
forall a. Enum a => a -> Int
fromEnum) ThirtyTwoBitDuration
et UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
ct) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<
      Int
0
    expiredBefore UTCTime
_ SigSubPacket
_ = Bool
False

finalPayload :: Pkt -> ByteString -> ByteString
finalPayload :: Pkt -> ByteString -> ByteString
finalPayload Pkt
s ByteString
pl = [ByteString] -> ByteString
BL.concat [ByteString
pl, ByteString
sigbit, Pkt -> ByteString
trailer Pkt
s]
  where
    sigbit :: ByteString
sigbit = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Pkt -> Put
putPartialSigforSigning Pkt
s
    trailer :: Pkt -> ByteString
    trailer :: Pkt -> ByteString
trailer (SignaturePkt SignaturePayload
sigPayload) =
      ByteString
-> (VerifiableSignatureV -> ByteString)
-> Maybe VerifiableSignatureV
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        ByteString
BL.empty
        (ByteString -> VerifiableSignatureV -> ByteString
forall a b. a -> b -> a
const (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Pkt -> Put
putSigTrailer Pkt
s))
        (SignaturePayload -> Maybe VerifiableSignatureV
fromSignaturePayloadVerifiableSignatureV SignaturePayload
sigPayload)
    trailer Pkt
_ = ByteString
BL.empty

normalizePayloadForSigType :: SigType -> ByteString -> ByteString
normalizePayloadForSigType :: SigType -> ByteString -> ByteString
normalizePayloadForSigType SigType
CanonicalTextSig =
  ByteString -> ByteString
stripTrailingWhitespacePerLine (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
canonicalizeLineEndings
normalizePayloadForSigType SigType
_ = ByteString -> ByteString
forall a. a -> a
id

normalizePayloadForSigTypeWith :: TextNormalizationMode -> SigType -> ByteString -> ByteString
normalizePayloadForSigTypeWith :: TextNormalizationMode -> SigType -> ByteString -> ByteString
normalizePayloadForSigTypeWith TextNormalizationMode
CleartextCompat SigType
st = SigType -> ByteString -> ByteString
normalizePayloadForSigType SigType
st
normalizePayloadForSigTypeWith TextNormalizationMode
RFC9580Strict SigType
CanonicalTextSig = ByteString -> ByteString
canonicalizeLineEndings
normalizePayloadForSigTypeWith TextNormalizationMode
RFC9580Strict SigType
_ = ByteString -> ByteString
forall a. a -> a
id

canonicalizeLineEndings :: ByteString -> ByteString
canonicalizeLineEndings :: ByteString -> ByteString
canonicalizeLineEndings = [Word8] -> ByteString
BL.pack ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8]
forall {a}. (Eq a, Num a) => [a] -> [a]
go ([Word8] -> [Word8])
-> (ByteString -> [Word8]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BL.unpack
  where
    go :: [a] -> [a]
go [] = []
    go (a
0x0d:a
0x0a:[a]
rest) = a
0x0d a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
0x0a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
rest
    go (a
0x0d:[a]
rest) = a
0x0d a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
0x0a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
rest
    go (a
0x0a:[a]
rest) = a
0x0d a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
0x0a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
rest
    go (a
w:[a]
rest) = a
w a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
rest

stripTrailingWhitespacePerLine :: ByteString -> ByteString
stripTrailingWhitespacePerLine :: ByteString -> ByteString
stripTrailingWhitespacePerLine = [Word8] -> ByteString
BL.pack ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8] -> [Word8]
go [] ([Word8] -> [Word8])
-> (ByteString -> [Word8]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BL.unpack
  where
    go :: [Word8] -> [Word8] -> [Word8]
go [Word8]
lineRev [] = [Word8] -> [Word8]
reverseTrimmed [Word8]
lineRev
    go [Word8]
lineRev (Word8
0x0d:Word8
0x0a:[Word8]
rest) =
      [Word8] -> [Word8]
reverseTrimmed [Word8]
lineRev [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8
0x0d, Word8
0x0a] [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8] -> [Word8] -> [Word8]
go [] [Word8]
rest
    go [Word8]
lineRev (Word8
w:[Word8]
rest) = [Word8] -> [Word8] -> [Word8]
go (Word8
w Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
lineRev) [Word8]
rest

    reverseTrimmed :: [Word8] -> [Word8]
    reverseTrimmed :: [Word8] -> [Word8]
reverseTrimmed = [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> [Word8] -> [Word8]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Word8 -> Bool
isTrailingWhitespace

    isTrailingWhitespace :: Word8 -> Bool
    isTrailingWhitespace :: Word8 -> Bool
isTrailingWhitespace Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09

hashWithSHA512 :: B.ByteString -> B.ByteString
hashWithSHA512 :: ByteString -> ByteString
hashWithSHA512 = Digest SHA512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest SHA512 -> ByteString)
-> (ByteString -> Digest SHA512) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA512 -> ByteString -> Digest SHA512
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA512
CHA.SHA512

hashForSignatureAlgorithm :: HashAlgorithm -> B.ByteString -> Either String B.ByteString
hashForSignatureAlgorithm :: HashAlgorithm -> ByteString -> Either String ByteString
hashForSignatureAlgorithm HashAlgorithm
ha ByteString
bs =
  case HashAlgorithm
ha of
    HashAlgorithm
SHA1 -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA1 -> ByteString -> Digest SHA1
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA1
CHA.SHA1 ByteString
bs))
    HashAlgorithm
RIPEMD160 -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest RIPEMD160 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (RIPEMD160 -> ByteString -> Digest RIPEMD160
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith RIPEMD160
CHA.RIPEMD160 ByteString
bs))
    HashAlgorithm
SHA224 -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA224 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA224 -> ByteString -> Digest SHA224
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA224
CHA.SHA224 ByteString
bs))
    HashAlgorithm
SHA256 -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA256 -> ByteString -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
CHA.SHA256 ByteString
bs))
    HashAlgorithm
SHA384 -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA384 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA384 -> ByteString -> Digest SHA384
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA384
CHA.SHA384 ByteString
bs))
    HashAlgorithm
SHA512 -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA512 -> ByteString -> Digest SHA512
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA512
CHA.SHA512 ByteString
bs))
    HashAlgorithm
SHA3_256 -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA3_256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA3_256 -> ByteString -> Digest SHA3_256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA3_256
CHA.SHA3_256 ByteString
bs))
    HashAlgorithm
SHA3_512 -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA3_512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA3_512 -> ByteString -> Digest SHA3_512
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA3_512
CHA.SHA3_512 ByteString
bs))
    HashAlgorithm
DeprecatedMD5 -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest MD5 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (MD5 -> ByteString -> Digest MD5
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith MD5
CHA.MD5 ByteString
bs))
    HashAlgorithm
_ -> String -> Either String ByteString
forall a b. a -> Either a b
Left (String
"unsupported hash algorithm for left16 derivation: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha)

left16FromHashPrefix :: B.ByteString -> Either String Word16
left16FromHashPrefix :: ByteString -> Either String Word16
left16FromHashPrefix ByteString
bs
  | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 = Word16 -> Either String Word16
forall a b. b -> Either a b
Right (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (Int -> ByteString -> ByteString
B.take Int
2 ByteString
bs)))
  | Bool
otherwise = String -> Either String Word16
forall a b. a -> Either a b
Left String
"hash output too short to derive left16"

left16FromSignedPayload :: HashAlgorithm -> B.ByteString -> Either String Word16
left16FromSignedPayload :: HashAlgorithm -> ByteString -> Either String Word16
left16FromSignedPayload HashAlgorithm
ha ByteString
signedPayload = do
  digest <- HashAlgorithm -> ByteString -> Either String ByteString
hashForSignatureAlgorithm HashAlgorithm
ha ByteString
signedPayload
  left16FromHashPrefix digest

left16FromSignedPayloadForSign :: HashAlgorithm -> B.ByteString -> Either SignError Word16
left16FromSignedPayloadForSign :: HashAlgorithm -> ByteString -> Either SignError Word16
left16FromSignedPayloadForSign HashAlgorithm
ha =
  (String -> SignError)
-> Either String Word16 -> Either SignError Word16
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> SignError
SignBackendError (Either String Word16 -> Either SignError Word16)
-> (ByteString -> Either String Word16)
-> ByteString
-> Either SignError Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashAlgorithm -> ByteString -> Either String Word16
left16FromSignedPayload HashAlgorithm
ha

ed25519Signer :: Ed25519.SecretKey -> B.ByteString -> B.ByteString
ed25519Signer :: SecretKey -> ByteString -> ByteString
ed25519Signer SecretKey
sk ByteString
prehash =
  Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign SecretKey
sk (SecretKey -> PublicKey
Ed25519.toPublic SecretKey
sk) ByteString
prehash)

ed448Signer :: Ed448.SecretKey -> B.ByteString -> B.ByteString
ed448Signer :: SecretKey -> ByteString -> ByteString
ed448Signer SecretKey
sk ByteString
prehash =
  Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed448.sign SecretKey
sk (SecretKey -> PublicKey
Ed448.toPublic SecretKey
sk) ByteString
prehash)

rsaPKCS15Sign ::
     HashAlgorithm
  -> RSATypes.PrivateKey
  -> B.ByteString
  -> Either SignError B.ByteString
rsaPKCS15Sign :: HashAlgorithm
-> PrivateKey -> ByteString -> Either SignError ByteString
rsaPKCS15Sign HashAlgorithm
ha PrivateKey
prv ByteString
bytes =
  case HashAlgorithm
ha of
    HashAlgorithm
SHA1 -> (Error -> SignError)
-> Either Error ByteString -> Either SignError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> SignError
SignBackendError (String -> SignError) -> (Error -> String) -> Error -> SignError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
forall a. Show a => a -> String
show) (Maybe Blinder
-> Maybe SHA1
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
P15.sign Maybe Blinder
forall a. Maybe a
Nothing (SHA1 -> Maybe SHA1
forall a. a -> Maybe a
Just SHA1
CHA.SHA1) PrivateKey
prv ByteString
bytes)
    HashAlgorithm
SHA224 -> (Error -> SignError)
-> Either Error ByteString -> Either SignError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> SignError
SignBackendError (String -> SignError) -> (Error -> String) -> Error -> SignError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
forall a. Show a => a -> String
show) (Maybe Blinder
-> Maybe SHA224
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
P15.sign Maybe Blinder
forall a. Maybe a
Nothing (SHA224 -> Maybe SHA224
forall a. a -> Maybe a
Just SHA224
CHA.SHA224) PrivateKey
prv ByteString
bytes)
    HashAlgorithm
SHA256 -> (Error -> SignError)
-> Either Error ByteString -> Either SignError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> SignError
SignBackendError (String -> SignError) -> (Error -> String) -> Error -> SignError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
forall a. Show a => a -> String
show) (Maybe Blinder
-> Maybe SHA256
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
P15.sign Maybe Blinder
forall a. Maybe a
Nothing (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
CHA.SHA256) PrivateKey
prv ByteString
bytes)
    HashAlgorithm
SHA384 -> (Error -> SignError)
-> Either Error ByteString -> Either SignError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> SignError
SignBackendError (String -> SignError) -> (Error -> String) -> Error -> SignError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
forall a. Show a => a -> String
show) (Maybe Blinder
-> Maybe SHA384
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
P15.sign Maybe Blinder
forall a. Maybe a
Nothing (SHA384 -> Maybe SHA384
forall a. a -> Maybe a
Just SHA384
CHA.SHA384) PrivateKey
prv ByteString
bytes)
    HashAlgorithm
SHA512 -> (Error -> SignError)
-> Either Error ByteString -> Either SignError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> SignError
SignBackendError (String -> SignError) -> (Error -> String) -> Error -> SignError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
forall a. Show a => a -> String
show) (Maybe Blinder
-> Maybe SHA512
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
P15.sign Maybe Blinder
forall a. Maybe a
Nothing (SHA512 -> Maybe SHA512
forall a. a -> Maybe a
Just SHA512
CHA.SHA512) PrivateKey
prv ByteString
bytes)
    HashAlgorithm
_ ->
      SignError -> Either SignError ByteString
forall a b. a -> Either a b
Left
        (String -> SignError
SignBackendError
           (String
"signature hash algorithm is not supported by RSA PKCS#1 v1.5 backend: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
            HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha))

validateV6SaltSize :: HashAlgorithm -> SignatureSalt -> Either SignError ()
validateV6SaltSize :: HashAlgorithm -> SignatureSalt -> Either SignError ()
validateV6SaltSize HashAlgorithm
ha SignatureSalt
salt =
  let saltBytes :: ByteString
saltBytes = ByteString -> ByteString
BL.toStrict (SignatureSalt -> ByteString
unSignatureSalt SignatureSalt
salt)
      actualSaltLen :: Int
actualSaltLen = ByteString -> Int
B.length ByteString
saltBytes
   in case HashAlgorithm -> Maybe Word8
signatureV6SaltSizeForHashAlgorithm HashAlgorithm
ha of
        Maybe Word8
Nothing ->
          SignError -> Either SignError ()
forall a b. a -> Either a b
Left
            (String -> SignError
SignBackendError
               (String
"signature hash algorithm does not define a V6 salt size: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha))
        Just Word8
expectedSaltLen ->
          if Int
actualSaltLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
expectedSaltLen
            then () -> Either SignError ()
forall a b. b -> Either a b
Right ()
            else SignError -> Either SignError ()
forall a b. a -> Either a b
Left (HashAlgorithm -> Word8 -> Int -> SignError
SignV6SaltSizeMismatch HashAlgorithm
ha Word8
expectedSaltLen Int
actualSaltLen)

signEdDSAV4 ::
     String
  -> Int
  -> Int
  -> (B.ByteString -> B.ByteString)
  -> TextNormalizationMode
  -> SigType
  -> PubKeyAlgorithm
  -> HashAlgorithm
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signEdDSAV4 :: String
-> Int
-> Int
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signEdDSAV4 String
algoName Int
sigLen Int
limbLen ByteString -> ByteString
signer TextNormalizationMode
mode SigType
st PubKeyAlgorithm
pka HashAlgorithm
ha [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload = do
  let normalizedPayload :: ByteString
normalizedPayload = TextNormalizationMode -> SigType -> ByteString -> ByteString
normalizePayloadForSigTypeWith TextNormalizationMode
mode SigType
st ByteString
payload
      sig0 :: SignaturePayload
sig0 = SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4 SigType
st PubKeyAlgorithm
pka HashAlgorithm
ha [SigSubPacket]
has [] Word16
0 ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI Integer
0, Integer -> MPI
MPI Integer
0])
      prehash :: ByteString
prehash =
        ByteString -> ByteString
hashWithSHA512
          (ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sig0) ByteString
normalizedPayload))
      sigBytes :: ByteString
sigBytes = ByteString -> ByteString
signer ByteString
prehash
  if ByteString -> Int
B.length ByteString
sigBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
sigLen
    then SignError -> Either SignError SignaturePayload
forall a b. a -> Either a b
Left (String -> Int -> Int -> SignError
SignProducedWrongLength String
algoName Int
sigLen (ByteString -> Int
B.length ByteString
sigBytes))
    else
      let (ByteString
r, ByteString
s) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
limbLen ByteString
sigBytes
       in (\Word16
left16 ->
             SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4
               SigType
st
               PubKeyAlgorithm
pka
               HashAlgorithm
ha
               [SigSubPacket]
has
               [SigSubPacket]
uhas
               Word16
left16
               ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
r), Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
s)]))
            (Word16 -> SignaturePayload)
-> Either SignError Word16 -> Either SignError SignaturePayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> SignError)
-> Either String Word16 -> Either SignError Word16
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> SignError
SignBackendError (ByteString -> Either String Word16
left16FromHashPrefix ByteString
prehash)

signEdDSAV6 ::
     String
  -> Int
  -> Int
  -> (B.ByteString -> B.ByteString)
  -> TextNormalizationMode
  -> SigType
  -> PubKeyAlgorithm
  -> HashAlgorithm
  -> SignatureSalt
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signEdDSAV6 :: String
-> Int
-> Int
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signEdDSAV6 String
algoName Int
sigLen Int
limbLen ByteString -> ByteString
signer TextNormalizationMode
mode SigType
st PubKeyAlgorithm
pka HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload = do
  HashAlgorithm -> SignatureSalt -> Either SignError ()
validateV6SaltSize HashAlgorithm
ha SignatureSalt
salt
  let normalizedPayload :: ByteString
normalizedPayload = TextNormalizationMode -> SigType -> ByteString -> ByteString
normalizePayloadForSigTypeWith TextNormalizationMode
mode SigType
st ByteString
payload
      sig0 :: SignaturePayload
sig0 = SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV6 SigType
st PubKeyAlgorithm
pka HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
has [] Word16
0 ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI Integer
0, Integer -> MPI
MPI Integer
0])
      prehash :: ByteString
prehash =
        ByteString -> ByteString
hashWithSHA512
          (ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sig0) ByteString
normalizedPayload))
      sigBytes :: ByteString
sigBytes = ByteString -> ByteString
signer ByteString
prehash
  if ByteString -> Int
B.length ByteString
sigBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
sigLen
    then SignError -> Either SignError SignaturePayload
forall a b. a -> Either a b
Left (String -> Int -> Int -> SignError
SignProducedWrongLength String
algoName Int
sigLen (ByteString -> Int
B.length ByteString
sigBytes))
    else
      let (ByteString
r, ByteString
s) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
limbLen ByteString
sigBytes
       in (\Word16
left16 ->
             SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV6
               SigType
st
               PubKeyAlgorithm
pka
               HashAlgorithm
ha
               SignatureSalt
salt
               [SigSubPacket]
has
               [SigSubPacket]
uhas
               Word16
left16
               ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
r), Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
s)]))
            (Word16 -> SignaturePayload)
-> Either SignError Word16 -> Either SignError SignaturePayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> SignError)
-> Either String Word16 -> Either SignError Word16
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> SignError
SignBackendError (ByteString -> Either String Word16
left16FromHashPrefix ByteString
prehash)

signUserIDwithRSA :: SomePKPayload -- ^ public key "payload" of user ID being signed
  -> UserId -- ^ user ID being signed
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either SignError SignaturePayload
signUserIDwithRSA :: SomePKPayload
-> UserId
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> Either SignError SignaturePayload
signUserIDwithRSA = SigType
-> SomePKPayload
-> UserId
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> Either SignError SignaturePayload
signCertificationWithRSA SigType
PositiveCert

signCertificationWithRSA ::
     SigType -- ^ certification type (GenericCert, PersonaCert, CasualCert, PositiveCert)
  -> SomePKPayload -- ^ public key "payload" of user ID being signed
  -> UserId -- ^ user ID being signed
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either SignError SignaturePayload
signCertificationWithRSA :: SigType
-> SomePKPayload
-> UserId
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> Either SignError SignaturePayload
signCertificationWithRSA SigType
st SomePKPayload
pkp UserId
uid [SigSubPacket]
hsigsubs [SigSubPacket]
usigsubs PrivateKey
prv
  | SigType
st SigType -> [SigType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SigType
GenericCert, SigType
PersonaCert, SigType
CasualCert, SigType
PositiveCert] = do
  let payloadToSign :: ByteString
payloadToSign = ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
uidsigp) ByteString
uidpayload)
  Word16 -> ByteString -> SignaturePayload
uidsigp'
    (Word16 -> ByteString -> SignaturePayload)
-> Either SignError Word16
-> Either SignError (ByteString -> SignaturePayload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashAlgorithm -> ByteString -> Either SignError Word16
left16FromSignedPayloadForSign HashAlgorithm
SHA512 ByteString
payloadToSign
    Either SignError (ByteString -> SignaturePayload)
-> Either SignError ByteString -> Either SignError SignaturePayload
forall a b.
Either SignError (a -> b)
-> Either SignError a -> Either SignError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Error -> SignError)
-> Either Error ByteString -> Either SignError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
          (String -> SignError
SignBackendError (String -> SignError) -> (Error -> String) -> Error -> SignError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
forall a. Show a => a -> String
show)
          (Maybe Blinder
-> Maybe SHA512
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
P15.sign
             Maybe Blinder
forall a. Maybe a
Nothing
             (SHA512 -> Maybe SHA512
forall a. a -> Maybe a
Just SHA512
CHA.SHA512)
             PrivateKey
prv
             ByteString
payloadToSign)
  | Bool
otherwise =
    SignError -> Either SignError SignaturePayload
forall a b. a -> Either a b
Left (SigType -> SignError
SignUnsupportedCertificationType SigType
st)
  where
    uidpayload :: ByteString
uidpayload =
      Put -> ByteString
runPut
        ([Put] -> Put
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
           [Pkt -> Put
putKeyforSigning (SomePKPayload -> Pkt
PublicKeyPkt SomePKPayload
pkp), Pkt -> Put
putUforSigning (UserId -> Pkt
forall a. Packet a => a -> Pkt
toPkt UserId
uid)])
    uidsigp :: SignaturePayload
uidsigp =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4 SigType
st PubKeyAlgorithm
RSA HashAlgorithm
SHA512 [SigSubPacket]
hsigsubs [SigSubPacket]
usigsubs Word16
0 ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI Integer
0])
    uidsigp' :: Word16 -> ByteString -> SignaturePayload
uidsigp' Word16
left16 ByteString
us =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4
        SigType
st
        PubKeyAlgorithm
RSA
        HashAlgorithm
SHA512
        [SigSubPacket]
hsigsubs
        [SigSubPacket]
usigsubs
        Word16
left16
        ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
us)])

signDirectKeyWithRSA ::
     SigType -- ^ key-scoped signature type (SignatureDirectlyOnAKey or KeyRevocationSig)
  -> SomePKPayload -- ^ primary key "payload" being signed
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either SignError SignaturePayload
signDirectKeyWithRSA :: SigType
-> SomePKPayload
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> Either SignError SignaturePayload
signDirectKeyWithRSA SigType
st SomePKPayload
pkp [SigSubPacket]
hsigsubs [SigSubPacket]
usigsubs PrivateKey
prv
  | SigType
st SigType -> [SigType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SigType
SignatureDirectlyOnAKey, SigType
KeyRevocationSig] =
    SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA SigType
st PrivateKey
prv [SigSubPacket]
hsigsubs [SigSubPacket]
usigsubs ByteString
keypayload
  | Bool
otherwise =
    SignError -> Either SignError SignaturePayload
forall a b. a -> Either a b
Left (SigType -> SignError
SignUnsupportedKeySignatureType SigType
st)
  where
    keypayload :: ByteString
keypayload = Put -> ByteString
runPut (Pkt -> Put
putKeyforSigning (SomePKPayload -> Pkt
PublicKeyPkt SomePKPayload
pkp))

signKeyRevocationWithRSA :: SomePKPayload -- ^ primary key "payload" being revoked
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either SignError SignaturePayload
signKeyRevocationWithRSA :: SomePKPayload
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> Either SignError SignaturePayload
signKeyRevocationWithRSA = SigType
-> SomePKPayload
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> Either SignError SignaturePayload
signDirectKeyWithRSA SigType
KeyRevocationSig

signSubkeyRevocationWithRSA :: SomePKPayload -- ^ primary key "payload"
  -> SomePKPayload -- ^ public subkey "payload" being revoked
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either SignError SignaturePayload
signSubkeyRevocationWithRSA :: SomePKPayload
-> SomePKPayload
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> Either SignError SignaturePayload
signSubkeyRevocationWithRSA SomePKPayload
pkp SomePKPayload
subpkp [SigSubPacket]
hsigsubs [SigSubPacket]
usigsubs PrivateKey
prv =
  SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA SigType
SubkeyRevocationSig PrivateKey
prv [SigSubPacket]
hsigsubs [SigSubPacket]
usigsubs ByteString
subkeypayload
  where
    subkeypayload :: ByteString
subkeypayload =
      Put -> ByteString
runPut
        ([Put] -> Put
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
           [ Pkt -> Put
putKeyforSigning (SomePKPayload -> Pkt
PublicKeyPkt SomePKPayload
pkp)
           , Pkt -> Put
putKeyforSigning (SomePKPayload -> Pkt
PublicSubkeyPkt SomePKPayload
subpkp)
           ])

signCertRevocationWithRSA :: SomePKPayload -- ^ primary key "payload"
  -> UserId -- ^ user ID certification being revoked
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either SignError SignaturePayload
signCertRevocationWithRSA :: SomePKPayload
-> UserId
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> Either SignError SignaturePayload
signCertRevocationWithRSA SomePKPayload
pkp UserId
uid [SigSubPacket]
hsigsubs [SigSubPacket]
usigsubs PrivateKey
prv =
  SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA SigType
CertRevocationSig PrivateKey
prv [SigSubPacket]
hsigsubs [SigSubPacket]
usigsubs ByteString
certpayload
  where
    certpayload :: ByteString
certpayload =
      Put -> ByteString
runPut
        ([Put] -> Put
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
           [Pkt -> Put
putKeyforSigning (SomePKPayload -> Pkt
PublicKeyPkt SomePKPayload
pkp), Pkt -> Put
putUforSigning (UserId -> Pkt
forall a. Packet a => a -> Pkt
toPkt UserId
uid)])

crossSignSubkeyWithRSA :: SomePKPayload -- ^ public key "payload" of key being signed
  -> SomePKPayload -- ^ public subkey "payload" of key being signed
  -> [SigSubPacket] -- ^ hashed signature subpackets for binding sig
  -> [SigSubPacket] -- ^ unhashed signature subpackets for binding sig
  -> [SigSubPacket] -- ^ hashed signature subpackets for embedded sig
  -> [SigSubPacket] -- ^ unhashed signature subpackets for embedded sig
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> RSATypes.PrivateKey -- ^ RSA signing subkey
  -> Either SignError SignaturePayload
crossSignSubkeyWithRSA :: SomePKPayload
-> SomePKPayload
-> [SigSubPacket]
-> [SigSubPacket]
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> PrivateKey
-> Either SignError SignaturePayload
crossSignSubkeyWithRSA SomePKPayload
pkp SomePKPayload
subpkp [SigSubPacket]
subhsigsubs [SigSubPacket]
subusigsubs [SigSubPacket]
embhsigsubs [SigSubPacket]
embusigsubs PrivateKey
prv PrivateKey
ssb = do
  let embPayloadToSign :: ByteString
embPayloadToSign = ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
embsigp) ByteString
subkeypayload)
      subPayloadToSign :: ByteString
subPayloadToSign = ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
subsigp) ByteString
subkeypayload)
  (\Word16
embleft16 Word16
subleft16 ByteString
embsig ByteString
subsig ->
     SignaturePayload -> Word16 -> ByteString -> SignaturePayload
subsigp' (Word16 -> ByteString -> SignaturePayload
embsigp' Word16
embleft16 ByteString
embsig) Word16
subleft16 ByteString
subsig)
    (Word16 -> Word16 -> ByteString -> ByteString -> SignaturePayload)
-> Either SignError Word16
-> Either
     SignError (Word16 -> ByteString -> ByteString -> SignaturePayload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashAlgorithm -> ByteString -> Either SignError Word16
left16FromSignedPayloadForSign HashAlgorithm
SHA512 ByteString
embPayloadToSign
    Either
  SignError (Word16 -> ByteString -> ByteString -> SignaturePayload)
-> Either SignError Word16
-> Either SignError (ByteString -> ByteString -> SignaturePayload)
forall a b.
Either SignError (a -> b)
-> Either SignError a -> Either SignError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashAlgorithm -> ByteString -> Either SignError Word16
left16FromSignedPayloadForSign HashAlgorithm
SHA512 ByteString
subPayloadToSign
    Either SignError (ByteString -> ByteString -> SignaturePayload)
-> Either SignError ByteString
-> Either SignError (ByteString -> SignaturePayload)
forall a b.
Either SignError (a -> b)
-> Either SignError a -> Either SignError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Error -> SignError)
-> Either Error ByteString -> Either SignError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
          (String -> SignError
SignBackendError (String -> SignError) -> (Error -> String) -> Error -> SignError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
forall a. Show a => a -> String
show)
          (Maybe Blinder
-> Maybe SHA512
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
P15.sign
             Maybe Blinder
forall a. Maybe a
Nothing
             (SHA512 -> Maybe SHA512
forall a. a -> Maybe a
Just SHA512
CHA.SHA512)
             PrivateKey
ssb
             ByteString
embPayloadToSign)
    Either SignError (ByteString -> SignaturePayload)
-> Either SignError ByteString -> Either SignError SignaturePayload
forall a b.
Either SignError (a -> b)
-> Either SignError a -> Either SignError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Error -> SignError)
-> Either Error ByteString -> Either SignError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
          (String -> SignError
SignBackendError (String -> SignError) -> (Error -> String) -> Error -> SignError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
forall a. Show a => a -> String
show)
          (Maybe Blinder
-> Maybe SHA512
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
P15.sign
             Maybe Blinder
forall a. Maybe a
Nothing
             (SHA512 -> Maybe SHA512
forall a. a -> Maybe a
Just SHA512
CHA.SHA512)
             PrivateKey
prv
             ByteString
subPayloadToSign)
  where
    subkeypayload :: ByteString
subkeypayload =
      Put -> ByteString
runPut
        ([Put] -> Put
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
           [ Pkt -> Put
putKeyforSigning (SomePKPayload -> Pkt
PublicKeyPkt SomePKPayload
pkp)
           , Pkt -> Put
putKeyforSigning (SomePKPayload -> Pkt
PublicSubkeyPkt SomePKPayload
subpkp)
           ])
    embsigp :: SignaturePayload
embsigp =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4
        SigType
PrimaryKeyBindingSig
        PubKeyAlgorithm
RSA
        HashAlgorithm
SHA512
        [SigSubPacket]
embhsigsubs
        [SigSubPacket]
embusigsubs
        Word16
0
        ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI Integer
0])
    embsigp' :: Word16 -> ByteString -> SignaturePayload
embsigp' Word16
left16 ByteString
es =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4
        SigType
PrimaryKeyBindingSig
        PubKeyAlgorithm
RSA
        HashAlgorithm
SHA512
        [SigSubPacket]
embhsigsubs
        [SigSubPacket]
embusigsubs
        Word16
left16
        ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
es)])
    subsigp :: SignaturePayload
subsigp =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4 SigType
SubkeyBindingSig PubKeyAlgorithm
RSA HashAlgorithm
SHA512 [SigSubPacket]
subhsigsubs [] Word16
0 ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI Integer
0])
    sspes :: SignaturePayload -> SigSubPacket
sspes SignaturePayload
es = Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (SignaturePayload -> SigSubPacketPayload
EmbeddedSignature SignaturePayload
es)
    subsigp' :: SignaturePayload -> Word16 -> ByteString -> SignaturePayload
subsigp' SignaturePayload
es Word16
left16 ByteString
ss =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4
        SigType
SubkeyBindingSig
        PubKeyAlgorithm
RSA
        HashAlgorithm
SHA512
        [SigSubPacket]
subhsigsubs
        (SignaturePayload -> SigSubPacket
sspes SignaturePayload
es SigSubPacket -> [SigSubPacket] -> [SigSubPacket]
forall a. a -> [a] -> [a]
: [SigSubPacket]
subusigsubs)
        Word16
left16
        ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
ss)])

signRSAV4Core ::
     TextNormalizationMode
  -> SigType
  -> HashAlgorithm
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> RSATypes.PrivateKey
  -> ByteString
  -> Either SignError SignaturePayload
signRSAV4Core :: TextNormalizationMode
-> SigType
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> ByteString
-> Either SignError SignaturePayload
signRSAV4Core TextNormalizationMode
mode SigType
st HashAlgorithm
ha [SigSubPacket]
has [SigSubPacket]
uhas PrivateKey
prv ByteString
payload =
  (\Word16
left16 ByteString
ss -> SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4 SigType
st PubKeyAlgorithm
RSA HashAlgorithm
ha [SigSubPacket]
has [SigSubPacket]
uhas Word16
left16 ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
ss)]))
    (Word16 -> ByteString -> SignaturePayload)
-> Either SignError Word16
-> Either SignError (ByteString -> SignaturePayload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashAlgorithm -> ByteString -> Either SignError Word16
left16FromSignedPayloadForSign HashAlgorithm
ha ByteString
payloadToSign
    Either SignError (ByteString -> SignaturePayload)
-> Either SignError ByteString -> Either SignError SignaturePayload
forall a b.
Either SignError (a -> b)
-> Either SignError a -> Either SignError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashAlgorithm
-> PrivateKey -> ByteString -> Either SignError ByteString
rsaPKCS15Sign HashAlgorithm
ha PrivateKey
prv ByteString
payloadToSign
  where
    sig0 :: SignaturePayload
sig0 = SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4 SigType
st PubKeyAlgorithm
RSA HashAlgorithm
ha [SigSubPacket]
has [] Word16
0 ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI Integer
0])
    payloadToSign :: ByteString
payloadToSign = ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sig0) (TextNormalizationMode -> SigType -> ByteString -> ByteString
normalizePayloadForSigTypeWith TextNormalizationMode
mode SigType
st ByteString
payload))

signRSAV6Core ::
     TextNormalizationMode
  -> SigType
  -> HashAlgorithm
  -> SignatureSalt
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> RSATypes.PrivateKey
  -> ByteString
  -> Either SignError SignaturePayload
signRSAV6Core :: TextNormalizationMode
-> SigType
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> ByteString
-> Either SignError SignaturePayload
signRSAV6Core TextNormalizationMode
mode SigType
st HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
has [SigSubPacket]
uhas PrivateKey
prv ByteString
payload = do
  HashAlgorithm -> SignatureSalt -> Either SignError ()
validateV6SaltSize HashAlgorithm
ha SignatureSalt
salt
  (\Word16
left16 ByteString
sigBytes -> SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV6 SigType
st PubKeyAlgorithm
RSA HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
has [SigSubPacket]
uhas Word16
left16 ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
sigBytes)]))
    (Word16 -> ByteString -> SignaturePayload)
-> Either SignError Word16
-> Either SignError (ByteString -> SignaturePayload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashAlgorithm -> ByteString -> Either SignError Word16
left16FromSignedPayloadForSign HashAlgorithm
ha ByteString
payloadToSign
    Either SignError (ByteString -> SignaturePayload)
-> Either SignError ByteString -> Either SignError SignaturePayload
forall a b.
Either SignError (a -> b)
-> Either SignError a -> Either SignError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashAlgorithm
-> PrivateKey -> ByteString -> Either SignError ByteString
rsaPKCS15Sign HashAlgorithm
ha PrivateKey
prv ByteString
payloadToSign
  where
    sig0 :: SignaturePayload
sig0 = SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV6 SigType
st PubKeyAlgorithm
RSA HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
has [] Word16
0 ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI Integer
0])
    payloadToSign :: ByteString
payloadToSign = ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sig0) (TextNormalizationMode -> SigType -> ByteString -> ByteString
normalizePayloadForSigTypeWith TextNormalizationMode
mode SigType
st ByteString
payload))

signDataWithRSA ::
     SigType
  -> RSATypes.PrivateKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithRSA :: SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSA SigType
st PrivateKey
prv [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload =
  TextNormalizationMode
-> SigType
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> ByteString
-> Either SignError SignaturePayload
signRSAV4Core TextNormalizationMode
CleartextCompat SigType
st HashAlgorithm
SHA512 [SigSubPacket]
has [SigSubPacket]
uhas PrivateKey
prv ByteString
payload

signDataWithRSAV6 ::
     SigType
  -> SignatureSalt
  -> RSATypes.PrivateKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithRSAV6 :: SigType
-> SignatureSalt
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithRSAV6 SigType
st SignatureSalt
salt PrivateKey
prv [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload =
  TextNormalizationMode
-> SigType
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> ByteString
-> Either SignError SignaturePayload
signRSAV6Core TextNormalizationMode
CleartextCompat SigType
st HashAlgorithm
SHA512 SignatureSalt
salt [SigSubPacket]
has [SigSubPacket]
uhas PrivateKey
prv ByteString
payload

ed25519Params :: (String, Int, Int, PubKeyAlgorithm)
ed25519Params :: (String, Int, Int, PubKeyAlgorithm)
ed25519Params = (String
"Ed25519", Int
64, Int
32, PubKeyAlgorithm
PKA.Ed25519)

ed448Params :: (String, Int, Int, PubKeyAlgorithm)
ed448Params :: (String, Int, Int, PubKeyAlgorithm)
ed448Params = (String
"Ed448", Int
114, Int
57, PubKeyAlgorithm
PKA.Ed448)

signDataWithEdDSAV4Generic ::
     (String, Int, Int, PubKeyAlgorithm)
  -> (B.ByteString -> B.ByteString)
  -> TextNormalizationMode
  -> HashAlgorithm
  -> SigType
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEdDSAV4Generic :: (String, Int, Int, PubKeyAlgorithm)
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> HashAlgorithm
-> SigType
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEdDSAV4Generic (String
algoName, Int
sigLen, Int
limbLen, PubKeyAlgorithm
pka) ByteString -> ByteString
signer TextNormalizationMode
mode HashAlgorithm
ha SigType
st [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload =
  String
-> Int
-> Int
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signEdDSAV4 String
algoName Int
sigLen Int
limbLen ByteString -> ByteString
signer TextNormalizationMode
mode SigType
st PubKeyAlgorithm
pka HashAlgorithm
ha [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload

signDataWithEdDSAV6Generic ::
     (String, Int, Int, PubKeyAlgorithm)
  -> (B.ByteString -> B.ByteString)
  -> TextNormalizationMode
  -> HashAlgorithm
  -> SigType
  -> SignatureSalt
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEdDSAV6Generic :: (String, Int, Int, PubKeyAlgorithm)
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> HashAlgorithm
-> SigType
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEdDSAV6Generic (String
algoName, Int
sigLen, Int
limbLen, PubKeyAlgorithm
pka) ByteString -> ByteString
signer TextNormalizationMode
mode HashAlgorithm
ha SigType
st SignatureSalt
salt [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload =
  String
-> Int
-> Int
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signEdDSAV6 String
algoName Int
sigLen Int
limbLen ByteString -> ByteString
signer TextNormalizationMode
mode SigType
st PubKeyAlgorithm
pka HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload

signDataWithEd25519 ::
     SigType
  -> Ed25519.SecretKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd25519 :: SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519 SigType
st SecretKey
sk [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload =
  (String, Int, Int, PubKeyAlgorithm)
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> HashAlgorithm
-> SigType
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEdDSAV4Generic (String, Int, Int, PubKeyAlgorithm)
ed25519Params (SecretKey -> ByteString -> ByteString
ed25519Signer SecretKey
sk) TextNormalizationMode
CleartextCompat HashAlgorithm
SHA512 SigType
st [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload

signDataWithEd25519V6 ::
     SigType
  -> SignatureSalt
  -> Ed25519.SecretKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd25519V6 :: SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd25519V6 SigType
st SignatureSalt
salt SecretKey
sk [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload =
  (String, Int, Int, PubKeyAlgorithm)
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> HashAlgorithm
-> SigType
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEdDSAV6Generic (String, Int, Int, PubKeyAlgorithm)
ed25519Params (SecretKey -> ByteString -> ByteString
ed25519Signer SecretKey
sk) TextNormalizationMode
CleartextCompat HashAlgorithm
SHA512 SigType
st SignatureSalt
salt [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload

signDataWithEd448 ::
     SigType
  -> Ed448.SecretKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd448 :: SigType
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448 SigType
st SecretKey
sk [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload =
  (String, Int, Int, PubKeyAlgorithm)
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> HashAlgorithm
-> SigType
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEdDSAV4Generic (String, Int, Int, PubKeyAlgorithm)
ed448Params (SecretKey -> ByteString -> ByteString
ed448Signer SecretKey
sk) TextNormalizationMode
CleartextCompat HashAlgorithm
SHA512 SigType
st [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload

signDataWithEd448V6 ::
     SigType
  -> SignatureSalt
  -> Ed448.SecretKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd448V6 :: SigType
-> SignatureSalt
-> SecretKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEd448V6 SigType
st SignatureSalt
salt SecretKey
sk [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload =
  (String, Int, Int, PubKeyAlgorithm)
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> HashAlgorithm
-> SigType
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEdDSAV6Generic (String, Int, Int, PubKeyAlgorithm)
ed448Params (SecretKey -> ByteString -> ByteString
ed448Signer SecretKey
sk) TextNormalizationMode
CleartextCompat HashAlgorithm
SHA512 SigType
st SignatureSalt
salt [SigSubPacket]
has [SigSubPacket]
uhas ByteString
payload

-- | Builder-based signature creation for RSA
-- 
-- Example usage:
--   builder <- sigBuilderInit BinarySig RSA SHA512
--   builder' <- addHashedSubs hashedSubpackets builder
--   builder'' <- addUnhashedSubs unhashedSubpackets builder'
--   sig <- signDataWithRSABuilder builder'' rsaPrivateKey payload
signDataWithRSABuilder ::
     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig 'PKA.RSA
  -> RSATypes.PrivateKey
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithRSABuilder :: SigBuilder Unhashed V4Sig 'RSA
-> PrivateKey -> ByteString -> Either SignError SignaturePayload
signDataWithRSABuilder SigBuilder Unhashed V4Sig 'RSA
builder PrivateKey
prv ByteString
payload =
  TextNormalizationMode
-> SigType
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> ByteString
-> Either SignError SignaturePayload
signRSAV4Core
    (SigBuilder Unhashed V4Sig 'RSA -> TextNormalizationMode
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> TextNormalizationMode
sbTextNormMode SigBuilder Unhashed V4Sig 'RSA
builder)
    (SigBuilder Unhashed V4Sig 'RSA -> SigType
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> SigType
sbSigType SigBuilder Unhashed V4Sig 'RSA
builder)
    (SigBuilder Unhashed V4Sig 'RSA -> HashAlgorithm
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> HashAlgorithm
sbHashAlgo SigBuilder Unhashed V4Sig 'RSA
builder)
    (SigBuilder Unhashed V4Sig 'RSA -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbHashedSubs SigBuilder Unhashed V4Sig 'RSA
builder)
    (SigBuilder Unhashed V4Sig 'RSA -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbUnhashedSubs SigBuilder Unhashed V4Sig 'RSA
builder)
    PrivateKey
prv
    ByteString
payload

-- | Builder-based signature creation for RSA (v6)
signDataWithRSAV6Builder ::
     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V6Sig 'PKA.RSA
  -> RSATypes.PrivateKey
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithRSAV6Builder :: SigBuilder Unhashed V6Sig 'RSA
-> PrivateKey -> ByteString -> Either SignError SignaturePayload
signDataWithRSAV6Builder SigBuilder Unhashed V6Sig 'RSA
builder PrivateKey
prv ByteString
payload =
  TextNormalizationMode
-> SigType
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> ByteString
-> Either SignError SignaturePayload
signRSAV6Core
    (SigBuilder Unhashed V6Sig 'RSA -> TextNormalizationMode
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> TextNormalizationMode
sbTextNormMode SigBuilder Unhashed V6Sig 'RSA
builder)
    (SigBuilder Unhashed V6Sig 'RSA -> SigType
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> SigType
sbSigType SigBuilder Unhashed V6Sig 'RSA
builder)
    (SigBuilder Unhashed V6Sig 'RSA -> HashAlgorithm
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> HashAlgorithm
sbHashAlgo SigBuilder Unhashed V6Sig 'RSA
builder)
    (SigBuilder Unhashed V6Sig 'RSA -> BuilderSalt V6Sig
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> BuilderSalt v
sbSalt SigBuilder Unhashed V6Sig 'RSA
builder)
    (SigBuilder Unhashed V6Sig 'RSA -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbHashedSubs SigBuilder Unhashed V6Sig 'RSA
builder)
    (SigBuilder Unhashed V6Sig 'RSA -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbUnhashedSubs SigBuilder Unhashed V6Sig 'RSA
builder)
    PrivateKey
prv
    ByteString
payload

-- | Builder-based signature creation for Ed25519 (v4)
--
-- Example usage:
--   builder <- sigBuilderInit BinarySig Ed25519 SHA512
--   builder' <- addHashedSubs hashedSubpackets builder
--   builder'' <- addUnhashedSubs unhashedSubpackets builder'
--   sig <- signDataWithEd25519Builder builder'' ed25519PrivateKey payload
signDataWithEd25519Builder ::
     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig 'PKA.Ed25519
  -> Ed25519.SecretKey
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd25519Builder :: SigBuilder Unhashed V4Sig 'Ed25519
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd25519Builder SigBuilder Unhashed V4Sig 'Ed25519
builder SecretKey
sk ByteString
payload =
  (String, Int, Int, PubKeyAlgorithm)
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> HashAlgorithm
-> SigType
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEdDSAV4Generic (String, Int, Int, PubKeyAlgorithm)
ed25519Params (SecretKey -> ByteString -> ByteString
ed25519Signer SecretKey
sk)
    (SigBuilder Unhashed V4Sig 'Ed25519 -> TextNormalizationMode
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> TextNormalizationMode
sbTextNormMode SigBuilder Unhashed V4Sig 'Ed25519
builder) (SigBuilder Unhashed V4Sig 'Ed25519 -> HashAlgorithm
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> HashAlgorithm
sbHashAlgo SigBuilder Unhashed V4Sig 'Ed25519
builder) (SigBuilder Unhashed V4Sig 'Ed25519 -> SigType
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> SigType
sbSigType SigBuilder Unhashed V4Sig 'Ed25519
builder)
    (SigBuilder Unhashed V4Sig 'Ed25519 -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbHashedSubs SigBuilder Unhashed V4Sig 'Ed25519
builder) (SigBuilder Unhashed V4Sig 'Ed25519 -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbUnhashedSubs SigBuilder Unhashed V4Sig 'Ed25519
builder) ByteString
payload

-- | Builder-based signature creation for Ed25519 (v6)
--
-- Example usage:
--   builder <- sigBuilderInitV6 BinarySig Ed25519 SHA512 salt
--   builder' <- addHashedSubs hashedSubpackets builder
--   builder'' <- addUnhashedSubs unhashedSubpackets builder'
--   sig <- signDataWithEd25519V6Builder builder'' ed25519PrivateKey payload
signDataWithEd25519V6Builder ::
     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V6Sig 'PKA.Ed25519
  -> Ed25519.SecretKey
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd25519V6Builder :: SigBuilder Unhashed V6Sig 'Ed25519
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd25519V6Builder SigBuilder Unhashed V6Sig 'Ed25519
builder SecretKey
sk ByteString
payload =
  (String, Int, Int, PubKeyAlgorithm)
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> HashAlgorithm
-> SigType
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEdDSAV6Generic (String, Int, Int, PubKeyAlgorithm)
ed25519Params (SecretKey -> ByteString -> ByteString
ed25519Signer SecretKey
sk)
    (SigBuilder Unhashed V6Sig 'Ed25519 -> TextNormalizationMode
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> TextNormalizationMode
sbTextNormMode SigBuilder Unhashed V6Sig 'Ed25519
builder) (SigBuilder Unhashed V6Sig 'Ed25519 -> HashAlgorithm
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> HashAlgorithm
sbHashAlgo SigBuilder Unhashed V6Sig 'Ed25519
builder) (SigBuilder Unhashed V6Sig 'Ed25519 -> SigType
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> SigType
sbSigType SigBuilder Unhashed V6Sig 'Ed25519
builder)
    (SigBuilder Unhashed V6Sig 'Ed25519 -> BuilderSalt V6Sig
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> BuilderSalt v
sbSalt SigBuilder Unhashed V6Sig 'Ed25519
builder) (SigBuilder Unhashed V6Sig 'Ed25519 -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbHashedSubs SigBuilder Unhashed V6Sig 'Ed25519
builder) (SigBuilder Unhashed V6Sig 'Ed25519 -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbUnhashedSubs SigBuilder Unhashed V6Sig 'Ed25519
builder) ByteString
payload

-- | Builder-based signature creation for Ed448 (v4)
--
-- Example usage:
--   builder <- sigBuilderInit BinarySig Ed448 SHA512
--   builder' <- addHashedSubs hashedSubpackets builder
--   builder'' <- addUnhashedSubs unhashedSubpackets builder'
--   sig <- signDataWithEd448Builder builder'' ed448PrivateKey payload
signDataWithEd448Builder ::
     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig 'PKA.Ed448
  -> Ed448.SecretKey
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd448Builder :: SigBuilder Unhashed V4Sig 'Ed448
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd448Builder SigBuilder Unhashed V4Sig 'Ed448
builder SecretKey
sk ByteString
payload =
  (String, Int, Int, PubKeyAlgorithm)
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> HashAlgorithm
-> SigType
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEdDSAV4Generic (String, Int, Int, PubKeyAlgorithm)
ed448Params (SecretKey -> ByteString -> ByteString
ed448Signer SecretKey
sk)
    (SigBuilder Unhashed V4Sig 'Ed448 -> TextNormalizationMode
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> TextNormalizationMode
sbTextNormMode SigBuilder Unhashed V4Sig 'Ed448
builder) (SigBuilder Unhashed V4Sig 'Ed448 -> HashAlgorithm
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> HashAlgorithm
sbHashAlgo SigBuilder Unhashed V4Sig 'Ed448
builder) (SigBuilder Unhashed V4Sig 'Ed448 -> SigType
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> SigType
sbSigType SigBuilder Unhashed V4Sig 'Ed448
builder)
    (SigBuilder Unhashed V4Sig 'Ed448 -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbHashedSubs SigBuilder Unhashed V4Sig 'Ed448
builder) (SigBuilder Unhashed V4Sig 'Ed448 -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbUnhashedSubs SigBuilder Unhashed V4Sig 'Ed448
builder) ByteString
payload

-- | Builder-based signature creation for Ed448 (v6)
signDataWithEd448V6Builder ::
     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V6Sig 'PKA.Ed448
  -> Ed448.SecretKey
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd448V6Builder :: SigBuilder Unhashed V6Sig 'Ed448
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd448V6Builder SigBuilder Unhashed V6Sig 'Ed448
builder SecretKey
sk ByteString
payload =
  (String, Int, Int, PubKeyAlgorithm)
-> (ByteString -> ByteString)
-> TextNormalizationMode
-> HashAlgorithm
-> SigType
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signDataWithEdDSAV6Generic (String, Int, Int, PubKeyAlgorithm)
ed448Params (SecretKey -> ByteString -> ByteString
ed448Signer SecretKey
sk)
    (SigBuilder Unhashed V6Sig 'Ed448 -> TextNormalizationMode
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> TextNormalizationMode
sbTextNormMode SigBuilder Unhashed V6Sig 'Ed448
builder) (SigBuilder Unhashed V6Sig 'Ed448 -> HashAlgorithm
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> HashAlgorithm
sbHashAlgo SigBuilder Unhashed V6Sig 'Ed448
builder) (SigBuilder Unhashed V6Sig 'Ed448 -> SigType
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> SigType
sbSigType SigBuilder Unhashed V6Sig 'Ed448
builder)
    (SigBuilder Unhashed V6Sig 'Ed448 -> BuilderSalt V6Sig
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> BuilderSalt v
sbSalt SigBuilder Unhashed V6Sig 'Ed448
builder) (SigBuilder Unhashed V6Sig 'Ed448 -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbHashedSubs SigBuilder Unhashed V6Sig 'Ed448
builder) (SigBuilder Unhashed V6Sig 'Ed448 -> [SigSubPacket]
forall hashedness v (algo :: PubKeyAlgorithm).
SigBuilder hashedness v algo -> [SigSubPacket]
sbUnhashedSubs SigBuilder Unhashed V6Sig 'Ed448
builder) ByteString
payload

-- | Algorithm-agnostic signature builder dispatcher (Phase 2)
-- 
-- Dispatches to the appropriate signing function based on the private key type.
-- The private key type (PrivateKeyFor algo) encodes the algorithm at the type level,
-- allowing compile-time verification that the key and builder algorithm match.
--
-- Example usage:
class BuilderSigningAlgorithm (algo :: PKA.PubKeyAlgorithm) where
  signDataWithAlgorithmicBuilderImpl
    :: SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig algo
    -> PrivateKeyFor algo
    -> ByteString
    -> Either SignError SignaturePayload

instance BuilderSigningAlgorithm 'PKA.RSA where
  signDataWithAlgorithmicBuilderImpl :: SigBuilder Unhashed V4Sig 'RSA
-> PrivateKeyFor 'RSA
-> ByteString
-> Either SignError SignaturePayload
signDataWithAlgorithmicBuilderImpl SigBuilder Unhashed V4Sig 'RSA
builder (SP.RSAPrivateKey PrivateKey
prv) ByteString
payload =
    SigBuilder Unhashed V4Sig 'RSA
-> PrivateKey -> ByteString -> Either SignError SignaturePayload
signDataWithRSABuilder SigBuilder Unhashed V4Sig 'RSA
builder PrivateKey
prv ByteString
payload

instance BuilderSigningAlgorithm 'PKA.Ed25519 where
  signDataWithAlgorithmicBuilderImpl :: SigBuilder Unhashed V4Sig 'Ed25519
-> PrivateKeyFor 'Ed25519
-> ByteString
-> Either SignError SignaturePayload
signDataWithAlgorithmicBuilderImpl SigBuilder Unhashed V4Sig 'Ed25519
builder (SP.Ed25519PrivateKey SecretKey
sk) ByteString
payload =
    SigBuilder Unhashed V4Sig 'Ed25519
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd25519Builder SigBuilder Unhashed V4Sig 'Ed25519
builder SecretKey
sk ByteString
payload

instance BuilderSigningAlgorithm 'PKA.Ed448 where
  signDataWithAlgorithmicBuilderImpl :: SigBuilder Unhashed V4Sig 'Ed448
-> PrivateKeyFor 'Ed448
-> ByteString
-> Either SignError SignaturePayload
signDataWithAlgorithmicBuilderImpl SigBuilder Unhashed V4Sig 'Ed448
builder (SP.Ed448PrivateKey SecretKey
sk) ByteString
payload =
    SigBuilder Unhashed V4Sig 'Ed448
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd448Builder SigBuilder Unhashed V4Sig 'Ed448
builder SecretKey
sk ByteString
payload

-- | Catch-all instance that produces a compile-time error for any algorithm
-- that is not supported by the algorithmic builder (e.g. DSA, ECDSA).
instance {-# OVERLAPPABLE #-}
  TypeError
    ( 'Text "signDataWithAlgorithmicBuilder does not support this algorithm."
    ':$$: 'Text "Supported algorithms: RSA, Ed25519, Ed448."
    ':$$: 'Text "For DSA or ECDSA, use signDataWith{DSA,ECDSA}Builder directly."
    )
  => BuilderSigningAlgorithm algo where
  signDataWithAlgorithmicBuilderImpl :: SigBuilder Unhashed V4Sig algo
-> PrivateKeyFor algo
-> ByteString
-> Either SignError SignaturePayload
signDataWithAlgorithmicBuilderImpl = String
-> SigBuilder Unhashed V4Sig algo
-> PrivateKeyFor algo
-> ByteString
-> Either SignError SignaturePayload
forall a. HasCallStack => String -> a
error String
"unreachable: TypeError fires at compile time"

signDataWithAlgorithmicBuilder
  :: forall (algo :: PKA.PubKeyAlgorithm)
   . BuilderSigningAlgorithm algo
  => SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig algo
  -> PrivateKeyFor algo
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithAlgorithmicBuilder :: forall (algo :: PubKeyAlgorithm).
BuilderSigningAlgorithm algo =>
SigBuilder Unhashed V4Sig algo
-> PrivateKeyFor algo
-> ByteString
-> Either SignError SignaturePayload
signDataWithAlgorithmicBuilder =
  SigBuilder Unhashed V4Sig algo
-> PrivateKeyFor algo
-> ByteString
-> Either SignError SignaturePayload
forall (algo :: PubKeyAlgorithm).
BuilderSigningAlgorithm algo =>
SigBuilder Unhashed V4Sig algo
-> PrivateKeyFor algo
-> ByteString
-> Either SignError SignaturePayload
signDataWithAlgorithmicBuilderImpl