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.Signatures (VerificationError)
import Codec.Encryption.OpenPGP.Types
import Data.Conduit.OpenPGP.Verify
  ( VerificationMode(..)
  , VerificationModeW(..)
  , verifyPacketsWithModeTyped
  , verifyPacketsBatch
  )

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)