-- 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
  , mkPassphrase
  , passphraseBytes
  , EncryptedPayload
  , mkEncryptedPayload
  , encryptedPayloadBytes
  , ClearPayload
  , mkClearPayload
  , clearPayloadBytes
  , WrappedSessionMaterial
  , SigningAlgorithm(..)
  , SecretKeyFor
  , VersionedPKPayload
  , asV4PKPayload
  , asV6PKPayload
  , Signer
  , SigningCapability
  , mkRSASignerV4
  , mkRSASignerV6
  , mkEd25519SignerV4
  , mkEd25519SignerV6
  , mkEd448SignerV4
  , mkEd448SignerV6
  , MessageParseFailure(..)
  , MessageDecryptFailure(..)
  , MessageError(..)
  , SessionMaterialExposure(..)
  , EncryptMessageProfile
  , EncryptMessageOptions(..)
  , RecoveredSessionMaterial(..)
  , encryptMessage
  , decryptMessage
  , signMessage
  , signMessageWith
  , ConduitMessage.VerificationPolicy(..)
  , ConduitMessage.VerificationOptions(..)
  , ConduitMessage.defaultVerificationOptions
  , verifySignedMessage
  ) where

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

import Codec.Encryption.OpenPGP.BlockCipher (CipherError, renderCipherError, keySize, withSymmetricCipher)
import Codec.Encryption.OpenPGP.CFB
  ( OpenPGPCFBModeW(..)
  , decryptOpenPGPCfb
  , decryptPreservingNonce
  , encryptOpenPGPCfbRaw
  , mdcTrailerForSEIPDv1
  , seipdv1NonceFromIV
  , validateSEIPD1MDC
  )
import Codec.Encryption.OpenPGP.Encrypt (encryptSEIPDv2WithSKESKBlock)
import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)
import Codec.Encryption.OpenPGP.Internal.HOBlockCipher (HOBlockCipher(..))
import Codec.Encryption.OpenPGP.Internal.CryptoSEIPDv2
  ( decryptSKESK6SessionKey
  , deriveSKESK6KEK
  )
import Codec.Encryption.OpenPGP.Policy
  ( OpenPGPPolicy
  , defaultPolicy
  , deprecatedHashAlgorithms
  , messageDefaultAEADAlgorithm
  , messageDefaultChunkSize
  , messageSEIPDv2SaltOctets
  , policyGenerationDeprecations
  , policyMessageEncryption
  , supportsSEIPDv2Symmetric
  , OpenPGPRFCW(..)
  , HashAlgorithmW(..)
  )
import Codec.Encryption.OpenPGP.S2K (S2KError(..), renderS2KError, skesk2SessionKey, string2Key)
import Codec.Encryption.OpenPGP.Serialize (parsePkts)
import Codec.Encryption.OpenPGP.Signatures
  ( SignError(..)
  , VerificationError
  , signDataWithRSABuilder
  , signDataWithRSAV6Builder
  , signDataWithEd25519Builder
  , signDataWithEd25519V6Builder
  , signDataWithEd448Builder
  , signDataWithEd448V6Builder
  )
import Codec.Encryption.OpenPGP.Subpackets
  ( sigBuilderInitTyped
  , sigBuilderInitV6Typed
  , addHashedSubs
  , addUnhashedSubs
  , listToHashedSubs
  , listToUnhashedSubs
  )
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 Passphrase = Passphrase { Passphrase -> ByteString
unPassphrase :: BL.ByteString }
  deriving (Passphrase -> Passphrase -> Bool
(Passphrase -> Passphrase -> Bool)
-> (Passphrase -> Passphrase -> Bool) -> Eq Passphrase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Passphrase -> Passphrase -> Bool
== :: Passphrase -> Passphrase -> Bool
$c/= :: Passphrase -> Passphrase -> Bool
/= :: Passphrase -> Passphrase -> Bool
Eq, Eq Passphrase
Eq Passphrase =>
(Passphrase -> Passphrase -> Ordering)
-> (Passphrase -> Passphrase -> Bool)
-> (Passphrase -> Passphrase -> Bool)
-> (Passphrase -> Passphrase -> Bool)
-> (Passphrase -> Passphrase -> Bool)
-> (Passphrase -> Passphrase -> Passphrase)
-> (Passphrase -> Passphrase -> Passphrase)
-> Ord Passphrase
Passphrase -> Passphrase -> Bool
Passphrase -> Passphrase -> Ordering
Passphrase -> Passphrase -> Passphrase
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 :: Passphrase -> Passphrase -> Ordering
compare :: Passphrase -> Passphrase -> Ordering
$c< :: Passphrase -> Passphrase -> Bool
< :: Passphrase -> Passphrase -> Bool
$c<= :: Passphrase -> Passphrase -> Bool
<= :: Passphrase -> Passphrase -> Bool
$c> :: Passphrase -> Passphrase -> Bool
> :: Passphrase -> Passphrase -> Bool
$c>= :: Passphrase -> Passphrase -> Bool
>= :: Passphrase -> Passphrase -> Bool
$cmax :: Passphrase -> Passphrase -> Passphrase
max :: Passphrase -> Passphrase -> Passphrase
$cmin :: Passphrase -> Passphrase -> Passphrase
min :: Passphrase -> Passphrase -> Passphrase
Ord, Int -> Passphrase -> ShowS
[Passphrase] -> ShowS
Passphrase -> String
(Int -> Passphrase -> ShowS)
-> (Passphrase -> String)
-> ([Passphrase] -> ShowS)
-> Show Passphrase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Passphrase -> ShowS
showsPrec :: Int -> Passphrase -> ShowS
$cshow :: Passphrase -> String
show :: Passphrase -> String
$cshowList :: [Passphrase] -> ShowS
showList :: [Passphrase] -> ShowS
Show)

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 -> StrictByteString
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
  = MessageEncryptError String
  | 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)

