-- Message.hs: OpenPGP (RFC9580) message helpers
-- Copyright © 2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Codec.Encryption.OpenPGP.Message
    ( Passphrase
    , EncryptedPayload
    , mkEncryptedPayload
    , encryptedPayloadBytes
    , ClearPayload
    , mkClearPayload
    , clearPayloadBytes
    , WrappedSessionMaterial
    , SigningAlgorithm (..)
    , SecretKeyFor
    , VersionedPKPayload
    , asV4PKPayload
    , asV6PKPayload
    , Signer
    , SigningCapability
    , mkRSASignerV4
    , mkRSASignerV6
    , mkEd25519SignerV4
    , mkEd25519SignerV6
    , mkEd448SignerV4
    , mkEd448SignerV6
    , MessageParseFailure (..)
    , renderMessageParseFailure
    , MDCFailure (..)
    , AEADFailure (..)
    , renderAEADFailure
    , PayloadDecryptFailure (..)
    , renderPayloadDecryptFailure
    , MessageDecryptFailure (..)
    , renderMessageDecryptFailure
    , MessageEncryptFailure (..)
    , renderMessageEncryptFailure
    , MessageError (..)
    , renderMessageError
    , SessionMaterialExposure (..)
    , EncryptMessageProfile
    , EncryptMessageOptions (..)
    , RecoveredSessionMaterial (..)
    , encryptMessage
    , decryptMessage
    , signMessage
    , signMessageWith
    , ConduitMessage.VerificationPolicy (..)
    , ConduitMessage.VerificationOptions (..)
    , ConduitMessage.defaultVerificationOptions
    , verifySignedMessage
    ) where

import Control.Monad (foldM)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.Ed448 as Ed448
import qualified Crypto.PubKey.RSA.Types as RSATypes
import Crypto.Random.Types (MonadRandom, getRandomBytes)
import Data.Bifunctor (bimap, first)
import Data.Binary (put)
import Data.Binary.Put (runPut)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Functor.Identity (Identity (..), runIdentity)
import Data.Kind (Type)
import Data.Word (Word8)

import Codec.Encryption.OpenPGP.BlockCipher
    ( CipherError
    , keySize
    , renderCipherError
    )
import Codec.Encryption.OpenPGP.CFB
    ( OpenPGPCFBModeW (..)
    , decryptOpenPGPCfb
    , decryptPreservingNonce
    , encryptOpenPGPCfbRaw
    )
import Codec.Encryption.OpenPGP.Encrypt
    ( buildOnePassSignature
    , encryptSEIPDv2WithSKESKBlock
    , renderOPSBuildError
    )
import Codec.Encryption.OpenPGP.Fingerprint
    ( eightOctetKeyID
    , fingerprint
    )
import Codec.Encryption.OpenPGP.Policy
    ( HashAlgorithmW (..)
    , OpenPGPPolicy
    , OpenPGPRFCW (..)
    , defaultPolicy
    , deprecatedHashAlgorithms
    , messageDefaultAEADAlgorithm
    , messageDefaultChunkSize
    , messageSEIPDv2SaltOctets
    , policyGenerationDeprecations
    , policyMessageEncryption
    , supportsSEIPDv2Symmetric
    )
import Codec.Encryption.OpenPGP.S2K
    ( S2KError (..)
    , renderS2KError
    , skesk2SessionKey
    , string2Key
    )
import Codec.Encryption.OpenPGP.SEIPDv1
    ( MDCFailure (..)
    , mdcTrailerForSEIPDv1
    , renderMDCFailure
    , validateSEIPD1MDC
    )
import Codec.Encryption.OpenPGP.SEIPDv2
    ( SEIPDv2Failure (..)
    , decryptSKESK6SessionKey
    , deriveSKESK6KEK
    , renderSEIPDv2Failure
    )
import Codec.Encryption.OpenPGP.Serialize (parsePkts)
import Codec.Encryption.OpenPGP.Signatures
    ( SignError (..)
    , VerificationError
    , renderSignError
    , signDataWithEd25519Builder
    , signDataWithEd25519V6Builder
    , signDataWithEd448Builder
    , signDataWithEd448V6Builder
    , signDataWithRSABuilder
    , signDataWithRSAV6Builder
    )
import Codec.Encryption.OpenPGP.Subpackets
    ( addHashedSubs
    , addUnhashedSubs
    , listToHashedSubs
    , listToUnhashedSubs
    , sigBuilderInitTyped
    , sigBuilderInitV6Typed
    )
import Codec.Encryption.OpenPGP.Types
import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA
import Data.Conduit.OpenPGP.Decrypt (decryptSEIPDv2Payload)
import qualified Data.Conduit.OpenPGP.Message as ConduitMessage

newtype EncryptedPayload = EncryptedPayload {EncryptedPayload -> ByteString
unEncryptedPayload :: BL.ByteString}
    deriving (EncryptedPayload -> EncryptedPayload -> Bool
(EncryptedPayload -> EncryptedPayload -> Bool)
-> (EncryptedPayload -> EncryptedPayload -> Bool)
-> Eq EncryptedPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncryptedPayload -> EncryptedPayload -> Bool
== :: EncryptedPayload -> EncryptedPayload -> Bool
$c/= :: EncryptedPayload -> EncryptedPayload -> Bool
/= :: EncryptedPayload -> EncryptedPayload -> Bool
Eq, Eq EncryptedPayload
Eq EncryptedPayload =>
(EncryptedPayload -> EncryptedPayload -> Ordering)
-> (EncryptedPayload -> EncryptedPayload -> Bool)
-> (EncryptedPayload -> EncryptedPayload -> Bool)
-> (EncryptedPayload -> EncryptedPayload -> Bool)
-> (EncryptedPayload -> EncryptedPayload -> Bool)
-> (EncryptedPayload -> EncryptedPayload -> EncryptedPayload)
-> (EncryptedPayload -> EncryptedPayload -> EncryptedPayload)
-> Ord EncryptedPayload
EncryptedPayload -> EncryptedPayload -> Bool
EncryptedPayload -> EncryptedPayload -> Ordering
EncryptedPayload -> EncryptedPayload -> EncryptedPayload
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EncryptedPayload -> EncryptedPayload -> Ordering
compare :: EncryptedPayload -> EncryptedPayload -> Ordering
$c< :: EncryptedPayload -> EncryptedPayload -> Bool
< :: EncryptedPayload -> EncryptedPayload -> Bool
$c<= :: EncryptedPayload -> EncryptedPayload -> Bool
<= :: EncryptedPayload -> EncryptedPayload -> Bool
$c> :: EncryptedPayload -> EncryptedPayload -> Bool
> :: EncryptedPayload -> EncryptedPayload -> Bool
$c>= :: EncryptedPayload -> EncryptedPayload -> Bool
>= :: EncryptedPayload -> EncryptedPayload -> Bool
$cmax :: EncryptedPayload -> EncryptedPayload -> EncryptedPayload
max :: EncryptedPayload -> EncryptedPayload -> EncryptedPayload
$cmin :: EncryptedPayload -> EncryptedPayload -> EncryptedPayload
min :: EncryptedPayload -> EncryptedPayload -> EncryptedPayload
Ord, Int -> EncryptedPayload -> ShowS
[EncryptedPayload] -> ShowS
EncryptedPayload -> String
(Int -> EncryptedPayload -> ShowS)
-> (EncryptedPayload -> String)
-> ([EncryptedPayload] -> ShowS)
-> Show EncryptedPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncryptedPayload -> ShowS
showsPrec :: Int -> EncryptedPayload -> ShowS
$cshow :: EncryptedPayload -> String
show :: EncryptedPayload -> String
$cshowList :: [EncryptedPayload] -> ShowS
showList :: [EncryptedPayload] -> ShowS
Show)

newtype ClearPayload = ClearPayload {ClearPayload -> ByteString
unClearPayload :: BL.ByteString}
    deriving (ClearPayload -> ClearPayload -> Bool
(ClearPayload -> ClearPayload -> Bool)
-> (ClearPayload -> ClearPayload -> Bool) -> Eq ClearPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClearPayload -> ClearPayload -> Bool
== :: ClearPayload -> ClearPayload -> Bool
$c/= :: ClearPayload -> ClearPayload -> Bool
/= :: ClearPayload -> ClearPayload -> Bool
Eq, Eq ClearPayload
Eq ClearPayload =>
(ClearPayload -> ClearPayload -> Ordering)
-> (ClearPayload -> ClearPayload -> Bool)
-> (ClearPayload -> ClearPayload -> Bool)
-> (ClearPayload -> ClearPayload -> Bool)
-> (ClearPayload -> ClearPayload -> Bool)
-> (ClearPayload -> ClearPayload -> ClearPayload)
-> (ClearPayload -> ClearPayload -> ClearPayload)
-> Ord ClearPayload
ClearPayload -> ClearPayload -> Bool
ClearPayload -> ClearPayload -> Ordering
ClearPayload -> ClearPayload -> ClearPayload
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ClearPayload -> ClearPayload -> Ordering
compare :: ClearPayload -> ClearPayload -> Ordering
$c< :: ClearPayload -> ClearPayload -> Bool
< :: ClearPayload -> ClearPayload -> Bool
$c<= :: ClearPayload -> ClearPayload -> Bool
<= :: ClearPayload -> ClearPayload -> Bool
$c> :: ClearPayload -> ClearPayload -> Bool
> :: ClearPayload -> ClearPayload -> Bool
$c>= :: ClearPayload -> ClearPayload -> Bool
>= :: ClearPayload -> ClearPayload -> Bool
$cmax :: ClearPayload -> ClearPayload -> ClearPayload
max :: ClearPayload -> ClearPayload -> ClearPayload
$cmin :: ClearPayload -> ClearPayload -> ClearPayload
min :: ClearPayload -> ClearPayload -> ClearPayload
Ord, Int -> ClearPayload -> ShowS
[ClearPayload] -> ShowS
ClearPayload -> String
(Int -> ClearPayload -> ShowS)
-> (ClearPayload -> String)
-> ([ClearPayload] -> ShowS)
-> Show ClearPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClearPayload -> ShowS
showsPrec :: Int -> ClearPayload -> ShowS
$cshow :: ClearPayload -> String
show :: ClearPayload -> String
$cshowList :: [ClearPayload] -> ShowS
showList :: [ClearPayload] -> ShowS
Show)

newtype WrappedSessionMaterial = WrappedSessionMaterial
    {WrappedSessionMaterial -> ByteString
unWrappedSessionMaterial :: B.ByteString}
    deriving (WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
(WrappedSessionMaterial -> WrappedSessionMaterial -> Bool)
-> (WrappedSessionMaterial -> WrappedSessionMaterial -> Bool)
-> Eq WrappedSessionMaterial
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
== :: WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
$c/= :: WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
/= :: WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
Eq, Eq WrappedSessionMaterial
Eq WrappedSessionMaterial =>
(WrappedSessionMaterial -> WrappedSessionMaterial -> Ordering)
-> (WrappedSessionMaterial -> WrappedSessionMaterial -> Bool)
-> (WrappedSessionMaterial -> WrappedSessionMaterial -> Bool)
-> (WrappedSessionMaterial -> WrappedSessionMaterial -> Bool)
-> (WrappedSessionMaterial -> WrappedSessionMaterial -> Bool)
-> (WrappedSessionMaterial
    -> WrappedSessionMaterial -> WrappedSessionMaterial)
-> (WrappedSessionMaterial
    -> WrappedSessionMaterial -> WrappedSessionMaterial)
-> Ord WrappedSessionMaterial
WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
WrappedSessionMaterial -> WrappedSessionMaterial -> Ordering
WrappedSessionMaterial
-> WrappedSessionMaterial -> WrappedSessionMaterial
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WrappedSessionMaterial -> WrappedSessionMaterial -> Ordering
compare :: WrappedSessionMaterial -> WrappedSessionMaterial -> Ordering
$c< :: WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
< :: WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
$c<= :: WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
<= :: WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
$c> :: WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
> :: WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
$c>= :: WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
>= :: WrappedSessionMaterial -> WrappedSessionMaterial -> Bool
$cmax :: WrappedSessionMaterial
-> WrappedSessionMaterial -> WrappedSessionMaterial
max :: WrappedSessionMaterial
-> WrappedSessionMaterial -> WrappedSessionMaterial
$cmin :: WrappedSessionMaterial
-> WrappedSessionMaterial -> WrappedSessionMaterial
min :: WrappedSessionMaterial
-> WrappedSessionMaterial -> WrappedSessionMaterial
Ord, Int -> WrappedSessionMaterial -> ShowS
[WrappedSessionMaterial] -> ShowS
WrappedSessionMaterial -> String
(Int -> WrappedSessionMaterial -> ShowS)
-> (WrappedSessionMaterial -> String)
-> ([WrappedSessionMaterial] -> ShowS)
-> Show WrappedSessionMaterial
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WrappedSessionMaterial -> ShowS
showsPrec :: Int -> WrappedSessionMaterial -> ShowS
$cshow :: WrappedSessionMaterial -> String
show :: WrappedSessionMaterial -> String
$cshowList :: [WrappedSessionMaterial] -> ShowS
showList :: [WrappedSessionMaterial] -> ShowS
Show)

data SigningAlgorithm = AlgoRSA | AlgoEd25519 | AlgoEd448

type family SecretKeyFor (alg :: SigningAlgorithm) where
    SecretKeyFor 'AlgoRSA = RSATypes.PrivateKey
    SecretKeyFor 'AlgoEd25519 = Ed25519.SecretKey
    SecretKeyFor 'AlgoEd448 = Ed448.SecretKey

type family KeyVersionForSig (v :: Type) :: KeyVersion where
    KeyVersionForSig V4Sig = 'V4
    KeyVersionForSig V6Sig = 'V6

data VersionedPKPayload (v :: KeyVersion) where
    VersionedPKPayloadV4 :: PKPayload 'V4 -> VersionedPKPayload 'V4
    VersionedPKPayloadV6 :: PKPayload 'V6 -> VersionedPKPayload 'V6

