SignatureQualities.hs

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

module Codec.Encryption.OpenPGP.SignatureQualities
    ( sigType
    , sigPKA
    , sigHA
    , sigCT
    , signatureSubpacketListsKnown
    , signatureHashedSubpacketsKnown
    ) where

import Control.Applicative ((<|>))
import Control.Lens (preview, _1)
import Data.List (find)

import Codec.Encryption.OpenPGP.Ontology (isSigCreationTime)
import Codec.Encryption.OpenPGP.Types

sigType :: SignaturePayload -> Maybe SigType
sigType sig =
    preview (_SigV3 . _1) sig
        <|> preview (_SigV4 . _1) sig
        <|> preview (_SigV6 . _1) sig

sigPKA :: SignaturePayload -> Maybe PubKeyAlgorithm
sigPKA sig =
    case preview _SigV3 sig of
        Just (_st, _ts, _ekid, pka, _ha, _w16, _mpis) -> Just pka
        _ -> case preview _SigV4 sig of
            Just (_st, pka, _ha, _hsps, _usps, _w16, _mpis) -> Just pka
            _ -> case preview _SigV6 sig of
                Just (_st, pka, _ha, _salt, _hsps, _usps, _w16, _mpis) -> Just pka
                _ -> Nothing

sigHA :: SignaturePayload -> Maybe HashAlgorithm
sigHA sig =
    case preview _SigV3 sig of
        Just (_st, _ts, _ekid, _pka, ha, _w16, _mpis) -> Just ha
        _ -> case preview _SigV4 sig of
            Just (_st, _pka, ha, _hsps, _usps, _w16, _mpis) -> Just ha
            _ -> case preview _SigV6 sig of
                Just (_st, _pka, ha, _salt, _hsps, _usps, _w16, _mpis) -> Just ha
                _ -> Nothing

sigCT :: SignaturePayload -> Maybe ThirtyTwoBitTimeStamp
sigCT sig =
    case preview _SigV3 sig of
        Just (_st, ct, _ekid, _pka, _ha, _w16, _mpis) -> Just ct
        _ -> case preview _SigV4 sig of
            Just (_st, _pka, _ha, hsubs, _usps, _w16, _mpis) ->
                fmap
                    (\(SigSubPacket _ (SigCreationTime i)) -> i)
                    (find isSigCreationTime hsubs)
            _ -> case preview _SigV6 sig of
                Just (_st, _pka, _ha, _salt, hsubs, _usps, _w16, _mpis) ->
                    fmap
                        (\(SigSubPacket _ (SigCreationTime i)) -> i)
                        (find isSigCreationTime hsubs)
                _ -> Nothing

signatureSubpacketListsKnown
    :: SignaturePayload -> Maybe ([SigSubPacket], [SigSubPacket])
signatureSubpacketListsKnown sig =
    (preview _SigV4 sig >>= \(_, _, _, h, u, _, _) -> Just (h, u))
        <|> (preview _SigV6 sig >>= \(_, _, _, _, h, u, _, _) -> Just (h, u))

signatureHashedSubpacketsKnown
    :: SignaturePayload -> Maybe [SigSubPacket]
signatureHashedSubpacketsKnown sigPayload =
    fst <$> signatureSubpacketListsKnown sigPayload