newtype MessageFlow a =
  MessageFlow
    { forall a. MessageFlow a -> Either MessageError a
runMessageFlow :: Either MessageError a
    }

instance Functor MessageFlow where
  fmap :: forall a b. (a -> b) -> MessageFlow a -> MessageFlow b
fmap a -> b
f (MessageFlow Either MessageError a
result) = Either MessageError b -> MessageFlow b
forall a. Either MessageError a -> MessageFlow a
MessageFlow ((a -> b) -> Either MessageError a -> Either MessageError b
forall a b.
(a -> b) -> Either MessageError a -> Either MessageError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either MessageError a
result)

instance Applicative MessageFlow where
  pure :: forall a. a -> MessageFlow a
pure = Either MessageError a -> MessageFlow a
forall a. Either MessageError a -> MessageFlow a
MessageFlow (Either MessageError a -> MessageFlow a)
-> (a -> Either MessageError a) -> a -> MessageFlow a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either MessageError a
forall a b. b -> Either a b
Right
  MessageFlow Either MessageError (a -> b)
ff <*> :: forall a b. MessageFlow (a -> b) -> MessageFlow a -> MessageFlow b
<*> MessageFlow Either MessageError a
fa = Either MessageError b -> MessageFlow b
forall a. Either MessageError a -> MessageFlow a
MessageFlow (Either MessageError (a -> b)
ff Either MessageError (a -> b)
-> Either MessageError a -> Either MessageError b
forall a b.
Either MessageError (a -> b)
-> Either MessageError a -> Either MessageError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either MessageError a
fa)

instance Monad MessageFlow where
  MessageFlow Either MessageError a
result >>= :: forall a b. MessageFlow a -> (a -> MessageFlow b) -> MessageFlow b
>>= a -> MessageFlow b
f =
    case Either MessageError a
result of
      Left MessageError
err -> Either MessageError b -> MessageFlow b
forall a. Either MessageError a -> MessageFlow a
MessageFlow (MessageError -> Either MessageError b
forall a b. a -> Either a b
Left MessageError
err)
      Right a
x -> a -> MessageFlow b
f a
x

messageStep :: Either MessageError a -> MessageFlow a
messageStep :: forall a. Either MessageError a -> MessageFlow a
messageStep = Either MessageError a -> MessageFlow a
forall a. Either MessageError a -> MessageFlow a
MessageFlow

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

liftMessageFlowT :: Monad m => MessageFlow a -> MessageFlowT m a
liftMessageFlowT :: forall (m :: * -> *) a.
Monad m =>
MessageFlow a -> MessageFlowT m a
liftMessageFlowT (MessageFlow Either MessageError a
result) =
  case Either MessageError a
result of
    Left MessageError
err -> MessageError -> MessageFlowT m a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE MessageError
err
    Right a
x -> a -> MessageFlowT m a
forall a. a -> ExceptT MessageError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

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 MessageDecryptFailure
  = SessionMaterialDerivationFailed S2KError
  | PayloadDecryptFailed String
  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 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 String
err) = String
err

mkPassphrase :: BL.ByteString -> Passphrase
mkPassphrase :: ByteString -> Passphrase
mkPassphrase = ByteString -> Passphrase
Passphrase

passphraseBytes :: Passphrase -> BL.ByteString
passphraseBytes :: Passphrase -> ByteString
passphraseBytes = Passphrase -> ByteString
unPassphrase

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

firstLeft :: (e -> e') -> Either e a -> Either e' a
firstLeft :: forall e e' a. (e -> e') -> Either e a -> Either e' a
firstLeft e -> e'
f = (e -> Either e' a)
-> (a -> Either e' a) -> Either e a -> Either e' a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e' -> Either e' a
forall a b. a -> Either a b
Left (e' -> Either e' a) -> (e -> e') -> e -> Either e' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> e'
f) a -> Either e' a
forall a b. b -> Either a b
Right

-- | Lift a parse failure step into the unified MessageError channel
parseStep :: Either MessageParseFailure a -> MessageFlow a
parseStep :: forall a. Either MessageParseFailure a -> MessageFlow a
parseStep = Either MessageError a -> MessageFlow a
forall a. Either MessageError a -> MessageFlow a
messageStep (Either MessageError a -> MessageFlow a)
-> (Either MessageParseFailure a -> Either MessageError a)
-> Either MessageParseFailure a
-> MessageFlow a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MessageParseFailure -> MessageError)
-> Either MessageParseFailure a -> Either MessageError a
forall e e' a. (e -> e') -> Either e a -> Either e' a
firstLeft MessageParseFailure -> MessageError
MessageParseFailureError

-- | Lift a decrypt failure step into the unified MessageError channel
decryptStep :: Either MessageDecryptFailure a -> MessageFlow a
decryptStep :: forall a. Either MessageDecryptFailure a -> MessageFlow a
decryptStep = Either MessageError a -> MessageFlow a
forall a. Either MessageError a -> MessageFlow a
messageStep (Either MessageError a -> MessageFlow a)
-> (Either MessageDecryptFailure a -> Either MessageError a)
-> Either MessageDecryptFailure a
-> MessageFlow a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MessageDecryptFailure -> MessageError)
-> Either MessageDecryptFailure a -> Either MessageError a
forall e e' a. (e -> e') -> Either e a -> Either e' a
firstLeft MessageDecryptFailure -> MessageError
MessageDecryptFailureError