asV4PKPayload
    :: SomePKPayload -> Either String (VersionedPKPayload 'V4)
asV4PKPayload :: SomePKPayload -> Either String (VersionedPKPayload 'V4)
asV4PKPayload (SomePKPayload pk :: PKPayload v
pk@(PKPayloadV4 ThirtyTwoBitTimeStamp
_ PubKeyAlgorithm
_ PKey
_)) =
    VersionedPKPayload 'V4 -> Either String (VersionedPKPayload 'V4)
forall a b. b -> Either a b
Right (PKPayload 'V4 -> VersionedPKPayload 'V4
VersionedPKPayloadV4 PKPayload v
PKPayload 'V4
pk)
asV4PKPayload SomePKPayload
_ = String -> Either String (VersionedPKPayload 'V4)
forall a b. a -> Either a b
Left String
"Expected a v4 PKPayload"

asV6PKPayload
    :: SomePKPayload -> Either String (VersionedPKPayload 'V6)
asV6PKPayload :: SomePKPayload -> Either String (VersionedPKPayload 'V6)
asV6PKPayload (SomePKPayload pk :: PKPayload v
pk@(PKPayloadV6 ThirtyTwoBitTimeStamp
_ PubKeyAlgorithm
_ PKey
_)) =
    VersionedPKPayload 'V6 -> Either String (VersionedPKPayload 'V6)
forall a b. b -> Either a b
Right (PKPayload 'V6 -> VersionedPKPayload 'V6
VersionedPKPayloadV6 PKPayload v
PKPayload 'V6
pk)
asV6PKPayload SomePKPayload
_ = String -> Either String (VersionedPKPayload 'V6)
forall a b. a -> Either a b
Left String
"Expected a v6 PKPayload"

data Signer (alg :: SigningAlgorithm) (v :: Type) where
    RSASigner
        :: VersionedPKPayload (KeyVersionForSig v)
        -> SecretKeyFor 'AlgoRSA
        -> Signer 'AlgoRSA v
    Ed25519Signer
        :: VersionedPKPayload (KeyVersionForSig v)
        -> SecretKeyFor 'AlgoEd25519
        -> Signer 'AlgoEd25519 v
    Ed448Signer
        :: VersionedPKPayload (KeyVersionForSig v)
        -> SecretKeyFor 'AlgoEd448
        -> Signer 'AlgoEd448 v

class SigningCapability (alg :: SigningAlgorithm) v
instance SigningCapability 'AlgoRSA V4Sig
instance SigningCapability 'AlgoRSA V6Sig
instance SigningCapability 'AlgoEd25519 V4Sig
instance SigningCapability 'AlgoEd25519 V6Sig
instance SigningCapability 'AlgoEd448 V4Sig
instance SigningCapability 'AlgoEd448 V6Sig

mkRSASignerV4
    :: VersionedPKPayload 'V4
    -> SecretKeyFor 'AlgoRSA
    -> Signer 'AlgoRSA V4Sig
mkRSASignerV4 :: VersionedPKPayload 'V4
-> SecretKeyFor 'AlgoRSA -> Signer 'AlgoRSA V4Sig
mkRSASignerV4 = VersionedPKPayload 'V4
-> SecretKeyFor 'AlgoRSA -> Signer 'AlgoRSA V4Sig
VersionedPKPayload (KeyVersionForSig V4Sig)
-> SecretKeyFor 'AlgoRSA -> Signer 'AlgoRSA V4Sig
forall v.
VersionedPKPayload (KeyVersionForSig v)
-> SecretKeyFor 'AlgoRSA -> Signer 'AlgoRSA v
RSASigner

mkRSASignerV6
    :: VersionedPKPayload 'V6
    -> SecretKeyFor 'AlgoRSA
    -> Signer 'AlgoRSA V6Sig
mkRSASignerV6 :: VersionedPKPayload 'V6
-> SecretKeyFor 'AlgoRSA -> Signer 'AlgoRSA V6Sig
mkRSASignerV6 = VersionedPKPayload 'V6
-> SecretKeyFor 'AlgoRSA -> Signer 'AlgoRSA V6Sig
VersionedPKPayload (KeyVersionForSig V6Sig)
-> SecretKeyFor 'AlgoRSA -> Signer 'AlgoRSA V6Sig
forall v.
VersionedPKPayload (KeyVersionForSig v)
-> SecretKeyFor 'AlgoRSA -> Signer 'AlgoRSA v
RSASigner

mkEd25519SignerV4
    :: VersionedPKPayload 'V4
    -> SecretKeyFor 'AlgoEd25519
    -> Signer 'AlgoEd25519 V4Sig
mkEd25519SignerV4 :: VersionedPKPayload 'V4
-> SecretKeyFor 'AlgoEd25519 -> Signer 'AlgoEd25519 V4Sig
mkEd25519SignerV4 = VersionedPKPayload 'V4
-> SecretKeyFor 'AlgoEd25519 -> Signer 'AlgoEd25519 V4Sig
VersionedPKPayload (KeyVersionForSig V4Sig)
-> SecretKeyFor 'AlgoEd25519 -> Signer 'AlgoEd25519 V4Sig
forall v.
VersionedPKPayload (KeyVersionForSig v)
-> SecretKeyFor 'AlgoEd25519 -> Signer 'AlgoEd25519 v
Ed25519Signer

mkEd25519SignerV6
    :: VersionedPKPayload 'V6
    -> SecretKeyFor 'AlgoEd25519
    -> Signer 'AlgoEd25519 V6Sig
mkEd25519SignerV6 :: VersionedPKPayload 'V6
-> SecretKeyFor 'AlgoEd25519 -> Signer 'AlgoEd25519 V6Sig
mkEd25519SignerV6 = VersionedPKPayload 'V6
-> SecretKeyFor 'AlgoEd25519 -> Signer 'AlgoEd25519 V6Sig
VersionedPKPayload (KeyVersionForSig V6Sig)
-> SecretKeyFor 'AlgoEd25519 -> Signer 'AlgoEd25519 V6Sig
forall v.
VersionedPKPayload (KeyVersionForSig v)
-> SecretKeyFor 'AlgoEd25519 -> Signer 'AlgoEd25519 v
Ed25519Signer

mkEd448SignerV4
    :: VersionedPKPayload 'V4
    -> SecretKeyFor 'AlgoEd448
    -> Signer 'AlgoEd448 V4Sig
mkEd448SignerV4 :: VersionedPKPayload 'V4
-> SecretKeyFor 'AlgoEd448 -> Signer 'AlgoEd448 V4Sig
mkEd448SignerV4 = VersionedPKPayload 'V4
-> SecretKeyFor 'AlgoEd448 -> Signer 'AlgoEd448 V4Sig
VersionedPKPayload (KeyVersionForSig V4Sig)
-> SecretKeyFor 'AlgoEd448 -> Signer 'AlgoEd448 V4Sig
forall v.
VersionedPKPayload (KeyVersionForSig v)
-> SecretKeyFor 'AlgoEd448 -> Signer 'AlgoEd448 v
Ed448Signer

mkEd448SignerV6
    :: VersionedPKPayload 'V6
    -> SecretKeyFor 'AlgoEd448
    -> Signer 'AlgoEd448 V6Sig
mkEd448SignerV6 :: VersionedPKPayload 'V6
-> SecretKeyFor 'AlgoEd448 -> Signer 'AlgoEd448 V6Sig
mkEd448SignerV6 = VersionedPKPayload 'V6
-> SecretKeyFor 'AlgoEd448 -> Signer 'AlgoEd448 V6Sig
VersionedPKPayload (KeyVersionForSig V6Sig)
-> SecretKeyFor 'AlgoEd448 -> Signer 'AlgoEd448 V6Sig
forall v.
VersionedPKPayload (KeyVersionForSig v)
-> SecretKeyFor 'AlgoEd448 -> Signer 'AlgoEd448 v
Ed448Signer

data MessageError
    = MessageEncryptFailureError MessageEncryptFailure
    | MessageDecryptError String
    | MessageSignError SignError
    | MessageParseError String
    | MessageParseFailureError MessageParseFailure
    | MessageDecryptFailureError MessageDecryptFailure
    deriving (MessageError -> MessageError -> Bool
(MessageError -> MessageError -> Bool)
-> (MessageError -> MessageError -> Bool) -> Eq MessageError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageError -> MessageError -> Bool
== :: MessageError -> MessageError -> Bool
$c/= :: MessageError -> MessageError -> Bool
/= :: MessageError -> MessageError -> Bool
Eq, Int -> MessageError -> ShowS
[MessageError] -> ShowS
MessageError -> String
(Int -> MessageError -> ShowS)
-> (MessageError -> String)
-> ([MessageError] -> ShowS)
-> Show MessageError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageError -> ShowS
showsPrec :: Int -> MessageError -> ShowS
$cshow :: MessageError -> String
show :: MessageError -> String
$cshowList :: [MessageError] -> ShowS
showList :: [MessageError] -> ShowS
Show)

messageStep
    :: Monad m => Either MessageError a -> ExceptT MessageError m a
messageStep :: forall (m :: * -> *) a.
Monad m =>
Either MessageError a -> ExceptT MessageError m a
messageStep = m (Either MessageError a) -> ExceptT MessageError m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either MessageError a) -> ExceptT MessageError m a)
-> (Either MessageError a -> m (Either MessageError a))
-> Either MessageError a
-> ExceptT MessageError m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either MessageError a -> m (Either MessageError a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

runMessageFlow
    :: ExceptT MessageError Identity a -> Either MessageError a
runMessageFlow :: forall a. ExceptT MessageError Identity a -> Either MessageError a
runMessageFlow = Identity (Either MessageError a) -> Either MessageError a
forall a. Identity a -> a
runIdentity (Identity (Either MessageError a) -> Either MessageError a)
-> (ExceptT MessageError Identity a
    -> Identity (Either MessageError a))
-> ExceptT MessageError Identity a
-> Either MessageError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT MessageError Identity a -> Identity (Either MessageError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

type MessageFlowT m = ExceptT MessageError m

runMessageFlowT :: MessageFlowT m a -> m (Either MessageError a)
runMessageFlowT :: forall (m :: * -> *) a.
MessageFlowT m a -> m (Either MessageError a)
runMessageFlowT = ExceptT MessageError m a -> m (Either MessageError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

signStepT :: Monad m => Either SignError a -> MessageFlowT m a
signStepT :: forall (m :: * -> *) a.
Monad m =>
Either SignError a -> MessageFlowT m a
signStepT = m (Either MessageError a) -> ExceptT MessageError m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either MessageError a) -> ExceptT MessageError m a)
-> (Either SignError a -> m (Either MessageError a))
-> Either SignError a
-> ExceptT MessageError m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either MessageError a -> m (Either MessageError a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either MessageError a -> m (Either MessageError a))
-> (Either SignError a -> Either MessageError a)
-> Either SignError a
-> m (Either MessageError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignError -> MessageError)
-> Either SignError a -> Either MessageError 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 SignError -> MessageError
MessageSignError

parseStep
    :: Monad m
    => Either MessageParseFailure a -> ExceptT MessageError m a
parseStep :: forall (m :: * -> *) a.
Monad m =>
Either MessageParseFailure a -> ExceptT MessageError m a
parseStep = Either MessageError a -> ExceptT MessageError m a
forall (m :: * -> *) a.
Monad m =>
Either MessageError a -> ExceptT MessageError m a
messageStep (Either MessageError a -> ExceptT MessageError m a)
-> (Either MessageParseFailure a -> Either MessageError a)
-> Either MessageParseFailure a
-> ExceptT MessageError m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MessageParseFailure -> MessageError)
-> Either MessageParseFailure a -> Either MessageError 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 MessageParseFailure -> MessageError
MessageParseFailureError

decryptStep
    :: Monad m
    => Either MessageDecryptFailure a -> ExceptT MessageError m a
decryptStep :: forall (m :: * -> *) a.
Monad m =>
Either MessageDecryptFailure a -> ExceptT MessageError m a
decryptStep = Either MessageError a -> ExceptT MessageError m a
forall (m :: * -> *) a.
Monad m =>
Either MessageError a -> ExceptT MessageError m a
messageStep (Either MessageError a -> ExceptT MessageError m a)
-> (Either MessageDecryptFailure a -> Either MessageError a)
-> Either MessageDecryptFailure a
-> ExceptT MessageError m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MessageDecryptFailure -> MessageError)
-> Either MessageDecryptFailure a -> Either MessageError 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 MessageDecryptFailure -> MessageError
MessageDecryptFailureError

encryptStep
    :: Monad m
    => Either MessageEncryptFailure a -> ExceptT MessageError m a
encryptStep :: forall (m :: * -> *) a.
Monad m =>
Either MessageEncryptFailure a -> ExceptT MessageError m a
encryptStep = Either MessageError a -> ExceptT MessageError m a
forall (m :: * -> *) a.
Monad m =>
Either MessageError a -> ExceptT MessageError m a
messageStep (Either MessageError a -> ExceptT MessageError m a)
-> (Either MessageEncryptFailure a -> Either MessageError a)
-> Either MessageEncryptFailure a
-> ExceptT MessageError m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MessageEncryptFailure -> MessageError)
-> Either MessageEncryptFailure a -> Either MessageError 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 MessageEncryptFailure -> MessageError
MessageEncryptFailureError

