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).

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}

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

import Data.List (find)

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

data KnownSignaturePayload where
  KnownSignaturePayloadV3 :: SignaturePayloadV 'SigPayloadV3 -> KnownSignaturePayload
  KnownSignaturePayloadV4 :: SignaturePayloadV 'SigPayloadV4 -> KnownSignaturePayload
  KnownSignaturePayloadV6 :: SignaturePayloadV 'SigPayloadV6 -> KnownSignaturePayload

knownSignaturePayload :: SignaturePayload -> Maybe KnownSignaturePayload
knownSignaturePayload sig =
  case toSomeSignaturePayload sig of
    SomeSignaturePayload (payload@SigPayloadV3Data {}) ->
      Just (KnownSignaturePayloadV3 payload)
    SomeSignaturePayload (payload@SigPayloadV4Data {}) ->
      Just (KnownSignaturePayloadV4 payload)
    SomeSignaturePayload (payload@SigPayloadV6Data {}) ->
      Just (KnownSignaturePayloadV6 payload)
    SomeSignaturePayload (SigPayloadOtherData _ _) -> Nothing

sigType :: SignaturePayload -> Maybe SigType
sigType sig =
  case knownSignaturePayload sig of
    Just (KnownSignaturePayloadV3 (SigPayloadV3Data st _ _ _ _ _ _)) -> Just st
    Just (KnownSignaturePayloadV4 (SigPayloadV4Data st _ _ _ _ _ _)) -> Just st
    Just (KnownSignaturePayloadV6 (SigPayloadV6Data st _ _ _ _ _ _ _)) -> Just st
    Nothing -> Nothing

sigPKA :: SignaturePayload -> Maybe PubKeyAlgorithm
sigPKA sig =
  case knownSignaturePayload sig of
    Just (KnownSignaturePayloadV3 (SigPayloadV3Data _ _ _ pka _ _ _)) -> Just pka
    Just (KnownSignaturePayloadV4 (SigPayloadV4Data _ pka _ _ _ _ _)) -> Just pka
    Just (KnownSignaturePayloadV6 (SigPayloadV6Data _ pka _ _ _ _ _ _)) -> Just pka
    Nothing -> Nothing

sigHA :: SignaturePayload -> Maybe HashAlgorithm
sigHA sig =
  case knownSignaturePayload sig of
    Just (KnownSignaturePayloadV3 (SigPayloadV3Data _ _ _ _ ha _ _)) -> Just ha
    Just (KnownSignaturePayloadV4 (SigPayloadV4Data _ _ ha _ _ _ _)) -> Just ha
    Just (KnownSignaturePayloadV6 (SigPayloadV6Data _ _ ha _ _ _ _ _)) -> Just ha
    Nothing -> Nothing

sigCT :: SignaturePayload -> Maybe ThirtyTwoBitTimeStamp
sigCT sig =
  case knownSignaturePayload sig of
    Just (KnownSignaturePayloadV3 (SigPayloadV3Data _ ct _ _ _ _ _)) -> Just ct
    Just (KnownSignaturePayloadV4 (SigPayloadV4Data _ _ _ hsubs _ _ _)) ->
      fmap
        (\(SigSubPacket _ (SigCreationTime i)) -> i)
        (find isSigCreationTime hsubs)
    Just (KnownSignaturePayloadV6 (SigPayloadV6Data _ _ _ _ hsubs _ _ _)) ->
      fmap
        (\(SigSubPacket _ (SigCreationTime i)) -> i)
        (find isSigCreationTime hsubs)
    Nothing -> Nothing

signatureSubpacketListsKnown ::
     SignaturePayload -> Maybe ([SigSubPacket], [SigSubPacket])
signatureSubpacketListsKnown sigPayload =
  case knownSignaturePayload sigPayload of
    Just (KnownSignaturePayloadV4 (SigPayloadV4Data _ _ _ hashed unhashed _ _)) ->
      Just (hashed, unhashed)
    Just (KnownSignaturePayloadV6 (SigPayloadV6Data _ _ _ _ hashed unhashed _ _)) ->
      Just (hashed, unhashed)
    _ -> Nothing

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