-- | Lift a string encrypt error step into the unified MessageError channel
encryptStep :: Either String a -> MessageFlow a
encryptStep :: forall a. Either String a -> MessageFlow a
encryptStep = Either MessageError a -> MessageFlow a
forall a. Either MessageError a -> MessageFlow a
messageStep (Either MessageError a -> MessageFlow a)
-> (Either String a -> Either MessageError a)
-> Either String a
-> MessageFlow a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> MessageError)
-> Either String a -> Either MessageError a
forall e e' a. (e -> e') -> Either e a -> Either e' a
firstLeft String -> MessageError
MessageEncryptError

-- | Lift a sign error step into the unified MessageError channel
signStep :: Either SignError a -> MessageFlow a
signStep :: forall a. Either SignError a -> MessageFlow a
signStep = Either MessageError a -> MessageFlow a
forall a. Either MessageError a -> MessageFlow a
messageStep (Either MessageError a -> MessageFlow a)
-> (Either SignError a -> Either MessageError a)
-> Either SignError a
-> MessageFlow a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignError -> MessageError)
-> Either SignError a -> Either MessageError a
forall e e' a. (e -> e') -> Either e a -> Either e' a
firstLeft SignError -> MessageError
MessageSignError

signStepT :: Monad m => Either SignError a -> MessageFlowT m a
signStepT :: forall (m :: * -> *) a.
Monad m =>
Either SignError a -> MessageFlowT m a
signStepT = MessageFlow a -> MessageFlowT m a
forall (m :: * -> *) a.
Monad m =>
MessageFlow a -> MessageFlowT m a
liftMessageFlowT (MessageFlow a -> MessageFlowT m a)
-> (Either SignError a -> MessageFlow a)
-> Either SignError a
-> MessageFlowT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SignError a -> MessageFlow a
forall a. Either SignError a -> MessageFlow a
signStep

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 e e' a. (e -> e') -> Either e a -> Either e' a
firstLeft 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 e e' a. (e -> e') -> Either e a -> Either e' a
firstLeft 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 e e' a. (e -> e') -> Either e a -> Either e' a
firstLeft (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 e e' a. (e -> e') -> Either e a -> Either e' a
firstLeft (String -> MessageDecryptFailure
PayloadDecryptFailed (String -> MessageDecryptFailure)
-> (CipherError -> String) -> CipherError -> MessageDecryptFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherError -> String
renderCipherError)

decryptPayloadStep :: Either String a -> Either MessageDecryptFailure a
decryptPayloadStep :: forall a. Either String a -> Either MessageDecryptFailure a
decryptPayloadStep = (String -> MessageDecryptFailure)
-> Either String a -> Either MessageDecryptFailure a
forall e e' a. (e -> e') -> Either e a -> Either e' a
firstLeft String -> MessageDecryptFailure
PayloadDecryptFailed

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 = MessageFlow (EncryptedPayload, Maybe RecoveredSessionMaterial)
-> Either
     MessageError (EncryptedPayload, Maybe RecoveredSessionMaterial)
forall a. MessageFlow a -> Either MessageError a
runMessageFlow (MessageFlow (EncryptedPayload, Maybe RecoveredSessionMaterial)
 -> Either
      MessageError (EncryptedPayload, Maybe RecoveredSessionMaterial))
-> MessageFlow (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
-> MessageFlow 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 String () -> MessageFlow ()
forall a. Either String a -> MessageFlow a
encryptStep (Either String () -> MessageFlow ())
-> Either String () -> MessageFlow ()
forall a b. (a -> b) -> a -> b
$ OpenPGPPolicy -> SymmetricAlgorithm -> Either String ()
validateRFC9580MessageSymmetric OpenPGPPolicy
defaultPolicy SymmetricAlgorithm
sa
      Either String () -> MessageFlow ()
forall a. Either String a -> MessageFlow a
encryptStep (Either String () -> MessageFlow ())
-> Either String () -> MessageFlow ()
forall a b. (a -> b) -> a -> b
$ OpenPGPPolicy -> S2K -> Either String ()
validateModernMessageS2K OpenPGPPolicy
defaultPolicy S2K
s2k
      encrypted <-
        Either String [Pkt] -> MessageFlow [Pkt]
forall a. Either String a -> MessageFlow a
encryptStep (Either String [Pkt] -> MessageFlow [Pkt])
-> Either String [Pkt] -> MessageFlow [Pkt]
forall a b. (a -> b) -> a -> b
$
        SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> S2K
-> ByteString
-> Block Pkt
-> Either String [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 [DataType
-> ByteString -> ThirtyTwoBitTimeStamp -> ByteString -> Pkt
LiteralDataPkt DataType
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 StrictByteString
ivBytes) =
  StrictByteString -> Salt
Salt (Int -> StrictByteString -> StrictByteString
B.take Int
outputLen ([StrictByteString] -> StrictByteString
B.concat (Int -> StrictByteString -> [StrictByteString]
forall a. Int -> a -> [a]
replicate Int
outputLen StrictByteString
seed)))
  where
    seed :: StrictByteString
seed
      | StrictByteString -> Bool
B.null StrictByteString
ivBytes = Word8 -> StrictByteString
B.singleton Word8
0
      | Bool
otherwise = StrictByteString
ivBytes

encryptMessageWithRFC4880Fallback ::
     SymmetricAlgorithm
  -> S2K
  -> IV
  -> Passphrase
  -> ClearPayload
  -> MessageFlow EncryptedPayload
encryptMessageWithRFC4880Fallback :: SymmetricAlgorithm
-> S2K
-> IV
-> Passphrase
-> ClearPayload
-> MessageFlow EncryptedPayload
encryptMessageWithRFC4880Fallback SymmetricAlgorithm
sa S2K
s2k IV
iv Passphrase
passphrase ClearPayload
payload = do
  keyLen          <- Either String Int -> MessageFlow Int
forall a. Either String a -> MessageFlow a
encryptStep (Either String Int -> MessageFlow Int)
-> (Either CipherError Int -> Either String Int)
-> Either CipherError Int
-> MessageFlow Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CipherError -> String)
-> Either CipherError Int -> Either String Int
forall e e' a. (e -> e') -> Either e a -> Either e' a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CipherError -> String
renderCipherError (Either CipherError Int -> MessageFlow Int)
-> Either CipherError Int -> MessageFlow Int
forall a b. (a -> b) -> a -> b
$ SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa
  sessionMaterial <- encryptStep . first renderS2KError $
                       WrappedSessionMaterial <$> string2Key s2k keyLen (unPassphrase passphrase)
  let literal          = DataType
