-- 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 :: SignaturePayload -> Maybe KnownSignaturePayload
knownSignaturePayload SignaturePayload
sig =
  case SignaturePayload -> SomeSignaturePayload
toSomeSignaturePayload SignaturePayload
sig of
    SomeSignaturePayload (payload :: SignaturePayloadV v
payload@SigPayloadV3Data {}) ->
      KnownSignaturePayload -> Maybe KnownSignaturePayload
forall a. a -> Maybe a
Just (SignaturePayloadV 'SigPayloadV3 -> KnownSignaturePayload
KnownSignaturePayloadV3 SignaturePayloadV v
SignaturePayloadV 'SigPayloadV3
payload)
    SomeSignaturePayload (payload :: SignaturePayloadV v
payload@SigPayloadV4Data {}) ->
      KnownSignaturePayload -> Maybe KnownSignaturePayload
forall a. a -> Maybe a
Just (SignaturePayloadV 'SigPayloadV4 -> KnownSignaturePayload
KnownSignaturePayloadV4 SignaturePayloadV v
SignaturePayloadV 'SigPayloadV4
payload)
    SomeSignaturePayload (payload :: SignaturePayloadV v
payload@SigPayloadV6Data {}) ->
      KnownSignaturePayload -> Maybe KnownSignaturePayload
forall a. a -> Maybe a
Just (SignaturePayloadV 'SigPayloadV6 -> KnownSignaturePayload
KnownSignaturePayloadV6 SignaturePayloadV v
SignaturePayloadV 'SigPayloadV6
payload)
    SomeSignaturePayload (SigPayloadOtherData Word8
_ ByteString
_) -> Maybe KnownSignaturePayload
forall a. Maybe a
Nothing

sigType :: SignaturePayload -> Maybe SigType
sigType :: SignaturePayload -> Maybe SigType
sigType SignaturePayload
sig =
  case SignaturePayload -> Maybe KnownSignaturePayload
knownSignaturePayload SignaturePayload
sig of
    Just (KnownSignaturePayloadV3 (SigPayloadV3Data SigType
st ThirtyTwoBitTimeStamp
_ EightOctetKeyId
_ PubKeyAlgorithm
_ HashAlgorithm
_ Word16
_ NonEmpty MPI
_)) -> SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
st
    Just (KnownSignaturePayloadV4 (SigPayloadV4Data SigType
st PubKeyAlgorithm
_ HashAlgorithm
_ [SigSubPacket]
_ [SigSubPacket]
_ Word16
_ NonEmpty MPI
_)) -> SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
st
    Just (KnownSignaturePayloadV6 (SigPayloadV6Data SigType
st PubKeyAlgorithm
_ HashAlgorithm
_ SignatureSalt
_ [SigSubPacket]
_ [SigSubPacket]
_ Word16
_ NonEmpty MPI
_)) -> SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
st
    Maybe KnownSignaturePayload
Nothing -> Maybe SigType
forall a. Maybe a
Nothing

sigPKA :: SignaturePayload -> Maybe PubKeyAlgorithm
sigPKA :: SignaturePayload -> Maybe PubKeyAlgorithm
sigPKA SignaturePayload
sig =
  case SignaturePayload -> Maybe KnownSignaturePayload
knownSignaturePayload SignaturePayload
sig of
    Just (KnownSignaturePayloadV3 (SigPayloadV3Data SigType
_ ThirtyTwoBitTimeStamp
_ EightOctetKeyId
_ PubKeyAlgorithm
pka HashAlgorithm
_ Word16
_ NonEmpty MPI
_)) -> PubKeyAlgorithm -> Maybe PubKeyAlgorithm
forall a. a -> Maybe a
Just PubKeyAlgorithm
pka
    Just (KnownSignaturePayloadV4 (SigPayloadV4Data SigType
_ PubKeyAlgorithm
pka HashAlgorithm
_ [SigSubPacket]
_ [SigSubPacket]
_ Word16
_ NonEmpty MPI
_)) -> PubKeyAlgorithm -> Maybe PubKeyAlgorithm
forall a. a -> Maybe a
Just PubKeyAlgorithm
pka
    Just (KnownSignaturePayloadV6 (SigPayloadV6Data SigType
_ PubKeyAlgorithm
pka HashAlgorithm
_ SignatureSalt
_ [SigSubPacket]
_ [SigSubPacket]
_ Word16
_ NonEmpty MPI
_)) -> PubKeyAlgorithm -> Maybe PubKeyAlgorithm
forall a. a -> Maybe a
Just PubKeyAlgorithm
pka
    Maybe KnownSignaturePayload
Nothing -> Maybe PubKeyAlgorithm
forall a. Maybe a
Nothing

sigHA :: SignaturePayload -> Maybe HashAlgorithm
sigHA :: SignaturePayload -> Maybe HashAlgorithm
sigHA SignaturePayload
sig =
  case SignaturePayload -> Maybe KnownSignaturePayload
knownSignaturePayload SignaturePayload
sig of
    Just (KnownSignaturePayloadV3 (SigPayloadV3Data SigType
_ ThirtyTwoBitTimeStamp
_ EightOctetKeyId
_ PubKeyAlgorithm
_ HashAlgorithm
ha Word16
_ NonEmpty MPI
_)) -> HashAlgorithm -> Maybe HashAlgorithm
forall a. a -> Maybe a
Just HashAlgorithm
ha
    Just (KnownSignaturePayloadV4 (SigPayloadV4Data SigType
_ PubKeyAlgorithm
_ HashAlgorithm
ha [SigSubPacket]
_ [SigSubPacket]
_ Word16
_ NonEmpty MPI
_)) -> HashAlgorithm -> Maybe HashAlgorithm
forall a. a -> Maybe a
Just HashAlgorithm
ha
    Just (KnownSignaturePayloadV6 (SigPayloadV6Data SigType
_ PubKeyAlgorithm
_ HashAlgorithm
ha SignatureSalt
_ [SigSubPacket]
_ [SigSubPacket]
_ Word16
_ NonEmpty MPI
_)) -> HashAlgorithm -> Maybe HashAlgorithm
forall a. a -> Maybe a
Just HashAlgorithm
ha
    Maybe KnownSignaturePayload