data MessageParseFailure
    = MissingEncryptedMessage
    | ExpectedSKESKThenEncryptedData
    | SKESKSEIPDAlgorithmMismatch
    | UnsupportedEncryptedSKESK
    | MissingLiteralDataPacket
    | UnknownCriticalPacketType Word8
    | BrokenCriticalPacketType Word8 String
    deriving (MessageParseFailure -> MessageParseFailure -> Bool
(MessageParseFailure -> MessageParseFailure -> Bool)
-> (MessageParseFailure -> MessageParseFailure -> Bool)
-> Eq MessageParseFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageParseFailure -> MessageParseFailure -> Bool
== :: MessageParseFailure -> MessageParseFailure -> Bool
$c/= :: MessageParseFailure -> MessageParseFailure -> Bool
/= :: MessageParseFailure -> MessageParseFailure -> Bool
Eq, Int -> MessageParseFailure -> ShowS
[MessageParseFailure] -> ShowS
MessageParseFailure -> String
(Int -> MessageParseFailure -> ShowS)
-> (MessageParseFailure -> String)
-> ([MessageParseFailure] -> ShowS)
-> Show MessageParseFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageParseFailure -> ShowS
showsPrec :: Int -> MessageParseFailure -> ShowS
$cshow :: MessageParseFailure -> String
show :: MessageParseFailure -> String
$cshowList :: [MessageParseFailure] -> ShowS
showList :: [MessageParseFailure] -> ShowS
Show)

data AEADFailure
    = AEADChunkAuthFailed AEADAlgorithm Int
    | AEADFinalTagFailed AEADAlgorithm
    | AEADInitFailed CipherError
    deriving (AEADFailure -> AEADFailure -> Bool
(AEADFailure -> AEADFailure -> Bool)
-> (AEADFailure -> AEADFailure -> Bool) -> Eq AEADFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AEADFailure -> AEADFailure -> Bool
== :: AEADFailure -> AEADFailure -> Bool
$c/= :: AEADFailure -> AEADFailure -> Bool
/= :: AEADFailure -> AEADFailure -> Bool
Eq, Int -> AEADFailure -> ShowS
[AEADFailure] -> ShowS
AEADFailure -> String
(Int -> AEADFailure -> ShowS)
-> (AEADFailure -> String)
-> ([AEADFailure] -> ShowS)
-> Show AEADFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AEADFailure -> ShowS
showsPrec :: Int -> AEADFailure -> ShowS
$cshow :: AEADFailure -> String
show :: AEADFailure -> String
$cshowList :: [AEADFailure] -> ShowS
showList :: [AEADFailure] -> ShowS
Show)

data PayloadDecryptFailure
    = PayloadDecryptCipherFailed CipherError
    | PayloadDecryptMDCFailed MDCFailure
    | PayloadDecryptAEADFailed AEADFailure
    | PayloadDecryptSEIPDv2Failed SEIPDv2Failure
    | PayloadDecryptGeneric String
    deriving (PayloadDecryptFailure -> PayloadDecryptFailure -> Bool
(PayloadDecryptFailure -> PayloadDecryptFailure -> Bool)
-> (PayloadDecryptFailure -> PayloadDecryptFailure -> Bool)
-> Eq PayloadDecryptFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PayloadDecryptFailure -> PayloadDecryptFailure -> Bool
== :: PayloadDecryptFailure -> PayloadDecryptFailure -> Bool
$c/= :: PayloadDecryptFailure -> PayloadDecryptFailure -> Bool
/= :: PayloadDecryptFailure -> PayloadDecryptFailure -> Bool
Eq, Int -> PayloadDecryptFailure -> ShowS
[PayloadDecryptFailure] -> ShowS
PayloadDecryptFailure -> String
(Int -> PayloadDecryptFailure -> ShowS)
-> (PayloadDecryptFailure -> String)
-> ([PayloadDecryptFailure] -> ShowS)
-> Show PayloadDecryptFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PayloadDecryptFailure -> ShowS
showsPrec :: Int -> PayloadDecryptFailure -> ShowS
$cshow :: PayloadDecryptFailure -> String
show :: PayloadDecryptFailure -> String
$cshowList :: [PayloadDecryptFailure] -> ShowS
showList :: [PayloadDecryptFailure] -> ShowS
Show)

data MessageDecryptFailure
    = SessionMaterialDerivationFailed S2KError
    | PayloadDecryptFailed PayloadDecryptFailure
    deriving (MessageDecryptFailure -> MessageDecryptFailure -> Bool
(MessageDecryptFailure -> MessageDecryptFailure -> Bool)
-> (MessageDecryptFailure -> MessageDecryptFailure -> Bool)
-> Eq MessageDecryptFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageDecryptFailure -> MessageDecryptFailure -> Bool
== :: MessageDecryptFailure -> MessageDecryptFailure -> Bool
$c/= :: MessageDecryptFailure -> MessageDecryptFailure -> Bool
/= :: MessageDecryptFailure -> MessageDecryptFailure -> Bool
Eq, Int -> MessageDecryptFailure -> ShowS
[MessageDecryptFailure] -> ShowS
MessageDecryptFailure -> String
(Int -> MessageDecryptFailure -> ShowS)
-> (MessageDecryptFailure -> String)
-> ([MessageDecryptFailure] -> ShowS)
-> Show MessageDecryptFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageDecryptFailure -> ShowS
showsPrec :: Int -> MessageDecryptFailure -> ShowS
$cshow :: MessageDecryptFailure -> String
show :: MessageDecryptFailure -> String
$cshowList :: [MessageDecryptFailure] -> ShowS
showList :: [MessageDecryptFailure] -> ShowS
Show)

data MessageEncryptFailure
    = MessageEncryptSEIPDv2Failed SEIPDv2Failure
    | MessageEncryptCipherFailed CipherError
    | MessageEncryptS2KFailed S2KError
    | MessageEncryptDeprecatedS2KHash HashAlgorithm
    | MessageEncryptUnsupportedSymmetricAlgorithm SymmetricAlgorithm
    deriving (MessageEncryptFailure -> MessageEncryptFailure -> Bool
(MessageEncryptFailure -> MessageEncryptFailure -> Bool)
-> (MessageEncryptFailure -> MessageEncryptFailure -> Bool)
-> Eq MessageEncryptFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageEncryptFailure -> MessageEncryptFailure -> Bool
== :: MessageEncryptFailure -> MessageEncryptFailure -> Bool
$c/= :: MessageEncryptFailure -> MessageEncryptFailure -> Bool
/= :: MessageEncryptFailure -> MessageEncryptFailure -> Bool
Eq, Int -> MessageEncryptFailure -> ShowS
[MessageEncryptFailure] -> ShowS
MessageEncryptFailure -> String
(Int -> MessageEncryptFailure -> ShowS)
-> (MessageEncryptFailure -> String)
-> ([MessageEncryptFailure] -> ShowS)
-> Show MessageEncryptFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageEncryptFailure -> ShowS
showsPrec :: Int -> MessageEncryptFailure -> ShowS
$cshow :: MessageEncryptFailure -> String
show :: MessageEncryptFailure -> String
$cshowList :: [MessageEncryptFailure] -> ShowS
showList :: [MessageEncryptFailure] -> ShowS
Show)

data ParsedEncryptedPayloadKind
    = LegacySEDPayloadKind
    | LegacySEIPDv1PayloadKind
    | SEIPDv2PayloadKind

data EncryptedPreludeKind
    = LegacyEncryptedPreludeKind
    | SEIPDv2EncryptedPreludeKind

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

data EncryptMessageProfile
    = RFC4880Message
    | RFC9580Message

data EncryptMessageOptions (p :: EncryptMessageProfile) where
    RFC4880EncryptMessageOptions
        :: { EncryptMessageOptions 'RFC4880Message -> SessionMaterialExposure
rfc4880EncryptMessageExposure :: SessionMaterialExposure
           , EncryptMessageOptions 'RFC4880Message -> SymmetricAlgorithm
rfc4880EncryptMessageSymmetricAlgorithm :: SymmetricAlgorithm
           , EncryptMessageOptions 'RFC4880Message -> S2K
rfc4880EncryptMessageS2K :: S2K
           , EncryptMessageOptions 'RFC4880Message -> IV
rfc4880EncryptMessageIV :: IV
           }
        -> EncryptMessageOptions 'RFC4880Message
    RFC9580EncryptMessageOptions
        :: { EncryptMessageOptions 'RFC9580Message -> SessionMaterialExposure
rfc9580EncryptMessageExposure :: SessionMaterialExposure
           , EncryptMessageOptions 'RFC9580Message -> SymmetricAlgorithm
rfc9580EncryptMessageSymmetricAlgorithm :: SymmetricAlgorithm
           , EncryptMessageOptions 'RFC9580Message -> S2K
rfc9580EncryptMessageS2K :: S2K
           , EncryptMessageOptions 'RFC9580Message -> IV
rfc9580EncryptMessageIV :: IV
           }
        -> EncryptMessageOptions 'RFC9580Message

deriving instance Eq (EncryptMessageOptions p)
deriving instance Show (EncryptMessageOptions p)

data RecoveredSessionMaterial
    = RecoveredSessionMaterial
    { RecoveredSessionMaterial -> SymmetricAlgorithm
recoveredSessionAlgorithm :: SymmetricAlgorithm
    , RecoveredSessionMaterial -> SessionKey
recoveredSessionKey :: SessionKey
    }
    deriving (RecoveredSessionMaterial -> RecoveredSessionMaterial -> Bool
(RecoveredSessionMaterial -> RecoveredSessionMaterial -> Bool)
-> (RecoveredSessionMaterial -> RecoveredSessionMaterial -> Bool)
-> Eq RecoveredSessionMaterial
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecoveredSessionMaterial -> RecoveredSessionMaterial -> Bool
== :: RecoveredSessionMaterial -> RecoveredSessionMaterial -> Bool
$c/= :: RecoveredSessionMaterial -> RecoveredSessionMaterial -> Bool
/= :: RecoveredSessionMaterial -> RecoveredSessionMaterial -> Bool
Eq, Int -> RecoveredSessionMaterial -> ShowS
[RecoveredSessionMaterial] -> ShowS
RecoveredSessionMaterial -> String
(Int -> RecoveredSessionMaterial -> ShowS)
-> (RecoveredSessionMaterial -> String)
-> ([RecoveredSessionMaterial] -> ShowS)
-> Show RecoveredSessionMaterial
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecoveredSessionMaterial -> ShowS
showsPrec :: Int -> RecoveredSessionMaterial -> ShowS
$cshow :: RecoveredSessionMaterial -> String
show :: RecoveredSessionMaterial -> String
$cshowList :: [RecoveredSessionMaterial] -> ShowS
showList :: [RecoveredSessionMaterial] -> ShowS
Show)

renderMessageParseFailure :: MessageParseFailure -> String
renderMessageParseFailure :: MessageParseFailure -> String
renderMessageParseFailure MessageParseFailure
MissingEncryptedMessage =
    String
"Could not parse encrypted OpenPGP message"
renderMessageParseFailure MessageParseFailure
ExpectedSKESKThenEncryptedData =
    String
"Expected an SKESK packet followed by symmetrically encrypted data or SEIPD v2 data"
renderMessageParseFailure MessageParseFailure
SKESKSEIPDAlgorithmMismatch =
    String
"SKESK and SEIPD v2 algorithms do not match"
renderMessageParseFailure MessageParseFailure
UnsupportedEncryptedSKESK =
    String
"Cannot decrypt SKESK packets with encrypted session keys"
renderMessageParseFailure MessageParseFailure
MissingLiteralDataPacket =
    String
"Decrypted message does not contain a literal data packet"
renderMessageParseFailure (UnknownCriticalPacketType Word8
t) =
    String
"Unknown critical packet type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
t
renderMessageParseFailure (BrokenCriticalPacketType Word8
t String
err) =
    String
"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

renderMessageDecryptFailure :: MessageDecryptFailure -> String
renderMessageDecryptFailure :: MessageDecryptFailure -> String
renderMessageDecryptFailure (SessionMaterialDerivationFailed S2KError
err) = S2KError -> String
renderS2KError S2KError
err
renderMessageDecryptFailure (PayloadDecryptFailed PayloadDecryptFailure
err) = PayloadDecryptFailure -> String
renderPayloadDecryptFailure PayloadDecryptFailure
err

renderMessageEncryptFailure :: MessageEncryptFailure -> String
renderMessageEncryptFailure :: MessageEncryptFailure -> String
renderMessageEncryptFailure (MessageEncryptSEIPDv2Failed SEIPDv2Failure
err) = SEIPDv2Failure -> String
renderSEIPDv2Failure SEIPDv2Failure
err
renderMessageEncryptFailure (MessageEncryptCipherFailed CipherError
err) = CipherError -> String
renderCipherError CipherError
err
renderMessageEncryptFailure (MessageEncryptS2KFailed S2KError
err) = S2KError -> String
renderS2KError S2KError
err
renderMessageEncryptFailure (MessageEncryptDeprecatedS2KHash HashAlgorithm
ha) =
    String
"deprecated hash algorithm disallowed for modern message generation: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha
renderMessageEncryptFailure (MessageEncryptUnsupportedSymmetricAlgorithm SymmetricAlgorithm
sa) =
    String
"symmetric algorithm disallowed for RFC9580 message generation: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymmetricAlgorithm -> String
forall a. Show a => a -> String
show SymmetricAlgorithm
sa

renderAEADFailure :: AEADFailure -> String
renderAEADFailure :: AEADFailure -> String
renderAEADFailure (AEADChunkAuthFailed AEADAlgorithm
algo Int
chunk) =
    String
"AEAD chunk authentication failed for "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ AEADAlgorithm -> String
forall a. Show a => a -> String
show AEADAlgorithm
algo
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at chunk "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
chunk
renderAEADFailure (AEADFinalTagFailed AEADAlgorithm
algo) =
    String
"AEAD final tag verification failed for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AEADAlgorithm -> String
forall a. Show a => a -> String
show AEADAlgorithm
algo
renderAEADFailure (AEADInitFailed CipherError
err) =
    String
"AEAD initialization failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CipherError -> String
renderCipherError CipherError
err