-> ByteString -> ThirtyTwoBitTimeStamp -> ByteString -> Pkt
LiteralDataPkt DataType
BinaryData ByteString
BL.empty ThirtyTwoBitTimeStamp
0 (ClearPayload -> ByteString
unClearPayload ClearPayload
payload)
      cleartext        = ByteString -> StrictByteString
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 = StrictByteString
cleartext StrictByteString -> StrictByteString -> StrictByteString
forall a. Semigroup a => a -> a -> a
<> IV -> StrictByteString -> StrictByteString
mdcTrailerForSEIPDv1 IV
iv StrictByteString
cleartext
  encrypted <- encryptStep . first renderCipherError $
                 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 ::
     SymmetricAlgorithm -> S2K -> Passphrase -> MessageFlow B.ByteString
deriveSessionMaterial :: SymmetricAlgorithm
-> S2K -> Passphrase -> MessageFlow StrictByteString
deriveSessionMaterial SymmetricAlgorithm
sa S2K
s2k Passphrase
passphrase = do
  keyLen <- Either String Int -> MessageFlow Int
forall a. Either String a -> MessageFlow a
encryptStep (Either String Int -> MessageFlow Int)
-> (Either CipherError Int -> Either String Int)
-> Either CipherError Int
-> MessageFlow Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CipherError -> String)
-> Either CipherError Int -> Either String Int
forall e e' a. (e -> e') -> Either e a -> Either e' a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CipherError -> String
renderCipherError (Either CipherError Int -> MessageFlow Int)
-> Either CipherError Int -> MessageFlow Int
forall a b. (a -> b) -> a -> b
$ SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa
  encryptStep . first renderS2KError $ string2Key s2k keyLen (unPassphrase passphrase)

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

decryptMessage :: Passphrase -> EncryptedPayload -> Either MessageError ClearPayload
decryptMessage :: Passphrase -> EncryptedPayload -> Either MessageError ClearPayload
decryptMessage Passphrase
passphrase EncryptedPayload
encrypted = MessageFlow ClearPayload -> Either MessageError ClearPayload
forall a. MessageFlow a -> Either MessageError a
runMessageFlow (MessageFlow ClearPayload -> Either MessageError ClearPayload)
-> MessageFlow ClearPayload -> Either MessageError ClearPayload
forall a b. (a -> b) -> a -> b
$ do
  encryptedPackets <- Either MessageParseFailure [Pkt] -> MessageFlow [Pkt]
