Message.hs

-- Message.hs: conduit-backed OpenPGP message helpers
-- Copyright © 2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

module Data.Conduit.OpenPGP.Message
    ( VerificationPolicy (..)
    , VerificationOptions (..)
    , defaultVerificationOptions
    , verifyMessagePackets
    , verifyMessage
    , VerificationMode (..)
    ) where

import qualified Data.ByteString.Lazy as BL
import Data.Conduit (runConduitPure, (.|))
import qualified Data.Conduit.List as CL
import Data.Time.Clock (UTCTime)

import Codec.Encryption.OpenPGP.Compression (decompressPkt)
import Codec.Encryption.OpenPGP.Policy
    ( defaultVerificationDefaults
    , verificationDefaultStreaming
    , verificationDefaultStrict
    )
import Codec.Encryption.OpenPGP.Serialize (parsePkts)
import Codec.Encryption.OpenPGP.Types
import Data.Conduit.OpenPGP.Verify
    ( VerificationMode (..)
    , VerificationModeW (..)
    , verifyPacketsBatch
    , verifyPacketsWithModeTyped
    )

data VerificationPolicy
    = VerifyInformational
    | VerifyStrict
    deriving (Eq, Show)

data VerificationOptions = VerificationOptions
    { verificationPolicy :: VerificationPolicy
    , verificationMode :: VerificationMode
    , verificationTime :: Maybe UTCTime
    }
    deriving (Eq, Show)

defaultVerificationOptions :: VerificationOptions
defaultVerificationOptions =
    VerificationOptions
        { verificationPolicy =
            if verificationDefaultStrict defaultVerificationDefaults
                then VerifyStrict
                else VerifyInformational
        , verificationMode =
            if verificationDefaultStreaming defaultVerificationDefaults
                then VerificationStreaming
                else VerificationBatch
        , verificationTime = Nothing
        }

verifyMessagePackets
    :: VerificationOptions
    -> PublicKeyring
    -> [Pkt]
    -> [Either VerificationError Verification]
verifyMessagePackets options keyring packets =
    applyVerificationPolicy (verificationPolicy options) rawResults
  where
    rawResults =
        case verificationMode options of
            VerificationBatch ->
                verifyPacketsBatch keyring (verificationTime options) packets
            VerificationStreaming ->
                runConduitPure $
                    CL.sourceList packets
                        .| verifyPacketsWithModeTyped
                            VerificationStreamingW
                            keyring
                            (verificationTime options)
                        .| CL.consume

verifyMessage
    :: VerificationOptions
    -> PublicKeyring
    -> BL.ByteString
    -> [Either VerificationError Verification]
verifyMessage options keyring signedMessage =
    verifyMessagePackets
        options
        keyring
        ( concatMap
            (either (const []) id . decompressPkt)
            (parsePkts signedMessage)
        )

applyVerificationPolicy
    :: VerificationPolicy
    -> [Either VerificationError Verification]
    -> [Either VerificationError Verification]
applyVerificationPolicy VerifyInformational results = results
applyVerificationPolicy VerifyStrict results =
    either (pure . Left) (Right <$>) (sequence results)