renderPayloadDecryptFailure :: PayloadDecryptFailure -> String
renderPayloadDecryptFailure :: PayloadDecryptFailure -> String
renderPayloadDecryptFailure (PayloadDecryptCipherFailed CipherError
err) = CipherError -> String
renderCipherError CipherError
err
renderPayloadDecryptFailure (PayloadDecryptMDCFailed MDCFailure
err) = MDCFailure -> String
renderMDCFailure MDCFailure
err
renderPayloadDecryptFailure (PayloadDecryptAEADFailed AEADFailure
err) = AEADFailure -> String
renderAEADFailure AEADFailure
err
renderPayloadDecryptFailure (PayloadDecryptSEIPDv2Failed SEIPDv2Failure
err) = SEIPDv2Failure -> String
renderSEIPDv2Failure SEIPDv2Failure
err
renderPayloadDecryptFailure (PayloadDecryptGeneric String
err) = String
err

renderMessageError :: MessageError -> String
renderMessageError :: MessageError -> String
renderMessageError (MessageEncryptFailureError MessageEncryptFailure
err) = MessageEncryptFailure -> String
renderMessageEncryptFailure MessageEncryptFailure
err
renderMessageError (MessageDecryptError String
err) = String
err
renderMessageError (MessageSignError SignError
err) = SignError -> String
renderSignError SignError
err
renderMessageError (MessageParseError String
err) = String
err
renderMessageError (MessageParseFailureError MessageParseFailure
err) = MessageParseFailure -> String
renderMessageParseFailure MessageParseFailure
err
renderMessageError (MessageDecryptFailureError MessageDecryptFailure
err) = MessageDecryptFailure -> String
renderMessageDecryptFailure MessageDecryptFailure
err

mkEncryptedPayload :: BL.ByteString -> EncryptedPayload
mkEncryptedPayload :: ByteString -> EncryptedPayload
mkEncryptedPayload = ByteString -> EncryptedPayload
EncryptedPayload

mkClearPayload :: BL.ByteString -> ClearPayload
mkClearPayload :: ByteString -> ClearPayload
mkClearPayload = ByteString -> ClearPayload
ClearPayload

clearPayloadBytes :: ClearPayload -> BL.ByteString
clearPayloadBytes :: ClearPayload -> ByteString
clearPayloadBytes = ClearPayload -> ByteString
unClearPayload

encryptedPayloadBytes :: EncryptedPayload -> BL.ByteString
encryptedPayloadBytes :: EncryptedPayload -> ByteString
encryptedPayloadBytes = EncryptedPayload -> ByteString
unEncryptedPayload

signBackendStep :: Either String a -> Either SignError a
signBackendStep :: forall a. Either String a -> Either SignError a
signBackendStep = (String -> SignError) -> Either String a -> Either SignError 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 String -> SignError
SignBackendError

decryptSessionStep
    :: Either S2KError a -> Either MessageDecryptFailure a
decryptSessionStep :: forall a. Either S2KError a -> Either MessageDecryptFailure a
decryptSessionStep = (S2KError -> MessageDecryptFailure)
-> Either S2KError a -> Either MessageDecryptFailure 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 S2KError -> MessageDecryptFailure
SessionMaterialDerivationFailed

decryptSessionKeySizeStep
    :: Either CipherError a -> Either MessageDecryptFailure a
decryptSessionKeySizeStep :: forall a. Either CipherError a -> Either MessageDecryptFailure a
decryptSessionKeySizeStep =
    (CipherError -> MessageDecryptFailure)
-> Either CipherError a -> Either MessageDecryptFailure 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
        (S2KError -> MessageDecryptFailure
SessionMaterialDerivationFailed (S2KError -> MessageDecryptFailure)
-> (CipherError -> S2KError)
-> CipherError
-> MessageDecryptFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherError -> S2KError
S2KUnsupportedAlgorithm)

decryptCipherStep
    :: Either CipherError a -> Either MessageDecryptFailure a
decryptCipherStep :: forall a. Either CipherError a -> Either MessageDecryptFailure a
decryptCipherStep = (CipherError -> MessageDecryptFailure)
-> Either CipherError a -> Either MessageDecryptFailure 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 (PayloadDecryptFailure -> MessageDecryptFailure
PayloadDecryptFailed (PayloadDecryptFailure -> MessageDecryptFailure)
-> (CipherError -> PayloadDecryptFailure)
-> CipherError
-> MessageDecryptFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherError -> PayloadDecryptFailure
PayloadDecryptCipherFailed)

decryptMDCStep
    :: Either MDCFailure a -> Either MessageDecryptFailure a
decryptMDCStep :: forall a. Either MDCFailure a -> Either MessageDecryptFailure a
decryptMDCStep = (MDCFailure -> MessageDecryptFailure)
-> Either MDCFailure a -> Either MessageDecryptFailure 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 (PayloadDecryptFailure -> MessageDecryptFailure
PayloadDecryptFailed (PayloadDecryptFailure -> MessageDecryptFailure)
-> (MDCFailure -> PayloadDecryptFailure)
-> MDCFailure
-> MessageDecryptFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MDCFailure -> PayloadDecryptFailure
PayloadDecryptMDCFailed)

decryptSEIPDv2Step
    :: Either SEIPDv2Failure a -> Either MessageDecryptFailure a
decryptSEIPDv2Step :: forall a. Either SEIPDv2Failure a -> Either MessageDecryptFailure a
decryptSEIPDv2Step = (SEIPDv2Failure -> MessageDecryptFailure)
-> Either SEIPDv2Failure a -> Either MessageDecryptFailure 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 (PayloadDecryptFailure -> MessageDecryptFailure
PayloadDecryptFailed (PayloadDecryptFailure -> MessageDecryptFailure)
-> (SEIPDv2Failure -> PayloadDecryptFailure)
-> SEIPDv2Failure
-> MessageDecryptFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEIPDv2Failure -> PayloadDecryptFailure
PayloadDecryptSEIPDv2Failed)

encryptMessage
    :: EncryptMessageOptions p
    -> Passphrase
    -> ClearPayload
    -> Either
        MessageError
        (EncryptedPayload, Maybe RecoveredSessionMaterial)
encryptMessage :: forall (p :: EncryptMessageProfile).
EncryptMessageOptions p
-> Passphrase
-> ClearPayload
-> Either
     MessageError (EncryptedPayload, Maybe RecoveredSessionMaterial)
encryptMessage EncryptMessageOptions p
options Passphrase
passphrase ClearPayload
payload = ExceptT
  MessageError
  Identity
  (EncryptedPayload, Maybe RecoveredSessionMaterial)
-> Either
     MessageError (EncryptedPayload, Maybe RecoveredSessionMaterial)
forall a. ExceptT MessageError Identity a -> Either MessageError a
runMessageFlow (ExceptT
   MessageError
   Identity
   (EncryptedPayload, Maybe RecoveredSessionMaterial)
 -> Either
      MessageError (EncryptedPayload, Maybe RecoveredSessionMaterial))
-> ExceptT
     MessageError
     Identity
     (EncryptedPayload, Maybe RecoveredSessionMaterial)
-> Either
     MessageError (EncryptedPayload, Maybe RecoveredSessionMaterial)
forall a b. (a -> b) -> a -> b
$
    case EncryptMessageOptions p
options of
        RFC4880EncryptMessageOptions SessionMaterialExposure
exposure SymmetricAlgorithm
sa S2K
s2k IV
iv -> do
            encryptedPayload <-
                SymmetricAlgorithm
-> S2K
-> IV
-> Passphrase
-> ClearPayload
-> ExceptT MessageError Identity EncryptedPayload
forall (m :: * -> *).
Monad m =>
SymmetricAlgorithm
-> S2K
-> IV
-> Passphrase
-> ClearPayload
-> ExceptT MessageError m EncryptedPayload
encryptMessageWithRFC4880Fallback SymmetricAlgorithm
sa S2K
s2k IV
iv Passphrase
passphrase ClearPayload
payload
            sessionKeyMaterial <- deriveSessionMaterial sa s2k passphrase
            pure
                ( encryptedPayload
                , exposedSessionMaterial exposure sa sessionKeyMaterial
                )
        RFC9580EncryptMessageOptions SessionMaterialExposure
exposure SymmetricAlgorithm
sa S2K
s2k IV
iv -> do
            Either MessageEncryptFailure () -> ExceptT MessageError Identity ()
forall (m :: * -> *) a.
Monad m =>
Either MessageEncryptFailure a -> ExceptT MessageError m a
encryptStep (Either MessageEncryptFailure ()
 -> ExceptT MessageError Identity ())
-> Either MessageEncryptFailure ()
-> ExceptT MessageError Identity ()
forall a b. (a -> b) -> a -> b
$ OpenPGPPolicy
-> SymmetricAlgorithm -> Either MessageEncryptFailure ()
validateRFC9580MessageSymmetric OpenPGPPolicy
defaultPolicy SymmetricAlgorithm
sa
            Either MessageEncryptFailure () -> ExceptT MessageError Identity ()
forall (m :: * -> *) a.
Monad m =>
Either MessageEncryptFailure a -> ExceptT MessageError m a
encryptStep (Either MessageEncryptFailure ()
 -> ExceptT MessageError Identity ())
-> Either MessageEncryptFailure ()
-> ExceptT MessageError Identity ()
forall a b. (a -> b) -> a -> b
$ OpenPGPPolicy -> S2K -> Either MessageEncryptFailure ()
validateModernMessageS2K OpenPGPPolicy
defaultPolicy S2K
s2k
            encrypted <-
                Either MessageEncryptFailure [Pkt]
-> ExceptT MessageError Identity [Pkt]
forall (m :: * -> *) a.
Monad m =>
Either MessageEncryptFailure a -> ExceptT MessageError m a
encryptStep (Either MessageEncryptFailure [Pkt]
 -> ExceptT MessageError Identity [Pkt])
-> (Either SEIPDv2Failure [Pkt]
    -> Either MessageEncryptFailure [Pkt])
-> Either SEIPDv2Failure [Pkt]
-> ExceptT MessageError Identity [Pkt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SEIPDv2Failure -> MessageEncryptFailure)
-> Either SEIPDv2Failure [Pkt]
-> Either MessageEncryptFailure [Pkt]
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 SEIPDv2Failure -> MessageEncryptFailure
MessageEncryptSEIPDv2Failed (Either SEIPDv2Failure [Pkt]
 -> ExceptT MessageError Identity [Pkt])
-> Either SEIPDv2Failure [Pkt]
-> ExceptT MessageError Identity [Pkt]
forall a b. (a -> b) -> a -> b
$
                    SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> S2K
-> ByteString
-> Block Pkt
-> Either SEIPDv2Failure [Pkt]
encryptSEIPDv2WithSKESKBlock
                        SymmetricAlgorithm
sa
                        (MessageEncryptionPolicy -> AEADAlgorithm
messageDefaultAEADAlgorithm MessageEncryptionPolicy
messagePolicy)
                        (MessageEncryptionPolicy -> Word8
messageDefaultChunkSize MessageEncryptionPolicy
messagePolicy)
                        ( Int -> IV -> Salt
defaultSEIPDv2SaltFromIV
                            (MessageEncryptionPolicy -> Int
messageSEIPDv2SaltOctets MessageEncryptionPolicy
messagePolicy)
                            IV
iv
                        )
                        S2K
s2k
                        (Passphrase -> ByteString
unPassphrase Passphrase
passphrase)
                        ( [Pkt] -> Block Pkt
forall a. [a] -> Block a
Block
                            [LiteralDataType
-> ByteString -> ThirtyTwoBitTimeStamp -> ByteString -> Pkt
LiteralDataPkt LiteralDataType
BinaryData ByteString
BL.empty ThirtyTwoBitTimeStamp
0 (ClearPayload -> ByteString
unClearPayload ClearPayload
payload)]
                        )
            sessionKeyMaterial <- deriveSessionMaterial sa s2k passphrase
            pure
                ( EncryptedPayload (runPut (put (Block encrypted)))
                , exposedSessionMaterial exposure sa sessionKeyMaterial
                )
  where
    messagePolicy :: MessageEncryptionPolicy
messagePolicy = OpenPGPPolicy -> MessageEncryptionPolicy
policyMessageEncryption OpenPGPPolicy
defaultPolicy

defaultSEIPDv2SaltFromIV :: Int -> IV -> Salt
defaultSEIPDv2SaltFromIV :: Int -> IV -> Salt
defaultSEIPDv2SaltFromIV Int
outputLen (IV ByteString
ivBytes) =
    ByteString -> Salt
Salt (Int -> ByteString -> ByteString
B.take Int
outputLen ([ByteString] -> ByteString
B.concat (Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate Int
outputLen ByteString
seed)))
  where
    seed :: ByteString
seed
        | ByteString -> Bool
B.null ByteString
ivBytes = Word8 -> ByteString
B.singleton Word8
0
        | Bool
otherwise = ByteString
ivBytes

encryptMessageWithRFC4880Fallback
    :: Monad m
    => SymmetricAlgorithm
    -> S2K
    -> IV
    -> Passphrase
    -> ClearPayload
    -> ExceptT MessageError m EncryptedPayload
encryptMessageWithRFC4880Fallback :: forall (m :: * -> *).
Monad m =>
SymmetricAlgorithm
-> S2K
-> IV
-> Passphrase
-> ClearPayload
-> ExceptT MessageError m EncryptedPayload
encryptMessageWithRFC4880Fallback SymmetricAlgorithm
sa S2K
s2k IV
iv Passphrase
passphrase ClearPayload
payload = do
    keyLen <-
        Either MessageEncryptFailure Int -> ExceptT MessageError m Int
forall (m :: * -> *) a.
Monad m =>
Either MessageEncryptFailure a -> ExceptT MessageError m a
encryptStep (Either MessageEncryptFailure Int -> ExceptT MessageError m Int)
-> (Either CipherError Int -> Either MessageEncryptFailure Int)
-> Either CipherError Int
-> ExceptT MessageError m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CipherError -> MessageEncryptFailure)
-> Either CipherError Int -> Either MessageEncryptFailure Int
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 CipherError -> MessageEncryptFailure
MessageEncryptCipherFailed (Either CipherError Int -> ExceptT MessageError m Int)
-> Either CipherError Int -> ExceptT MessageError m Int
forall a b. (a -> b) -> a -> b
$ SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa
    sessionMaterial <-
        encryptStep . first MessageEncryptS2KFailed $
            WrappedSessionMaterial
                <$> string2Key s2k keyLen (unPassphrase passphrase)
    let literal =
            LiteralDataType