forall a. Either MessageParseFailure a -> MessageFlow a
parseStep (Either MessageParseFailure [Pkt] -> MessageFlow [Pkt])
-> Either MessageParseFailure [Pkt] -> MessageFlow [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 $ decryptPayloadTyped 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
$
  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 ->
               let builder :: SigBuilder Hashed V4Sig 'RSA
builder =
                     forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(KnownPubKeyAlgorithm algo, HashAlgoAllowedFor rfc h) =>
OpenPGPRFCW rfc
-> SigType -> HashAlgorithmW h -> SigBuilder Hashed V4Sig algo
sigBuilderInitTyped @'PKA.RSA OpenPGPRFCW 'RFC9580
RFC9580W SigType
BinarySig HashAlgorithmW 'SHA512
SHA512W
                   withHashed :: SigBuilder Unhashed V4Sig 'RSA
withHashed = HashedSubpackets V4Sig
-> SigBuilder Hashed V4Sig 'RSA -> SigBuilder Unhashed V4Sig 'RSA
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs ([SigSubPacket] -> HashedSubpackets V4Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
hashed) SigBuilder Hashed V4Sig 'RSA
builder
                   withUnhashed :: SigBuilder Unhashed V4Sig 'RSA
withUnhashed = UnhashedSubpackets V4Sig
-> SigBuilder Unhashed V4Sig 'RSA -> SigBuilder Unhashed V4Sig 'RSA
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs ([SigSubPacket] -> UnhashedSubpackets V4Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
unhashed) SigBuilder Unhashed V4Sig 'RSA
withHashed
                in SigBuilder Unhashed V4Sig 'RSA
-> PrivateKey -> ByteString -> Either SignError SignaturePayload
signDataWithRSABuilder SigBuilder Unhashed V4Sig 'RSA
withUnhashed 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 ->
               let builder :: SigBuilder Hashed V6Sig 'RSA
builder =
                     forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(KnownPubKeyAlgorithm algo, HashAlgoAllowedFor rfc h) =>
OpenPGPRFCW rfc
-> SigType
-> HashAlgorithmW h
-> SignatureSalt
-> SigBuilder Hashed V6Sig algo
sigBuilderInitV6Typed @'PKA.RSA OpenPGPRFCW 'RFC9580
RFC9580W SigType
BinarySig HashAlgorithmW 'SHA512
SHA512W SignatureSalt
salt
                   withHashed :: SigBuilder Unhashed V6Sig 'RSA
withHashed = HashedSubpackets V6Sig
-> SigBuilder Hashed V6Sig 'RSA -> SigBuilder Unhashed V6Sig 'RSA
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs ([SigSubPacket] -> HashedSubpackets V6Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
hashed) SigBuilder Hashed V6Sig 'RSA
builder
                   withUnhashed :: SigBuilder Unhashed V6Sig 'RSA
withUnhashed = UnhashedSubpackets V6Sig
-> SigBuilder Unhashed V6Sig 'RSA -> SigBuilder Unhashed V6Sig 'RSA
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs ([SigSubPacket] -> UnhashedSubpackets V6Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
unhashed) SigBuilder Unhashed V6Sig 'RSA
withHashed
                in SigBuilder Unhashed V6Sig 'RSA
-> PrivateKey -> ByteString -> Either SignError SignaturePayload
signDataWithRSAV6Builder SigBuilder Unhashed V6Sig 'RSA
withUnhashed 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 ->
               let builder :: SigBuilder Hashed V4Sig 'Ed25519
builder =
                     forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(KnownPubKeyAlgorithm algo, HashAlgoAllowedFor rfc h) =>
OpenPGPRFCW rfc
-> SigType -> HashAlgorithmW h -> SigBuilder Hashed V4Sig algo
sigBuilderInitTyped @'PKA.Ed25519 OpenPGPRFCW 'RFC9580
RFC9580W SigType
BinarySig HashAlgorithmW 'SHA512
SHA512W
                   withHashed :: SigBuilder Unhashed V4Sig 'Ed25519
withHashed = HashedSubpackets V4Sig
-> SigBuilder Hashed V4Sig 'Ed25519
-> SigBuilder Unhashed V4Sig 'Ed25519
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs ([SigSubPacket] -> HashedSubpackets V4Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
hashed) SigBuilder Hashed V4Sig 'Ed25519
builder
                   withUnhashed :: SigBuilder Unhashed V4Sig 'Ed25519
withUnhashed = UnhashedSubpackets V4Sig
-> SigBuilder Unhashed V4Sig 'Ed25519
-> SigBuilder Unhashed V4Sig 'Ed25519
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs ([SigSubPacket] -> UnhashedSubpackets V4Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
unhashed) SigBuilder Unhashed V4Sig 'Ed25519
withHashed
                in SigBuilder Unhashed V4Sig 'Ed25519
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd25519Builder SigBuilder Unhashed V4Sig 'Ed25519
withUnhashed 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 ->
               let builder :: SigBuilder Hashed V6Sig 'Ed25519
builder =
                     forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(KnownPubKeyAlgorithm algo, HashAlgoAllowedFor rfc h) =>
OpenPGPRFCW rfc
-> SigType
-> HashAlgorithmW h
-> SignatureSalt
-> SigBuilder Hashed V6Sig algo
sigBuilderInitV6Typed @'PKA.Ed25519 OpenPGPRFCW 'RFC9580
RFC9580W SigType
BinarySig HashAlgorithmW 'SHA512
SHA512W SignatureSalt
salt
                   withHashed :: SigBuilder Unhashed V6Sig 'Ed25519
withHashed = HashedSubpackets V6Sig
-> SigBuilder Hashed V6Sig 'Ed25519
-> SigBuilder Unhashed V6Sig 'Ed25519
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs ([SigSubPacket] -> HashedSubpackets V6Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
hashed) SigBuilder Hashed V6Sig 'Ed25519
builder
                   withUnhashed :: SigBuilder Unhashed V6Sig 'Ed25519
withUnhashed = UnhashedSubpackets V6Sig
-> SigBuilder Unhashed V6Sig 'Ed25519
-> SigBuilder Unhashed V6Sig 'Ed25519
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs ([SigSubPacket] -> UnhashedSubpackets V6Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
unhashed) SigBuilder Unhashed V6Sig 'Ed25519
withHashed
                in SigBuilder Unhashed V6Sig 'Ed25519
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd25519V6Builder SigBuilder Unhashed V6Sig 'Ed25519
withUnhashed 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 ->
               let builder :: SigBuilder Hashed V4Sig 'Ed448
builder =
                     forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(KnownPubKeyAlgorithm algo, HashAlgoAllowedFor rfc h) =>
OpenPGPRFCW rfc
-> SigType -> HashAlgorithmW h -> SigBuilder Hashed V4Sig algo
sigBuilderInitTyped @'PKA.Ed448 OpenPGPRFCW 'RFC9580
RFC9580W SigType
BinarySig HashAlgorithmW 'SHA512
SHA512W
                   withHashed :: SigBuilder Unhashed V4Sig 'Ed448
withHashed = HashedSubpackets V4Sig
-> SigBuilder Hashed V4Sig 'Ed448
-> SigBuilder Unhashed V4Sig 'Ed448
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs ([SigSubPacket] -> HashedSubpackets V4Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
hashed) SigBuilder Hashed V4Sig 'Ed448
builder
                   withUnhashed :: SigBuilder Unhashed V4Sig 'Ed448
withUnhashed = UnhashedSubpackets V4Sig
-> SigBuilder Unhashed V4Sig 'Ed448
-> SigBuilder Unhashed V4Sig 'Ed448
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs ([SigSubPacket] -> UnhashedSubpackets V4Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
unhashed) SigBuilder Unhashed V4Sig 'Ed448
withHashed
                in SigBuilder Unhashed V4Sig 'Ed448
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd448Builder SigBuilder Unhashed V4Sig 'Ed448
withUnhashed 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 ->
               let builder :: SigBuilder Hashed V6Sig 'Ed448
builder =
                     forall (algo :: PubKeyAlgorithm) (rfc :: OpenPGPRFC)
       (h :: HashAlgorithm).
(KnownPubKeyAlgorithm algo, HashAlgoAllowedFor rfc h) =>
OpenPGPRFCW rfc
-> SigType
-> HashAlgorithmW h
-> SignatureSalt
-> SigBuilder Hashed V6Sig algo
sigBuilderInitV6Typed @'PKA.Ed448 OpenPGPRFCW 'RFC9580
RFC9580W SigType
BinarySig HashAlgorithmW 'SHA512
SHA512W SignatureSalt
salt
                   withHashed :: SigBuilder Unhashed V6Sig 'Ed448
withHashed = HashedSubpackets V6Sig
-> SigBuilder Hashed V6Sig 'Ed448
-> SigBuilder Unhashed V6Sig 'Ed448
forall v (algo :: PubKeyAlgorithm).
HashedSubpackets v
-> SigBuilder Hashed v algo -> SigBuilder Unhashed v algo
addHashedSubs ([SigSubPacket] -> HashedSubpackets V6Sig
forall v. [SigSubPacket] -> HashedSubpackets v
listToHashedSubs [SigSubPacket]
hashed) SigBuilder Hashed V6Sig 'Ed448
builder
                   withUnhashed :: SigBuilder Unhashed V6Sig 'Ed448
withUnhashed = UnhashedSubpackets V6Sig
-> SigBuilder Unhashed V6Sig 'Ed448
-> SigBuilder Unhashed V6Sig 'Ed448
forall v (algo :: PubKeyAlgorithm).
UnhashedSubpackets v
-> SigBuilder Unhashed v algo -> SigBuilder Unhashed v algo
addUnhashedSubs ([SigSubPacket] -> UnhashedSubpackets V6Sig
forall v. [SigSubPacket] -> UnhashedSubpackets v
listToUnhashedSubs [SigSubPacket]
unhashed) SigBuilder Unhashed V6Sig 'Ed448
withHashed
                in SigBuilder Unhashed V6Sig 'Ed448
-> SecretKey -> ByteString -> Either SignError SignaturePayload
signDataWithEd448V6Builder SigBuilder Unhashed V6Sig 'Ed448
withUnhashed 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

versionedPKPayload :: VersionedPKPayload v -> PKPayload v
versionedPKPayload :: forall (v :: KeyVersion). VersionedPKPayload v -> PKPayload v
versionedPKPayload (VersionedPKPayloadV4 PKPayload 'V4
pk) = PKPayload v
PKPayload 'V4
pk
versionedPKPayload (VersionedPKPayloadV6 PKPayload 'V6
pk) = PKPayload v
PKPayload 'V6
pk

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)
-> (StrictByteString -> ByteString)
-> StrictByteString
-> SignatureSalt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> ByteString
BL.fromStrict (StrictByteString -> SignatureSalt)
-> m StrictByteString -> m SignatureSalt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m StrictByteString
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 = DataType
-> ByteString -> ThirtyTwoBitTimeStamp -> ByteString -> Pkt
LiteralDataPkt DataType
BinaryData ByteString
BL.empty ThirtyTwoBitTimeStamp
0 ByteString
clear
  signature <- [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either SignError SignaturePayload
signingFn [SigSubPacket]
hashed [SigSubPacket]
unhashed ByteString
clear
  return . runPut . put $ Block [literal, SignaturePkt signature]

encryptOpenPGPCfb ::
     SymmetricAlgorithm
  -> IV
  -> B.ByteString
  -> WrappedSessionMaterial
  -> Either CipherError B.ByteString
encryptOpenPGPCfb :: SymmetricAlgorithm
-> IV
-> StrictByteString
-> WrappedSessionMaterial
-> Either CipherError StrictByteString
encryptOpenPGPCfb SymmetricAlgorithm
sa IV
iv StrictByteString
cleartext (WrappedSessionMaterial StrictByteString
keydata) =
  OpenPGPCFBModeW 'OpenPGPCFBResync
-> SymmetricAlgorithm
-> IV
-> StrictByteString
-> StrictByteString
-> Either CipherError StrictByteString
forall (mode :: OpenPGPCFBMode).
OpenPGPCFBModeW mode
-> SymmetricAlgorithm
-> IV
-> StrictByteString
-> StrictByteString
-> Either CipherError StrictByteString
encryptOpenPGPCfbRaw OpenPGPCFBModeW 'OpenPGPCFBResync
OpenPGPCFBResyncW SymmetricAlgorithm
sa IV
iv StrictByteString
cleartext StrictByteString
keydata

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
-> StrictByteString -> EncryptedPrelude 'LegacyEncryptedPreludeKind
LegacySEDPrelude
          (SymmetricAlgorithm -> S2K -> Maybe ByteString -> SKESK 'SKESKV4
SKESK4Packet SymmetricAlgorithm
sa S2K
s2k Maybe ByteString
esk)
          (ByteString -> StrictByteString
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
-> StrictByteString -> EncryptedPrelude 'LegacyEncryptedPreludeKind
LegacySEIPDv1Prelude
          (SymmetricAlgorithm -> S2K -> Maybe ByteString -> SKESK 'SKESKV4
SKESK4Packet SymmetricAlgorithm
sa S2K
s2k Maybe ByteString
esk)
          (ByteString -> StrictByteString
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
-> StrictByteString
-> EncryptedPrelude 'SEIPDv2EncryptedPreludeKind
SEIPDv2SKESK4Prelude
              SymmetricAlgorithm
sa
              S2K
s2k
              AEADAlgorithm
aead
              Word8
chunkSize
              Salt
salt
              (ByteString -> StrictByteString
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
-> StrictByteString
-> EncryptedPrelude 'SEIPDv2EncryptedPreludeKind
SEIPDv2SKESK6Prelude
              SymmetricAlgorithm
sa
              AEADAlgorithm
aa
              S2K
s2k
              ByteString
iv
              ByteString
esk
              ByteString
tag
              Word8
chunkSize
              Salt
salt
              (ByteString -> StrictByteString
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
toSEIPDv2Prelude SKESKPayload
_ SymmetricAlgorithm
_ AEADAlgorithm
_ Word8
_ Salt
_ ByteString
_ = MessageParseFailure
-> Either MessageParseFailure SomeEncryptedPrelude
forall a b. a -> Either a b
Left MessageParseFailure
ExpectedSKESKThenEncryptedData

parsedEncryptedPayloadFromPrelude :: SomeEncryptedPrelude -> SomeParsedEncryptedPayload
parsedEncryptedPayloadFromPrelude :: SomeEncryptedPrelude -> SomeParsedEncryptedPayload
parsedEncryptedPayloadFromPrelude (SomeEncryptedPrelude EncryptedPrelude k
prelude) =
  case EncryptedPrelude k
prelude of
    LegacySEDPrelude SKESK 'SKESKV4
skesk StrictByteString
payload ->
      ParsedEncryptedPayload 'LegacySEDPayloadKind
-> SomeParsedEncryptedPayload
forall (v :: ParsedEncryptedPayloadKind).
ParsedEncryptedPayload v -> SomeParsedEncryptedPayload
SomeParsedEncryptedPayload (SKESK 'SKESKV4
-> StrictByteString -> ParsedEncryptedPayload 'LegacySEDPayloadKind
LegacySEDPayload SKESK 'SKESKV4
skesk StrictByteString
payload)
    LegacySEIPDv1Prelude SKESK 'SKESKV4
skesk StrictByteString
payload ->
      ParsedEncryptedPayload 'LegacySEIPDv1PayloadKind
-> SomeParsedEncryptedPayload
forall (v :: ParsedEncryptedPayloadKind).
ParsedEncryptedPayload v -> SomeParsedEncryptedPayload
SomeParsedEncryptedPayload (SKESK 'SKESKV4
-> StrictByteString
-> ParsedEncryptedPayload 'LegacySEIPDv1PayloadKind
LegacySEIPDv1Payload SKESK 'SKESKV4
skesk StrictByteString
payload)
    SEIPDv2SKESK4Prelude SymmetricAlgorithm
sa S2K
s2k AEADAlgorithm
aead Word8
chunkSize Salt
salt StrictByteString
payload ->
      ParsedEncryptedPayload 'SEIPDv2PayloadKind
-> SomeParsedEncryptedPayload
forall (v :: ParsedEncryptedPayloadKind).
ParsedEncryptedPayload v -> SomeParsedEncryptedPayload
SomeParsedEncryptedPayload
        (SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> SEIPDv2SKESKInfo 'V4
-> StrictByteString
-> ParsedEncryptedPayload 'SEIPDv2PayloadKind
forall (v :: KeyVersion).
SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> SEIPDv2SKESKInfo v
-> StrictByteString
-> ParsedEncryptedPayload 'SEIPDv2PayloadKind
SEIPDv2Payload
           SymmetricAlgorithm
sa
           AEADAlgorithm
aead
           Word8
chunkSize
           Salt
salt
           (SymmetricAlgorithm -> S2K -> SEIPDv2SKESKInfo 'V4
SEIPDv2SKESK4 SymmetricAlgorithm
sa S2K
s2k)
           StrictByteString
payload)
    SEIPDv2SKESK6Prelude SymmetricAlgorithm
sa AEADAlgorithm
aa S2K
s2k ByteString
iv ByteString
esk ByteString
tag Word8
chunkSize Salt
salt StrictByteString
payload ->
      ParsedEncryptedPayload 'SEIPDv2PayloadKind
-> SomeParsedEncryptedPayload
forall (v :: ParsedEncryptedPayloadKind).
ParsedEncryptedPayload v -> SomeParsedEncryptedPayload
SomeParsedEncryptedPayload
        (SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> SEIPDv2SKESKInfo 'V6
-> StrictByteString
-> ParsedEncryptedPayload 'SEIPDv2PayloadKind
forall (v :: KeyVersion).
SymmetricAlgorithm
-> AEADAlgorithm
-> Word8
-> Salt
-> SEIPDv2SKESKInfo v
-> StrictByteString
-> 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)
           StrictByteString
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 String ClearPayload
decryptPayload :: Passphrase
-> SomeParsedEncryptedPayload -> Either String ClearPayload
decryptPayload Passphrase
passphrase =
  (MessageDecryptFailure -> String)
-> Either MessageDecryptFailure ClearPayload
-> Either String ClearPayload
forall e e' a. (e -> e') -> Either e a -> Either e' a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first MessageDecryptFailure -> String
renderMessageDecryptFailure (Either MessageDecryptFailure ClearPayload
 -> Either String ClearPayload)
-> (SomeParsedEncryptedPayload
    -> Either MessageDecryptFailure ClearPayload)
-> SomeParsedEncryptedPayload
-> Either String ClearPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Passphrase
-> SomeParsedEncryptedPayload
-> Either MessageDecryptFailure ClearPayload
decryptPayloadTyped Passphrase
passphrase

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

decryptLegacySEDPayloadTyped ::
     Passphrase
  -> SKESK 'SKESKV4
  -> B.ByteString
  -> Either MessageDecryptFailure ClearPayload
decryptLegacySEDPayloadTyped :: Passphrase
-> SKESK 'SKESKV4
-> StrictByteString
-> Either MessageDecryptFailure ClearPayload
decryptLegacySEDPayloadTyped Passphrase
passphrase SKESK 'SKESKV4
skesk StrictByteString
payload = do
  (sessionAlgorithm, sessionKeyBytes) <-
    Either S2KError (SymmetricAlgorithm, StrictByteString)
-> Either
     MessageDecryptFailure (SymmetricAlgorithm, StrictByteString)
forall a. Either S2KError a -> Either MessageDecryptFailure a
decryptSessionStep (Either S2KError (SymmetricAlgorithm, StrictByteString)
 -> Either
      MessageDecryptFailure (SymmetricAlgorithm, StrictByteString))
-> Either S2KError (SymmetricAlgorithm, StrictByteString)
-> Either
     MessageDecryptFailure (SymmetricAlgorithm, StrictByteString)
forall a b. (a -> b) -> a -> b
$
    SKESK 'SKESKV4
-> ByteString
-> Either S2KError (SymmetricAlgorithm, StrictByteString)
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
-> StrictByteString
-> Either MessageDecryptFailure ClearPayload
decryptLegacySEIPDv1PayloadTyped Passphrase
passphrase SKESK 'SKESKV4
skesk StrictByteString
payload = do
  (sessionAlgorithm, sessionKeyBytes) <-
    Either S2KError (SymmetricAlgorithm, StrictByteString)
-> Either
     MessageDecryptFailure (SymmetricAlgorithm, StrictByteString)
forall a. Either S2KError a -> Either MessageDecryptFailure a
decryptSessionStep (Either S2KError (SymmetricAlgorithm, StrictByteString)
 -> Either
      MessageDecryptFailure (SymmetricAlgorithm, StrictByteString))
-> Either S2KError (SymmetricAlgorithm, StrictByteString)
-> Either
     MessageDecryptFailure (SymmetricAlgorithm, StrictByteString)
forall a b. (a -> b) -> a -> b
$
    SKESK 'SKESKV4
-> ByteString
-> Either S2KError (SymmetricAlgorithm, StrictByteString)
skesk2SessionKey SKESK 'SKESKV4
skesk (Passphrase -> ByteString
unPassphrase Passphrase
passphrase)
  (nonce, decrypted) <-
    decryptCipherStep $
    decryptPreservingNonce sessionAlgorithm payload sessionKeyBytes
  cleartext <- decryptPayloadStep $ 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
-> StrictByteString
-> Either MessageDecryptFailure ClearPayload
decryptSEIPDv2PayloadTyped Passphrase
passphrase SymmetricAlgorithm
sa AEADAlgorithm
aead Word8
chunkSize Salt
salt SEIPDv2SKESKInfo v
skeskInfo StrictByteString
payload = do
  sessionKey <- StrictByteString -> SessionKey
SessionKey (StrictByteString -> SessionKey)
-> Either MessageDecryptFailure StrictByteString
-> Either MessageDecryptFailure SessionKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Passphrase
-> SEIPDv2SKESKInfo v
-> Either MessageDecryptFailure StrictByteString
forall (v :: KeyVersion).
Passphrase
-> SEIPDv2SKESKInfo v
-> Either MessageDecryptFailure StrictByteString
deriveSEIPDv2SessionKeyBytes Passphrase
passphrase SEIPDv2SKESKInfo v
skeskInfo
  decryptPayloadStep $
    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 StrictByteString
deriveSEIPDv2SessionKeyBytes Passphrase
passphrase (SEIPDv2SKESK4 SymmetricAlgorithm
sa S2K
s2k) =
  Passphrase
-> SymmetricAlgorithm
-> S2K
-> Either MessageDecryptFailure StrictByteString
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 StrictByteString
deriveSessionKeyBytes Passphrase
passphrase SymmetricAlgorithm
sa S2K
s2k
  kek <- decryptPayloadStep $ deriveSKESK6KEK sa aead ikm
  decryptPayloadStep $
    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 StrictByteString
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 DataType
_ 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]
go []
  where
    go :: [Pkt] -> [Pkt] -> Either MessageParseFailure [Pkt]
go [Pkt]
acc [] = [Pkt] -> Either MessageParseFailure [Pkt]
forall a b. b -> Either a b
Right ([Pkt] -> [Pkt]
forall a. [a] -> [a]
reverse [Pkt]
acc)
    go [Pkt]
acc (Pkt
pkt:[Pkt]
rest) =
      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] -> [Pkt] -> Either MessageParseFailure [Pkt]
go (Pkt
pkt Pkt -> [Pkt] -> [Pkt]
forall a. a -> [a] -> [a]
: [Pkt]
acc) [Pkt]
rest

validateModernMessageS2K :: OpenPGPPolicy -> S2K -> Either String ()
validateModernMessageS2K :: OpenPGPPolicy -> S2K -> Either String ()
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) ->
          String -> Either String ()
forall a b. a -> Either a b
Left
            (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)
    Maybe HashAlgorithm
_ -> () -> Either String ()
forall a b. b -> Either a b
Right ()

validateRFC9580MessageSymmetric ::
     OpenPGPPolicy -> SymmetricAlgorithm -> Either String ()
validateRFC9580MessageSymmetric :: OpenPGPPolicy -> SymmetricAlgorithm -> Either String ()
validateRFC9580MessageSymmetric OpenPGPPolicy
policy SymmetricAlgorithm
sa
  | OpenPGPPolicy -> SymmetricAlgorithm -> Bool
supportsSEIPDv2Symmetric OpenPGPPolicy
policy SymmetricAlgorithm
sa = () -> Either String ()
forall a b. b -> Either a b
Right ()
  | Bool
otherwise =
      String -> Either String ()
forall a b. a -> Either a b
Left
        (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)

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