Nothing -> Maybe HashAlgorithm
forall a. Maybe a
Nothing

sigCT :: SignaturePayload -> Maybe ThirtyTwoBitTimeStamp
sigCT :: SignaturePayload -> Maybe ThirtyTwoBitTimeStamp
sigCT SignaturePayload
sig =
  case SignaturePayload -> Maybe KnownSignaturePayload
knownSignaturePayload SignaturePayload
sig of
    Just (KnownSignaturePayloadV3 (SigPayloadV3Data SigType
_ ThirtyTwoBitTimeStamp
ct EightOctetKeyId
_ PubKeyAlgorithm
_ HashAlgorithm
_ Word16
_ NonEmpty MPI
_)) -> ThirtyTwoBitTimeStamp -> Maybe ThirtyTwoBitTimeStamp
forall a. a -> Maybe a
Just ThirtyTwoBitTimeStamp
ct
    Just (KnownSignaturePayloadV4 (SigPayloadV4Data SigType
_ PubKeyAlgorithm
_ HashAlgorithm
_ [SigSubPacket]
hsubs [SigSubPacket]
_ Word16
_ NonEmpty MPI
_)) ->
      (SigSubPacket -> ThirtyTwoBitTimeStamp)
-> Maybe SigSubPacket -> Maybe ThirtyTwoBitTimeStamp
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\(SigSubPacket Bool
_ (SigCreationTime ThirtyTwoBitTimeStamp
i)) -> ThirtyTwoBitTimeStamp
i)
        ((SigSubPacket -> Bool) -> [SigSubPacket] -> Maybe SigSubPacket
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find SigSubPacket -> Bool
isSigCreationTime [SigSubPacket]
hsubs)
    Just (KnownSignaturePayloadV6 (SigPayloadV6Data SigType
_ PubKeyAlgorithm
_ HashAlgorithm
_ SignatureSalt
_ [SigSubPacket]
hsubs [SigSubPacket]
_ Word16
_ NonEmpty MPI
_)) ->
      (SigSubPacket -> ThirtyTwoBitTimeStamp)
-> Maybe SigSubPacket -> Maybe ThirtyTwoBitTimeStamp
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\(SigSubPacket Bool
_ (SigCreationTime ThirtyTwoBitTimeStamp
i)) -> ThirtyTwoBitTimeStamp
i)
        ((SigSubPacket -> Bool) -> [SigSubPacket] -> Maybe SigSubPacket
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find SigSubPacket -> Bool
isSigCreationTime [SigSubPacket]
hsubs)
    Maybe KnownSignaturePayload
Nothing -> Maybe ThirtyTwoBitTimeStamp
forall a. Maybe a
Nothing

signatureSubpacketListsKnown ::
     SignaturePayload -> Maybe ([SigSubPacket], [SigSubPacket])
signatureSubpacketListsKnown :: SignaturePayload -> Maybe ([SigSubPacket], [SigSubPacket])
signatureSubpacketListsKnown SignaturePayload
sigPayload =
  case SignaturePayload -> Maybe KnownSignaturePayload
knownSignaturePayload SignaturePayload
sigPayload of
    Just (KnownSignaturePayloadV4 (SigPayloadV4Data SigType
_ PubKeyAlgorithm
_ HashAlgorithm
_ [SigSubPacket]
hashed [SigSubPacket]
unhashed Word16
_ NonEmpty MPI
_)) ->
      ([SigSubPacket], [SigSubPacket])
-> Maybe ([SigSubPacket], [SigSubPacket])
forall a. a -> Maybe a
Just ([SigSubPacket]
hashed, [SigSubPacket]
unhashed)
    Just (KnownSignaturePayloadV6 (SigPayloadV6Data SigType
_ PubKeyAlgorithm
_ HashAlgorithm
_ SignatureSalt
_ [SigSubPacket]
hashed [SigSubPacket]
unhashed Word16
_ NonEmpty MPI
_)) ->
      ([SigSubPacket], [SigSubPacket])
-> Maybe ([SigSubPacket], [SigSubPacket])
forall a. a -> Maybe a
Just ([SigSubPacket]
hashed, [SigSubPacket]
unhashed)
    Maybe KnownSignaturePayload
_ -> Maybe ([SigSubPacket], [SigSubPacket])
forall a. Maybe a
Nothing

signatureHashedSubpacketsKnown :: SignaturePayload -> Maybe [SigSubPacket]
signatureHashedSubpacketsKnown :: SignaturePayload -> Maybe [SigSubPacket]
signatureHashedSubpacketsKnown SignaturePayload
sigPayload =
  ([SigSubPacket], [SigSubPacket]) -> [SigSubPacket]
forall a b. (a, b) -> a
fst (([SigSubPacket], [SigSubPacket]) -> [SigSubPacket])
-> Maybe ([SigSubPacket], [SigSubPacket]) -> Maybe [SigSubPacket]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SignaturePayload -> Maybe ([SigSubPacket], [SigSubPacket])
signatureSubpacketListsKnown SignaturePayload
sigPayload