-> ByteString -> ThirtyTwoBitTimeStamp -> ByteString -> Pkt
LiteralDataPkt LiteralDataType
BinaryData ByteString
BL.empty ThirtyTwoBitTimeStamp
0 (ClearPayload -> ByteString
unClearPayload ClearPayload
payload)
        cleartext = ByteString -> ByteString
BL.toStrict (Put -> ByteString
runPut (Block Pkt -> Put
forall t. Binary t => t -> Put
put ([Pkt] -> Block Pkt
forall a. [a] -> Block a
Block [Pkt
literal])))
        cleartextWithMDC = ByteString
cleartext ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> IV -> ByteString -> ByteString
mdcTrailerForSEIPDv1 IV
iv ByteString
cleartext
    encrypted <-
        encryptStep . first MessageEncryptCipherFailed $
            encryptOpenPGPCfbRaw
                OpenPGPCFBNoResyncW
                sa
                iv
                cleartextWithMDC
                (unWrappedSessionMaterial sessionMaterial)
    return . EncryptedPayload . runPut . put $
        Block
            [ SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k Nothing))
            , SymEncIntegrityProtectedDataPkt
                (SEIPD1 1 (BL.fromStrict encrypted))
            ]

deriveSessionMaterial
    :: Monad m
    => SymmetricAlgorithm
    -> S2K
    -> Passphrase
    -> ExceptT MessageError m B.ByteString
deriveSessionMaterial :: forall (m :: * -> *).
Monad m =>
SymmetricAlgorithm
-> S2K -> Passphrase -> ExceptT MessageError m ByteString
deriveSessionMaterial SymmetricAlgorithm
sa S2K
s2k Passphrase
passphrase = do
    keyLen <-
        Either MessageEncryptFailure Int -> ExceptT MessageError m Int
forall (m :: * -> *) a.
Monad m =>
Either MessageEncryptFailure a -> ExceptT MessageError m a
encryptStep (Either MessageEncryptFailure Int -> ExceptT MessageError m Int)
-> (Either CipherError Int -> Either MessageEncryptFailure Int)
-> Either CipherError Int
-> ExceptT MessageError m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CipherError -> MessageEncryptFailure)
-> Either CipherError Int -> Either MessageEncryptFailure Int
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 CipherError -> MessageEncryptFailure
MessageEncryptCipherFailed (Either CipherError Int -> ExceptT MessageError m Int)
-> Either CipherError Int -> ExceptT MessageError m Int
forall a b. (a -> b) -> a -> b
$ SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa
    encryptStep . first MessageEncryptS2KFailed $
        string2Key s2k keyLen (unPassphrase passphrase)

exposedSessionMaterial
    :: SessionMaterialExposure
    -> SymmetricAlgorithm
    -> B.ByteString
    -> Maybe RecoveredSessionMaterial
exposedSessionMaterial :: SessionMaterialExposure
-> SymmetricAlgorithm
-> ByteString
-> Maybe RecoveredSessionMaterial
exposedSessionMaterial SessionMaterialExposure
DoNotExposeSessionMaterial SymmetricAlgorithm
_ ByteString
_ = Maybe RecoveredSessionMaterial
forall a. Maybe a
Nothing
exposedSessionMaterial SessionMaterialExposure
ExposeSessionMaterial SymmetricAlgorithm
sa ByteString
sessionKeyMaterial =
    RecoveredSessionMaterial -> Maybe RecoveredSessionMaterial
forall a. a -> Maybe a
Just
        ( RecoveredSessionMaterial
            { recoveredSessionAlgorithm :: SymmetricAlgorithm
recoveredSessionAlgorithm = SymmetricAlgorithm
sa
            , recoveredSessionKey :: SessionKey
recoveredSessionKey = ByteString -> SessionKey
SessionKey ByteString
sessionKeyMaterial
            }
        )

decryptMessage
    :: Passphrase
    -> EncryptedPayload
    -> Either MessageError ClearPayload
decryptMessage :: Passphrase -> EncryptedPayload -> Either MessageError ClearPayload
decryptMessage Passphrase
passphrase EncryptedPayload
encrypted = ExceptT MessageError Identity ClearPayload
-> Either MessageError ClearPayload
forall a. ExceptT MessageError Identity a -> Either MessageError a
runMessageFlow (ExceptT MessageError Identity ClearPayload
 -> Either MessageError ClearPayload)
-> ExceptT MessageError Identity ClearPayload
-> Either MessageError ClearPayload
forall a b. (a -> b) -> a -> b
$ do
    encryptedPackets <-
        Either MessageParseFailure [Pkt]
-> ExceptT MessageError Identity [Pkt]
forall (m :: * -> *) a.
Monad m =>
Either MessageParseFailure a -> ExceptT MessageError m a
parseStep (Either MessageParseFailure [Pkt]
 -> ExceptT MessageError Identity [Pkt])
-> Either MessageParseFailure [Pkt]
-> ExceptT MessageError Identity [Pkt]
forall a b. (a -> b) -> a -> b
$
            [Pkt] -> Either MessageParseFailure [Pkt]
rejectUnknownCriticalPacketsTyped
                (ByteString -> [Pkt]
parsePkts (EncryptedPayload -> ByteString
unEncryptedPayload EncryptedPayload
encrypted))
    payload <-
        parseStep $ extractEncryptedPayload encryptedPackets
    cleartext <-
        decryptStep $ decryptPayload passphrase payload
    clearPackets <-
        parseStep $
            rejectUnknownCriticalPacketsTyped
                (parsePkts (unClearPayload cleartext))
    parseStep $ extractLiteralPayload clearPackets

signMessageWith
    :: (MonadRandom m, SigningCapability alg v)
    => Signer alg v
    -> ClearPayload
    -> m (Either MessageError BL.ByteString)
signMessageWith :: forall (m :: * -> *) (alg :: SigningAlgorithm) v.
(MonadRandom m, SigningCapability alg v) =>
Signer alg v -> ClearPayload -> m (Either MessageError ByteString)
signMessageWith Signer alg v
signer ClearPayload
payload =
    MessageFlowT m ByteString -> m (Either MessageError ByteString)
forall (m :: * -> *) a.
MessageFlowT m a -> m (Either MessageError a)
runMessageFlowT (MessageFlowT m ByteString -> m (Either MessageError ByteString))
-> MessageFlowT m ByteString -> m (Either MessageError ByteString)
forall a b. (a -> b) -> a -> b
$
        let applySubs :: SigBuilder Hashed v algo
-> [SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed v algo
applySubs SigBuilder Hashed v algo
builder [SigSubPacket]
hashed [SigSubPacket]
unhashed =
                UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs
                    ([SigSubPacket] -> UnhashedSubpackets v
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
unhashed)
                    (HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs ([SigSubPacket] -> HashedSubpackets v
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
hashed) SigBuilder Hashed v algo
builder)
         in case Signer alg v
signer of
                RSASigner VersionedPKPayload (KeyVersionForSig v)
signerPK SecretKeyFor 'AlgoRSA
signingKey ->
                    case VersionedPKPayload (KeyVersionForSig v)
signerPK of
                        VersionedPKPayloadV4 PKPayload 'V4
pk ->
                            PKPayload 'V4
-> ([SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
forall (m :: * -> *).
Monad m =>
PKPayload 'V4
-> ([SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
signV4Message
                                PKPayload 'V4
pk
                                ( \[SigSubPacket]
hashed [SigSubPacket]
unhashed ByteString
clear ->
                                    SigBuilder Unhashed V4Sig 'RSA
-> PrivateKey -> ByteString -> Either SignError SignaturePayload
signDataWithRSABuilder
                                        ( SigBuilder Hashed V4Sig 'RSA
-> [SigSubPacket]
-> [SigSubPacket]
-> SigBuilder Unhashed V4Sig 'RSA
forall {v} {algo :: PubKeyAlgorithm}.
SigBuilder Hashed v algo
-> [SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed v algo
applySubs
                                            (forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(HashAlgoAllowedFor rfc h, KnownPubKeyAlgorithm algo) =>
OpenPGPRFCW rfc
-> SigType -> HashAlgorithmW h -> SigBuilder Hashed V4Sig algo
sigBuilderInitTyped @'PKA.RSA OpenPGPRFCW 'RFC9580
RFC9580W SigType
BinarySig HashAlgorithmW 'SHA512
SHA512W)
                                            [SigSubPacket]
hashed
                                            [SigSubPacket]
unhashed
                                        )
                                        PrivateKey
SecretKeyFor 'AlgoRSA
signingKey
                                        ByteString
clear
                                )
                                ClearPayload
payload
                        VersionedPKPayloadV6 PKPayload 'V6
pk ->
                            PKPayload 'V6
-> (SignatureSalt
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
forall (m :: * -> *).
MonadRandom m =>
PKPayload 'V6
-> (SignatureSalt
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
signV6Message
                                PKPayload 'V6
pk
                                ( \SignatureSalt
salt [SigSubPacket]
hashed [SigSubPacket]
unhashed ByteString
clear ->
                                    SigBuilder Unhashed V6Sig 'RSA
-> PrivateKey -> ByteString -> Either SignError SignaturePayload
signDataWithRSAV6Builder
                                        ( SigBuilder Hashed V6Sig 'RSA
-> [SigSubPacket]
-> [SigSubPacket]
-> SigBuilder Unhashed V6Sig 'RSA
forall {v} {algo :: PubKeyAlgorithm}.
SigBuilder Hashed v algo
-> [SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed v algo
applySubs
                                            (forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(HashAlgoAllowedFor rfc h, KnownPubKeyAlgorithm algo) =>
OpenPGPRFCW rfc
-> SigType
-> HashAlgorithmW h
-> SignatureSalt
-> SigBuilder Hashed V6Sig algo
sigBuilderInitV6Typed @'PKA.RSA OpenPGPRFCW 'RFC9580
RFC9580W SigType
BinarySig HashAlgorithmW 'SHA512
SHA512W SignatureSalt
salt)
                                            [SigSubPacket]
hashed
                                            [SigSubPacket]
unhashed
                                        )
                                        PrivateKey
SecretKeyFor 'AlgoRSA
signingKey
                                        ByteString
clear
                                )
                                ClearPayload
payload
                Ed25519Signer VersionedPKPayload (KeyVersionForSig v)
signerPK SecretKeyFor 'AlgoEd25519
signingKey ->
                    case VersionedPKPayload (KeyVersionForSig v)
signerPK of
                        VersionedPKPayloadV4 PKPayload 'V4
pk ->
                            PKPayload 'V4
-> ([SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
forall (m :: * -> *).
Monad m =>
PKPayload 'V4
-> ([SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
signV4Message
                                PKPayload 'V4
pk
                                ( \[SigSubPacket]
hashed [SigSubPacket]
unhashed ByteString
clear ->
                                    SigBuilder Unhashed V4Sig 'Ed25519
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd25519Builder
                                        ( SigBuilder Hashed V4Sig 'Ed25519
-> [SigSubPacket]
-> [SigSubPacket]
-> SigBuilder Unhashed V4Sig 'Ed25519
forall {v} {algo :: PubKeyAlgorithm}.
SigBuilder Hashed v algo
-> [SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed v algo
applySubs
                                            (forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(HashAlgoAllowedFor rfc h, KnownPubKeyAlgorithm algo) =>
OpenPGPRFCW rfc
-> SigType -> HashAlgorithmW h -> SigBuilder Hashed V4Sig algo
sigBuilderInitTyped @'PKA.Ed25519 OpenPGPRFCW 'RFC9580
RFC9580W SigType
BinarySig HashAlgorithmW 'SHA512
SHA512W)
                                            [SigSubPacket]
hashed
                                            [SigSubPacket]
unhashed
                                        )
                                        SecretKey
SecretKeyFor 'AlgoEd25519
signingKey
                                        ByteString
clear
                                )
                                ClearPayload
payload
                        VersionedPKPayloadV6 PKPayload 'V6
pk ->
                            PKPayload 'V6
-> (SignatureSalt
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
forall (m :: * -> *).
MonadRandom m =>
PKPayload 'V6
-> (SignatureSalt
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
signV6Message
                                PKPayload 'V6
pk
                                ( \SignatureSalt
salt [SigSubPacket]
hashed [SigSubPacket]
unhashed ByteString
clear ->
                                    SigBuilder Unhashed V6Sig 'Ed25519
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd25519V6Builder
                                        ( SigBuilder Hashed V6Sig 'Ed25519
-> [SigSubPacket]
-> [SigSubPacket]
-> SigBuilder Unhashed V6Sig 'Ed25519
forall {v} {algo :: PubKeyAlgorithm}.
SigBuilder Hashed v algo
-> [SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed v algo
applySubs
                                            ( forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(HashAlgoAllowedFor rfc h, KnownPubKeyAlgorithm algo) =>
OpenPGPRFCW rfc
-> SigType
-> HashAlgorithmW h
-> SignatureSalt
-> SigBuilder Hashed V6Sig algo
sigBuilderInitV6Typed @'PKA.Ed25519
                                                OpenPGPRFCW 'RFC9580
RFC9580W
                                                SigType
BinarySig
                                                HashAlgorithmW 'SHA512
SHA512W
                                                SignatureSalt
salt
                                            )
                                            [SigSubPacket]
hashed
                                            [SigSubPacket]
unhashed
                                        )
                                        SecretKey
SecretKeyFor 'AlgoEd25519
signingKey
                                        ByteString
clear
                                )
                                ClearPayload
payload
                Ed448Signer VersionedPKPayload (KeyVersionForSig v)
signerPK SecretKeyFor 'AlgoEd448
signingKey ->
                    case VersionedPKPayload (KeyVersionForSig v)
signerPK of
                        VersionedPKPayloadV4 PKPayload 'V4
pk ->
                            PKPayload 'V4
-> ([SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
forall (m :: * -> *).
Monad m =>
PKPayload 'V4
-> ([SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
signV4Message
                                PKPayload 'V4
pk
                                ( \[SigSubPacket]
hashed [SigSubPacket]
unhashed ByteString
clear ->
                                    SigBuilder Unhashed V4Sig 'Ed448
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd448Builder
                                        ( SigBuilder Hashed V4Sig 'Ed448
-> [SigSubPacket]
-> [SigSubPacket]
-> SigBuilder Unhashed V4Sig 'Ed448
forall {v} {algo :: PubKeyAlgorithm}.
SigBuilder Hashed v algo
-> [SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed v algo
applySubs
                                            (forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(HashAlgoAllowedFor rfc h, KnownPubKeyAlgorithm algo) =>
OpenPGPRFCW rfc
-> SigType -> HashAlgorithmW h -> SigBuilder Hashed V4Sig algo
sigBuilderInitTyped @'PKA.Ed448 OpenPGPRFCW 'RFC9580
RFC9580W SigType
BinarySig HashAlgorithmW 'SHA512
SHA512W)
                                            [SigSubPacket]
hashed
                                            [SigSubPacket]
unhashed
                                        )
                                        SecretKey
SecretKeyFor 'AlgoEd448
signingKey
                                        ByteString
clear
                                )
                                ClearPayload
payload
                        VersionedPKPayloadV6 PKPayload 'V6
pk ->
                            PKPayload 'V6
-> (SignatureSalt
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
forall (m :: * -> *).
MonadRandom m =>
PKPayload 'V6
-> (SignatureSalt
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
signV6Message
                                PKPayload 'V6
pk
                                ( \SignatureSalt
salt [SigSubPacket]
hashed [SigSubPacket]
unhashed ByteString
clear ->
                                    SigBuilder Unhashed V6Sig 'Ed448
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd448V6Builder
                                        ( SigBuilder Hashed V6Sig 'Ed448
-> [SigSubPacket]
-> [SigSubPacket]
-> SigBuilder Unhashed V6Sig 'Ed448
forall {v} {algo :: PubKeyAlgorithm}.
SigBuilder Hashed v algo
-> [SigSubPacket] -> [SigSubPacket] -> SigBuilder Unhashed v algo
applySubs
                                            (forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(HashAlgoAllowedFor rfc h, KnownPubKeyAlgorithm algo) =>
OpenPGPRFCW rfc
-> SigType
-> HashAlgorithmW h
-> SignatureSalt
-> SigBuilder Hashed V6Sig algo
sigBuilderInitV6Typed @'PKA.Ed448 OpenPGPRFCW 'RFC9580
RFC9580W SigType
BinarySig HashAlgorithmW 'SHA512
SHA512W SignatureSalt
salt)
                                            [SigSubPacket]
hashed
                                            [SigSubPacket]
unhashed
                                        )
                                        SecretKey
SecretKeyFor 'AlgoEd448
signingKey
                                        ByteString
clear
                                )
                                ClearPayload
payload

signMessage
    :: (MonadRandom m, SigningCapability alg v)
    => Signer alg v
    -> BL.ByteString
    -> m (Either MessageError BL.ByteString)
signMessage :: forall (m :: * -> *) (alg :: SigningAlgorithm) v.
(MonadRandom m, SigningCapability alg v) =>
Signer alg v -> ByteString -> m (Either MessageError ByteString)
signMessage Signer alg v
signer = Signer alg v -> ClearPayload -> m (Either MessageError ByteString)
forall (m :: * -> *) (alg :: SigningAlgorithm) v.
(MonadRandom m, SigningCapability alg v) =>
Signer alg v -> ClearPayload -> m (Either MessageError ByteString)
signMessageWith Signer alg v
signer (ClearPayload -> m (Either MessageError ByteString))
-> (ByteString -> ClearPayload)
-> ByteString
-> m (Either MessageError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ClearPayload
mkClearPayload

verifySignedMessage
    :: ConduitMessage.VerificationOptions
    -> PublicKeyring
    -> BL.ByteString
    -> [Either VerificationError Verification]
verifySignedMessage :: VerificationOptions
-> PublicKeyring
-> ByteString
-> [Either VerificationError Verification]
verifySignedMessage = VerificationOptions
-> PublicKeyring
-> ByteString
-> [Either VerificationError Verification]
ConduitMessage.verifyMessage

signV4Message
    :: Monad m
    => PKPayload 'V4
    -> ( [SigSubPacket]
         -> [SigSubPacket]
         -> BL.ByteString
         -> Either SignError SignaturePayload
       )
    -> ClearPayload
    -> MessageFlowT m BL.ByteString
signV4Message :: forall (m :: * -> *).
Monad m =>
PKPayload 'V4
-> ([SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
signV4Message PKPayload 'V4
signer [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signingFn ClearPayload
payload =
    Either SignError ByteString -> MessageFlowT m ByteString
forall (m :: * -> *) a.
Monad m =>
Either SignError a -> MessageFlowT m a
signStepT (PKPayload 'V4
-> ([SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> Either SignError ByteString
signV4WithIssuers PKPayload 'V4
signer [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signingFn ClearPayload
payload)

signV6Message
    :: MonadRandom m
    => PKPayload 'V6
    -> ( SignatureSalt
         -> [SigSubPacket]
         -> [SigSubPacket]
         -> BL.ByteString
         -> Either SignError SignaturePayload
       )
    -> ClearPayload
    -> MessageFlowT m BL.ByteString
signV6Message :: forall (m :: * -> *).
MonadRandom m =>
PKPayload 'V6
-> (SignatureSalt
    -> [SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> MessageFlowT m ByteString
signV6Message PKPayload 'V6
signer SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signingFn ClearPayload
payload = do
    salt <- m SignatureSalt -> ExceptT MessageError m SignatureSalt
forall (m :: * -> *) a. Monad m => m a -> ExceptT MessageError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m SignatureSalt
forall (m :: * -> *). MonadRandom m => m SignatureSalt
randomSHA512SignatureSalt
    signStepT
        (signV6WithFingerprintOnly signer (signingFn salt) payload)

randomSHA512SignatureSalt :: MonadRandom m => m SignatureSalt
randomSHA512SignatureSalt :: forall (m :: * -> *). MonadRandom m => m SignatureSalt
randomSHA512SignatureSalt =
    ByteString -> SignatureSalt
SignatureSalt (ByteString -> SignatureSalt)
-> (ByteString -> ByteString) -> ByteString -> SignatureSalt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> SignatureSalt) -> m ByteString -> m SignatureSalt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32

signV4WithIssuers
    :: PKPayload 'V4
    -> ( [SigSubPacket]
         -> [SigSubPacket]
         -> BL.ByteString
         -> Either SignError SignaturePayload
       )
    -> ClearPayload
    -> Either SignError BL.ByteString
signV4WithIssuers :: PKPayload 'V4
-> ([SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> Either SignError ByteString
signV4WithIssuers PKPayload 'V4
signer [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signingFn ClearPayload
payload = do
    issuerKeyId <-
        Either String EightOctetKeyId -> Either SignError EightOctetKeyId
forall a. Either String a -> Either SignError a
signBackendStep (SomePKPayload -> Either String EightOctetKeyId
eightOctetKeyID (PKPayload 'V4 -> SomePKPayload
forall (v :: KeyVersion). PKPayload v -> SomePKPayload
SomePKPayload PKPayload 'V4
signer))
    let hashed =
            [ Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket
                Bool
False
                ( IssuerFingerprintVersion -> Fingerprint -> SigSubPacketPayload
IssuerFingerprint
                    IssuerFingerprintVersion
IssuerFingerprintV4
                    (SomePKPayload -> Fingerprint
fingerprint (PKPayload 'V4 -> SomePKPayload
forall (v :: KeyVersion). PKPayload v -> SomePKPayload
SomePKPayload PKPayload 'V4
signer))
                )
            ]
        unhashed = [Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (EightOctetKeyId -> SigSubPacketPayload
Issuer EightOctetKeyId
issuerKeyId)]
    signWithSubpackets hashed unhashed signingFn payload

signV6WithFingerprintOnly
    :: PKPayload 'V6
    -> ( [SigSubPacket]
         -> [SigSubPacket]
         -> BL.ByteString
         -> Either SignError SignaturePayload
       )
    -> ClearPayload
    -> Either SignError BL.ByteString
signV6WithFingerprintOnly :: PKPayload 'V6
-> ([SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> Either SignError ByteString
signV6WithFingerprintOnly PKPayload 'V6
signer [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signingFn ClearPayload
payload = do
    let hashed :: [SigSubPacket]
hashed =
            [ Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket
                Bool
False
                ( IssuerFingerprintVersion -> Fingerprint -> SigSubPacketPayload
IssuerFingerprint
                    IssuerFingerprintVersion
IssuerFingerprintV6
                    (SomePKPayload -> Fingerprint
fingerprint (PKPayload 'V6 -> SomePKPayload
forall (v :: KeyVersion). PKPayload v -> SomePKPayload
SomePKPayload PKPayload 'V6
signer))
                )
            ]
        unhashed :: [a]
unhashed = []
    [SigSubPacket]
-> [SigSubPacket]
-> ([SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> Either SignError ByteString
signWithSubpackets [SigSubPacket]
hashed [SigSubPacket]
forall a. [a]
unhashed [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signingFn ClearPayload
payload

signWithSubpackets
    :: [SigSubPacket]
    -> [SigSubPacket]
    -> ( [SigSubPacket]
         -> [SigSubPacket]
         -> BL.ByteString
         -> Either SignError SignaturePayload
       )
    -> ClearPayload
    -> Either SignError BL.ByteString
signWithSubpackets :: [SigSubPacket]
-> [SigSubPacket]
-> ([SigSubPacket]
    -> [SigSubPacket]
    -> ByteString
    -> Either SignError SignaturePayload)
-> ClearPayload
-> Either SignError ByteString
signWithSubpackets [SigSubPacket]
hashed [SigSubPacket]
unhashed [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signingFn ClearPayload
payload = do
    let clear :: ByteString
clear = ClearPayload -> ByteString
unClearPayload ClearPayload
payload
        literal :: Pkt
literal = LiteralDataType
-> ByteString -> ThirtyTwoBitTimeStamp -> ByteString -> Pkt
LiteralDataPkt LiteralDataType
BinaryData ByteString
BL.empty ThirtyTwoBitTimeStamp
0 ByteString
clear
    signature <- [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signingFn [SigSubPacket]
hashed [SigSubPacket]
unhashed ByteString
clear
    let sigPkt = SignaturePayload -> Pkt
SignaturePkt SignaturePayload
signature
    bimap
        (SignBackendError . renderOPSBuildError)
        ( \OnePassSignaturePayload
ops ->
            Put -> ByteString
runPut (Put -> ByteString)
-> (Block Pkt -> Put) -> Block Pkt -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block Pkt -> Put
forall t. Binary t => t -> Put
put (Block Pkt -> ByteString) -> Block Pkt -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pkt] -> Block Pkt
forall a. [a] -> Block a
Block [OnePassSignaturePayload -> Pkt
OnePassSignaturePkt OnePassSignaturePayload
ops, Pkt
literal, Pkt
sigPkt]
        )
        (buildOnePassSignature False signature)

extractEncryptedPayload
    :: [Pkt] -> Either MessageParseFailure SomeParsedEncryptedPayload
extractEncryptedPayload :: [Pkt] -> Either MessageParseFailure SomeParsedEncryptedPayload
extractEncryptedPayload =
    (SomeEncryptedPrelude -> SomeParsedEncryptedPayload)
-> Either MessageParseFailure SomeEncryptedPrelude
-> Either MessageParseFailure SomeParsedEncryptedPayload
forall a b.
(a -> b)
-> Either MessageParseFailure a -> Either MessageParseFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeEncryptedPrelude -> SomeParsedEncryptedPayload
parsedEncryptedPayloadFromPrelude
        (Either MessageParseFailure SomeEncryptedPrelude
 -> Either MessageParseFailure SomeParsedEncryptedPayload)
-> ([Pkt] -> Either MessageParseFailure SomeEncryptedPrelude)
-> [Pkt]
-> Either MessageParseFailure SomeParsedEncryptedPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pkt] -> Either MessageParseFailure SomeEncryptedPrelude
extractEncryptedPreludeTyped

data EncryptedPrelude (k :: EncryptedPreludeKind) where
    LegacySEDPrelude
        :: SKESK 'SKESKV4
        -> B.ByteString
        -> EncryptedPrelude 'LegacyEncryptedPreludeKind
    LegacySEIPDv1Prelude
        :: SKESK 'SKESKV4
        -> B.ByteString
        -> EncryptedPrelude 'LegacyEncryptedPreludeKind
    SEIPDv2SKESK4Prelude
        :: SymmetricAlgorithm
        -> S2K
        -> AEADAlgorithm
        -> Word8
        -> Salt
        -> B.ByteString
        -> EncryptedPrelude 'SEIPDv2EncryptedPreludeKind
    SEIPDv2SKESK6Prelude
        :: SymmetricAlgorithm
        -> AEADAlgorithm
        -> S2K
        -> BL.ByteString
        -> BL.ByteString
        -> BL.ByteString
        -> Word8
        -> Salt
        -> B.ByteString
        -> EncryptedPrelude 'SEIPDv2EncryptedPreludeKind

data SomeEncryptedPrelude where
    SomeEncryptedPrelude
        :: EncryptedPrelude k -> SomeEncryptedPrelude

extractEncryptedPreludeTyped
    :: [Pkt] -> Either MessageParseFailure SomeEncryptedPrelude
extractEncryptedPreludeTyped :: [Pkt] -> Either MessageParseFailure SomeEncryptedPrelude
extractEncryptedPreludeTyped
    ( SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 SymmetricAlgorithm
sa S2K
s2k Maybe ByteString
esk))
            : SymEncDataPkt ByteString
payload
            : [Pkt]
_
        ) =
        SomeEncryptedPrelude
-> Either MessageParseFailure SomeEncryptedPrelude
forall a b. b -> Either a b
Right
            ( EncryptedPrelude 'LegacyEncryptedPreludeKind
-> SomeEncryptedPrelude
forall (v :: EncryptedPreludeKind).
EncryptedPrelude v -> SomeEncryptedPrelude
SomeEncryptedPrelude
                ( SKESK 'SKESKV4
-> ByteString -> EncryptedPrelude 'LegacyEncryptedPreludeKind
LegacySEDPrelude
                    (SymmetricAlgorithm -> S2K -> Maybe ByteString -> SKESK 'SKESKV4
SKESK4Packet SymmetricAlgorithm
sa S2K
s2k Maybe ByteString
esk)
                    (ByteString -> ByteString
BL.toStrict ByteString
payload)
                )
            )
extractEncryptedPreludeTyped
    ( SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 SymmetricAlgorithm
sa S2K
s2k Maybe ByteString
esk))
            : SymEncIntegrityProtectedDataPkt (SEIPD1 Word8
_ ByteString
payload)
            : [Pkt]
_
        ) =
        SomeEncryptedPrelude
-> Either MessageParseFailure SomeEncryptedPrelude
forall a b. b -> Either a b
Right
            ( EncryptedPrelude 'LegacyEncryptedPreludeKind
-> SomeEncryptedPrelude
forall (v :: EncryptedPreludeKind).
EncryptedPrelude v -> SomeEncryptedPrelude
SomeEncryptedPrelude
                ( SKESK 'SKESKV4
-> ByteString -> EncryptedPrelude 'LegacyEncryptedPreludeKind
LegacySEIPDv1Prelude
                    (SymmetricAlgorithm -> S2K -> Maybe ByteString -> SKESK 'SKESKV4
SKESK4Packet SymmetricAlgorithm
sa S2K
s2k Maybe ByteString
esk)
                    (ByteString -> ByteString
BL.toStrict ByteString
payload)
                )
            )
extractEncryptedPreludeTyped
    ( SKESKPkt SKESKPayload
skesk
            : SymEncIntegrityProtectedDataPkt
                (SEIPD2 SymmetricAlgorithm
payloadSA AEADAlgorithm
aead Word8
chunkSize Salt
salt ByteString
payload)
            : [Pkt]
_
        ) =
        SKESKPayload
-> SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> ByteString
-> Either MessageParseFailure SomeEncryptedPrelude
toSEIPDv2Prelude SKESKPayload
skesk SymmetricAlgorithm
payloadSA AEADAlgorithm
aead Word8
chunkSize Salt
salt ByteString
payload
extractEncryptedPreludeTyped [] = MessageParseFailure
-> Either MessageParseFailure SomeEncryptedPrelude
forall a b. a -> Either a b
Left MessageParseFailure
MissingEncryptedMessage
extractEncryptedPreludeTyped [Pkt]
_ = MessageParseFailure
-> Either MessageParseFailure SomeEncryptedPrelude
forall a b. a -> Either a b
Left MessageParseFailure
ExpectedSKESKThenEncryptedData

toSEIPDv2Prelude
    :: SKESKPayload
    -> SymmetricAlgorithm
    -> AEADAlgorithm
    -> Word8
    -> Salt
    -> BL.ByteString
    -> Either MessageParseFailure SomeEncryptedPrelude
toSEIPDv2Prelude :: SKESKPayload
-> SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> ByteString
-> Either MessageParseFailure SomeEncryptedPrelude
toSEIPDv2Prelude (SKESKPayloadV4Packet (SKESKPayloadV4 SymmetricAlgorithm
sa S2K
s2k Maybe ByteString
Nothing)) SymmetricAlgorithm
payloadSA AEADAlgorithm
aead Word8
chunkSize Salt
salt ByteString
payload
    | SymmetricAlgorithm
sa SymmetricAlgorithm -> SymmetricAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
/= SymmetricAlgorithm
payloadSA = MessageParseFailure
-> Either MessageParseFailure SomeEncryptedPrelude
forall a b. a -> Either a b
Left MessageParseFailure
SKESKSEIPDAlgorithmMismatch
    | Bool
otherwise =
        SomeEncryptedPrelude
-> Either MessageParseFailure SomeEncryptedPrelude
forall a b. b -> Either a b
Right
            ( EncryptedPrelude 'SEIPDv2EncryptedPreludeKind
-> SomeEncryptedPrelude
forall (v :: EncryptedPreludeKind).
EncryptedPrelude v -> SomeEncryptedPrelude
SomeEncryptedPrelude
                ( SymmetricAlgorithm
-> S2K
-> AEADAlgorithm
-> Word8
-> Salt
-> ByteString
-> EncryptedPrelude 'SEIPDv2EncryptedPreludeKind
SEIPDv2SKESK4Prelude
                    SymmetricAlgorithm
sa
                    S2K
s2k
                    AEADAlgorithm
aead
                    Word8
chunkSize
                    Salt
salt
                    (ByteString -> ByteString
BL.toStrict ByteString
payload)
                )
            )
toSEIPDv2Prelude (SKESKPayloadV6Packet (SKESKPayloadV6 SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k ByteString
iv ByteString
esk ByteString
tag)) SymmetricAlgorithm
payloadSA AEADAlgorithm
_aead Word8
chunkSize Salt
salt ByteString
payload
    | SymmetricAlgorithm
sa SymmetricAlgorithm -> SymmetricAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
/= SymmetricAlgorithm
payloadSA = MessageParseFailure
-> Either MessageParseFailure SomeEncryptedPrelude
forall a b. a -> Either a b
Left MessageParseFailure
SKESKSEIPDAlgorithmMismatch
    | Bool
otherwise =
        SomeEncryptedPrelude
-> Either MessageParseFailure SomeEncryptedPrelude
forall a b. b -> Either a b
Right
            ( EncryptedPrelude 'SEIPDv2EncryptedPreludeKind
-> SomeEncryptedPrelude
forall (v :: EncryptedPreludeKind).
EncryptedPrelude v -> SomeEncryptedPrelude
SomeEncryptedPrelude
                ( SymmetricAlgorithm
-> AEADAlgorithm
-> S2K
-> ByteString
-> ByteString
-> ByteString
-> Word8
-> Salt
-> ByteString
-> EncryptedPrelude 'SEIPDv2EncryptedPreludeKind
SEIPDv2SKESK6Prelude
                    SymmetricAlgorithm
sa
                    AEADAlgorithm
aa
                    S2K
s2k
                    ByteString
iv
                    ByteString
esk
                    ByteString
tag
                    Word8
chunkSize
                    Salt
salt
                    (ByteString -> ByteString
BL.toStrict ByteString
payload)
                )
            )
toSEIPDv2Prelude (SKESKPayloadV4Packet (SKESKPayloadV4 SymmetricAlgorithm
_ S2K
_ (Just ByteString
_))) SymmetricAlgorithm
_ AEADAlgorithm
_ Word8
_ Salt
_ ByteString
_ = MessageParseFailure
-> Either MessageParseFailure SomeEncryptedPrelude
forall a b. a -> Either a b
Left MessageParseFailure
UnsupportedEncryptedSKESK

parsedEncryptedPayloadFromPrelude
    :: SomeEncryptedPrelude -> SomeParsedEncryptedPayload
parsedEncryptedPayloadFromPrelude :: SomeEncryptedPrelude -> SomeParsedEncryptedPayload
parsedEncryptedPayloadFromPrelude (SomeEncryptedPrelude EncryptedPrelude k
prelude) =
    case EncryptedPrelude k
prelude of
        LegacySEDPrelude SKESK 'SKESKV4
skesk ByteString
payload ->
            ParsedEncryptedPayload 'LegacySEDPayloadKind
-> SomeParsedEncryptedPayload
forall (v :: ParsedEncryptedPayloadKind).
ParsedEncryptedPayload v -> SomeParsedEncryptedPayload
SomeParsedEncryptedPayload (SKESK 'SKESKV4
-> ByteString -> ParsedEncryptedPayload 'LegacySEDPayloadKind
LegacySEDPayload SKESK 'SKESKV4
skesk ByteString
payload)
        LegacySEIPDv1Prelude SKESK 'SKESKV4
skesk ByteString
payload ->
            ParsedEncryptedPayload 'LegacySEIPDv1PayloadKind
-> SomeParsedEncryptedPayload
forall (v :: ParsedEncryptedPayloadKind).
ParsedEncryptedPayload v -> SomeParsedEncryptedPayload
SomeParsedEncryptedPayload (SKESK 'SKESKV4
-> ByteString -> ParsedEncryptedPayload 'LegacySEIPDv1PayloadKind
LegacySEIPDv1Payload SKESK 'SKESKV4
skesk ByteString
payload)
        SEIPDv2SKESK4Prelude SymmetricAlgorithm
sa S2K
s2k AEADAlgorithm
aead Word8
chunkSize Salt
salt ByteString
payload ->
            ParsedEncryptedPayload 'SEIPDv2PayloadKind
-> SomeParsedEncryptedPayload
forall (v :: ParsedEncryptedPayloadKind).
ParsedEncryptedPayload v -> SomeParsedEncryptedPayload
SomeParsedEncryptedPayload
                ( SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> SEIPDv2SKESKInfo 'V4
-> ByteString
-> ParsedEncryptedPayload 'SEIPDv2PayloadKind
forall (v :: KeyVersion).
SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> SEIPDv2SKESKInfo v
-> ByteString
-> ParsedEncryptedPayload 'SEIPDv2PayloadKind
SEIPDv2Payload
                    SymmetricAlgorithm
sa
                    AEADAlgorithm
aead
                    Word8
chunkSize
                    Salt
salt
                    (SymmetricAlgorithm -> S2K -> SEIPDv2SKESKInfo 'V4
SEIPDv2SKESK4 SymmetricAlgorithm
sa S2K
s2k)
                    ByteString
payload
                )
        SEIPDv2SKESK6Prelude SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k ByteString
iv ByteString
esk ByteString
tag Word8
chunkSize Salt
salt ByteString
payload ->
            ParsedEncryptedPayload 'SEIPDv2PayloadKind
-> SomeParsedEncryptedPayload
forall (v :: ParsedEncryptedPayloadKind).
ParsedEncryptedPayload v -> SomeParsedEncryptedPayload
SomeParsedEncryptedPayload
                ( SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> SEIPDv2SKESKInfo 'V6
-> ByteString
-> ParsedEncryptedPayload 'SEIPDv2PayloadKind
forall (v :: KeyVersion).
SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> SEIPDv2SKESKInfo v
-> ByteString
-> ParsedEncryptedPayload 'SEIPDv2PayloadKind
SEIPDv2Payload
                    SymmetricAlgorithm
sa
                    AEADAlgorithm
aa
                    Word8
chunkSize
                    Salt
salt
                    (SymmetricAlgorithm
-> AEADAlgorithm
-> S2K
-> ByteString
-> ByteString
-> ByteString
-> SEIPDv2SKESKInfo 'V6
SEIPDv2SKESK6 SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k ByteString
iv ByteString
esk ByteString
tag)
                    ByteString
payload
                )

data SEIPDv2SKESKInfo (v :: KeyVersion) where
    SEIPDv2SKESK4
        :: SymmetricAlgorithm -> S2K -> SEIPDv2SKESKInfo 'V4
    SEIPDv2SKESK6
        :: SymmetricAlgorithm
        -> AEADAlgorithm
        -> S2K
        -> BL.ByteString
        -> BL.ByteString
        -> BL.ByteString
        -> SEIPDv2SKESKInfo 'V6

data ParsedEncryptedPayload (k :: ParsedEncryptedPayloadKind) where
    LegacySEDPayload
        :: SKESK 'SKESKV4
        -> B.ByteString
        -> ParsedEncryptedPayload 'LegacySEDPayloadKind
    LegacySEIPDv1Payload
        :: SKESK 'SKESKV4
        -> B.ByteString
        -> ParsedEncryptedPayload 'LegacySEIPDv1PayloadKind
    SEIPDv2Payload
        :: SymmetricAlgorithm
        -> AEADAlgorithm
        -> Word8
        -> Salt
        -> SEIPDv2SKESKInfo v
        -> B.ByteString
        -> ParsedEncryptedPayload 'SEIPDv2PayloadKind

data SomeParsedEncryptedPayload where
    SomeParsedEncryptedPayload
        :: ParsedEncryptedPayload k
        -> SomeParsedEncryptedPayload

decryptPayload
    :: Passphrase
    -> SomeParsedEncryptedPayload
    -> Either MessageDecryptFailure ClearPayload
decryptPayload :: Passphrase
-> SomeParsedEncryptedPayload
-> Either MessageDecryptFailure ClearPayload
decryptPayload Passphrase
passphrase (SomeParsedEncryptedPayload ParsedEncryptedPayload k
payload) =
    case ParsedEncryptedPayload k
payload of
        LegacySEDPayload SKESK 'SKESKV4
skesk ByteString
encryptedPayload ->
            Passphrase
-> SKESK 'SKESKV4
-> ByteString
-> Either MessageDecryptFailure ClearPayload
decryptLegacySEDPayloadTyped Passphrase
passphrase SKESK 'SKESKV4
skesk ByteString
encryptedPayload
        LegacySEIPDv1Payload SKESK 'SKESKV4
skesk ByteString
encryptedPayload ->
            Passphrase
-> SKESK 'SKESKV4
-> ByteString
-> Either MessageDecryptFailure ClearPayload
decryptLegacySEIPDv1PayloadTyped
                Passphrase
passphrase
                SKESK 'SKESKV4
skesk
                ByteString
encryptedPayload
        SEIPDv2Payload SymmetricAlgorithm
sa AEADAlgorithm
aead Word8
chunkSize Salt
salt SEIPDv2SKESKInfo v
skeskInfo ByteString
encryptedPayload ->
            Passphrase
-> SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> SEIPDv2SKESKInfo v
-> ByteString
-> Either MessageDecryptFailure ClearPayload
forall (v :: KeyVersion).
Passphrase
-> SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> SEIPDv2SKESKInfo v
-> ByteString
-> Either MessageDecryptFailure ClearPayload
decryptSEIPDv2PayloadTyped
                Passphrase
passphrase
                SymmetricAlgorithm
sa
                AEADAlgorithm
aead
                Word8
chunkSize
                Salt
salt
                SEIPDv2SKESKInfo v
skeskInfo
                ByteString
encryptedPayload

decryptLegacySEDPayloadTyped
    :: Passphrase
    -> SKESK 'SKESKV4
    -> B.ByteString
    -> Either MessageDecryptFailure ClearPayload
decryptLegacySEDPayloadTyped :: Passphrase
-> SKESK 'SKESKV4
-> ByteString
-> Either MessageDecryptFailure ClearPayload
decryptLegacySEDPayloadTyped Passphrase
passphrase SKESK 'SKESKV4
skesk ByteString
payload = do
    (sessionAlgorithm, sessionKeyBytes) <-
        Either S2KError (SymmetricAlgorithm, ByteString)
-> Either MessageDecryptFailure (SymmetricAlgorithm, ByteString)
forall a. Either S2KError a -> Either MessageDecryptFailure a
decryptSessionStep (Either S2KError (SymmetricAlgorithm, ByteString)
 -> Either MessageDecryptFailure (SymmetricAlgorithm, ByteString))
-> Either S2KError (SymmetricAlgorithm, ByteString)
-> Either MessageDecryptFailure (SymmetricAlgorithm, ByteString)
forall a b. (a -> b) -> a -> b
$
            SKESK 'SKESKV4
-> ByteString -> Either S2KError (SymmetricAlgorithm, ByteString)
skesk2SessionKey SKESK 'SKESKV4
skesk (Passphrase -> ByteString
unPassphrase Passphrase
passphrase)
    decryptCipherStep $
        ClearPayload . BL.fromStrict
            <$> decryptOpenPGPCfb
                sessionAlgorithm
                payload
                sessionKeyBytes

decryptLegacySEIPDv1PayloadTyped
    :: Passphrase
    -> SKESK 'SKESKV4
    -> B.ByteString
    -> Either MessageDecryptFailure ClearPayload
decryptLegacySEIPDv1PayloadTyped :: Passphrase
-> SKESK 'SKESKV4
-> ByteString
-> Either MessageDecryptFailure ClearPayload
decryptLegacySEIPDv1PayloadTyped Passphrase
passphrase SKESK 'SKESKV4
skesk ByteString
payload = do
    (sessionAlgorithm, sessionKeyBytes) <-
        Either S2KError (SymmetricAlgorithm, ByteString)
-> Either MessageDecryptFailure (SymmetricAlgorithm, ByteString)
forall a. Either S2KError a -> Either MessageDecryptFailure a
decryptSessionStep (Either S2KError (SymmetricAlgorithm, ByteString)
 -> Either MessageDecryptFailure (SymmetricAlgorithm, ByteString))
-> Either S2KError (SymmetricAlgorithm, ByteString)
-> Either MessageDecryptFailure (SymmetricAlgorithm, ByteString)
forall a b. (a -> b) -> a -> b
$
            SKESK 'SKESKV4
-> ByteString -> Either S2KError (SymmetricAlgorithm, ByteString)
skesk2SessionKey SKESK 'SKESKV4
skesk (Passphrase -> ByteString
unPassphrase Passphrase
passphrase)
    (nonce, decrypted) <-
        decryptCipherStep $
            decryptPreservingNonce sessionAlgorithm payload sessionKeyBytes
    cleartext <-
        decryptMDCStep $ validateSEIPD1MDC nonce decrypted
    Right (ClearPayload (BL.fromStrict cleartext))

decryptSEIPDv2PayloadTyped
    :: Passphrase
    -> SymmetricAlgorithm
    -> AEADAlgorithm
    -> Word8
    -> Salt
    -> SEIPDv2SKESKInfo v
    -> B.ByteString
    -> Either MessageDecryptFailure ClearPayload
decryptSEIPDv2PayloadTyped :: forall (v :: KeyVersion).
Passphrase
-> SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> SEIPDv2SKESKInfo v
-> ByteString
-> Either MessageDecryptFailure ClearPayload
decryptSEIPDv2PayloadTyped Passphrase
passphrase SymmetricAlgorithm
sa AEADAlgorithm
aead Word8
chunkSize Salt
salt SEIPDv2SKESKInfo v
skeskInfo ByteString
payload = do
    sessionKey <-
        ByteString -> SessionKey
SessionKey (ByteString -> SessionKey)
-> Either MessageDecryptFailure ByteString
-> Either MessageDecryptFailure SessionKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Passphrase
-> SEIPDv2SKESKInfo v -> Either MessageDecryptFailure ByteString
forall (v :: KeyVersion).
Passphrase
-> SEIPDv2SKESKInfo v -> Either MessageDecryptFailure ByteString
deriveSEIPDv2SessionKeyBytes Passphrase
passphrase SEIPDv2SKESKInfo v
skeskInfo
    decryptSEIPDv2Step $
        ClearPayload . BL.fromStrict
            <$> decryptSEIPDv2Payload sa aead chunkSize salt payload sessionKey

deriveSEIPDv2SessionKeyBytes
    :: Passphrase
    -> SEIPDv2SKESKInfo v
    -> Either MessageDecryptFailure B.ByteString
deriveSEIPDv2SessionKeyBytes :: forall (v :: KeyVersion).
Passphrase
-> SEIPDv2SKESKInfo v -> Either MessageDecryptFailure ByteString
deriveSEIPDv2SessionKeyBytes Passphrase
passphrase (SEIPDv2SKESK4 SymmetricAlgorithm
sa S2K
s2k) =
    Passphrase
-> SymmetricAlgorithm
-> S2K
-> Either MessageDecryptFailure ByteString
deriveSessionKeyBytes Passphrase
passphrase SymmetricAlgorithm
sa S2K
s2k
deriveSEIPDv2SessionKeyBytes Passphrase
passphrase (SEIPDv2SKESK6 SymmetricAlgorithm
sa AEADAlgorithm
aead S2K
s2k ByteString
iv ByteString
esk ByteString
tag) = do
    ikm <- Passphrase
-> SymmetricAlgorithm
-> S2K
-> Either MessageDecryptFailure ByteString
deriveSessionKeyBytes Passphrase
passphrase SymmetricAlgorithm
sa S2K
s2k
    kek <- decryptSEIPDv2Step $ deriveSKESK6KEK sa aead ikm
    decryptSEIPDv2Step $
        decryptSKESK6SessionKey
            sa
            aead
            kek
            (BL.toStrict iv)
            (BL.toStrict esk)
            (BL.toStrict tag)

deriveSessionKeyBytes
    :: Passphrase
    -> SymmetricAlgorithm
    -> S2K
    -> Either MessageDecryptFailure B.ByteString
deriveSessionKeyBytes :: Passphrase
-> SymmetricAlgorithm
-> S2K
-> Either MessageDecryptFailure ByteString
deriveSessionKeyBytes Passphrase
passphrase SymmetricAlgorithm
sa S2K
s2k = do
    keyLen <- Either CipherError Int -> Either MessageDecryptFailure Int
forall a. Either CipherError a -> Either MessageDecryptFailure a
decryptSessionKeySizeStep (Either CipherError Int -> Either MessageDecryptFailure Int)
-> Either CipherError Int -> Either MessageDecryptFailure Int
forall a b. (a -> b) -> a -> b
$ SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa
    decryptSessionStep $
        string2Key s2k keyLen (unPassphrase passphrase)

extractLiteralPayload
    :: [Pkt] -> Either MessageParseFailure ClearPayload
extractLiteralPayload :: [Pkt] -> Either MessageParseFailure ClearPayload
extractLiteralPayload [Pkt]
pkts =
    case [ByteString
p | LiteralDataPkt LiteralDataType
_ ByteString
_ ThirtyTwoBitTimeStamp
_ ByteString
p <- [Pkt]
pkts] of
        ByteString
payload : [ByteString]
_ -> ClearPayload -> Either MessageParseFailure ClearPayload
forall a b. b -> Either a b
Right (ByteString -> ClearPayload
ClearPayload ByteString
payload)
        [] -> MessageParseFailure -> Either MessageParseFailure ClearPayload
forall a b. a -> Either a b
Left MessageParseFailure
MissingLiteralDataPacket

rejectUnknownCriticalPacketsTyped
    :: [Pkt] -> Either MessageParseFailure [Pkt]
rejectUnknownCriticalPacketsTyped :: [Pkt] -> Either MessageParseFailure [Pkt]
rejectUnknownCriticalPacketsTyped =
    ([Pkt] -> [Pkt])
-> Either MessageParseFailure [Pkt]
-> Either MessageParseFailure [Pkt]
forall a b.
(a -> b)
-> Either MessageParseFailure a -> Either MessageParseFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Pkt] -> [Pkt]
forall a. [a] -> [a]
reverse (Either MessageParseFailure [Pkt]
 -> Either MessageParseFailure [Pkt])
-> ([Pkt] -> Either MessageParseFailure [Pkt])
-> [Pkt]
-> Either MessageParseFailure [Pkt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Pkt] -> Pkt -> Either MessageParseFailure [Pkt])
-> [Pkt] -> [Pkt] -> Either MessageParseFailure [Pkt]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [Pkt] -> Pkt -> Either MessageParseFailure [Pkt]
go []
  where
    go :: [Pkt] -> Pkt -> Either MessageParseFailure [Pkt]
go [Pkt]
acc Pkt
pkt =
        case Pkt
pkt of
            OtherPacketPkt Word8
t ByteString
_ | Word8
t Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
40 -> MessageParseFailure -> Either MessageParseFailure [Pkt]
forall a b. a -> Either a b
Left (Word8 -> MessageParseFailure
UnknownCriticalPacketType Word8
t)
            BrokenPacketPkt String
err Word8
t ByteString
_ | Word8
t Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
40 -> MessageParseFailure -> Either MessageParseFailure [Pkt]
forall a b. a -> Either a b
Left (Word8 -> String -> MessageParseFailure
BrokenCriticalPacketType Word8
t String
err)
            Pkt
_ -> [Pkt] -> Either MessageParseFailure [Pkt]
forall a b. b -> Either a b
Right (Pkt
pkt Pkt -> [Pkt] -> [Pkt]
forall a. a -> [a] -> [a]
: [Pkt]
acc)

validateModernMessageS2K
    :: OpenPGPPolicy -> S2K -> Either MessageEncryptFailure ()
validateModernMessageS2K :: OpenPGPPolicy -> S2K -> Either MessageEncryptFailure ()
validateModernMessageS2K OpenPGPPolicy
policy S2K
s2k =
    case S2K -> Maybe HashAlgorithm
s2kHashAlgorithm S2K
s2k of
        Just HashAlgorithm
ha
            | HashAlgorithm
ha
                HashAlgorithm -> [HashAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` GenerationDeprecationPolicy -> [HashAlgorithm]
deprecatedHashAlgorithms (OpenPGPPolicy -> GenerationDeprecationPolicy
policyGenerationDeprecations OpenPGPPolicy
policy) ->
                MessageEncryptFailure -> Either MessageEncryptFailure ()
forall a b. a -> Either a b
Left (HashAlgorithm -> MessageEncryptFailure
MessageEncryptDeprecatedS2KHash HashAlgorithm
ha)
        Maybe HashAlgorithm
_ -> () -> Either MessageEncryptFailure ()
forall a b. b -> Either a b
Right ()

validateRFC9580MessageSymmetric
    :: OpenPGPPolicy
    -> SymmetricAlgorithm
    -> Either MessageEncryptFailure ()
validateRFC9580MessageSymmetric :: OpenPGPPolicy
-> SymmetricAlgorithm -> Either MessageEncryptFailure ()
validateRFC9580MessageSymmetric OpenPGPPolicy
policy SymmetricAlgorithm
sa
    | OpenPGPPolicy -> SymmetricAlgorithm -> Bool
supportsSEIPDv2Symmetric OpenPGPPolicy
policy SymmetricAlgorithm
sa = () -> Either MessageEncryptFailure ()
forall a b. b -> Either a b
Right ()
    | Bool
otherwise =
        MessageEncryptFailure -> Either MessageEncryptFailure ()
forall a b. a -> Either a b
Left
            (SymmetricAlgorithm -> MessageEncryptFailure
MessageEncryptUnsupportedSymmetricAlgorithm SymmetricAlgorithm
sa)

s2kHashAlgorithm :: S2K -> Maybe HashAlgorithm
s2kHashAlgorithm :: S2K -> Maybe HashAlgorithm
s2kHashAlgorithm (Simple HashAlgorithm
ha) = HashAlgorithm -> Maybe HashAlgorithm
forall a. a -> Maybe a
Just HashAlgorithm
ha
s2kHashAlgorithm (Salted HashAlgorithm
ha Salt8
_) = HashAlgorithm -> Maybe HashAlgorithm
forall a. a -> Maybe a
Just HashAlgorithm
ha
s2kHashAlgorithm (IteratedSalted HashAlgorithm
ha Salt8
_ IterationCount
_) = HashAlgorithm -> Maybe HashAlgorithm
forall a. a -> Maybe a
Just HashAlgorithm
ha
s2kHashAlgorithm Argon2 {} = Maybe HashAlgorithm
forall a. Maybe a
Nothing
s2kHashAlgorithm (OtherS2K Word8
_ ByteString
_) = Maybe HashAlgorithm
forall a. Maybe a
Nothing