-- Pkt.hs: OpenPGP (RFC9580) Pkt data types
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}

module Codec.Encryption.OpenPGP.Types.Internal.Pkt where

import Control.Lens (makeLenses)
import Data.Aeson (object, (.=))
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as AK
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Data
    ( Constr
    , Data (..)
    , Fixity (Prefix)
    , mkConstr
    , mkDataType
    )
import qualified Data.Data as DD
import Data.Hashable (Hashable (..))
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import Data.Ord (comparing)
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Typeable (Typeable)
import Data.Word (Word8)
import GHC.Generics (Generic)
import Prettyprinter (Pretty (..), (<+>))

import Codec.Encryption.OpenPGP.Types.Internal.Base
import Codec.Encryption.OpenPGP.Types.Internal.PKITypes
import Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils
    ( prettyLBS
    )

data PKESKPayloadVersion = PKESKV3 | PKESKV6
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data PKESKPayloadV3
    = PKESKPayloadV3
        PacketVersion
        EightOctetKeyId
        PubKeyAlgorithm
        (NonEmpty MPI)
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data PKESKPayloadV6
    = PKESKPayloadV6
        BL.ByteString
        PubKeyAlgorithm
        BL.ByteString
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data PKESKPayload
    = PKESKPayloadV3Packet PKESKPayloadV3
    | PKESKPayloadV6Packet PKESKPayloadV6
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data SKESKPayloadVersion = SKESKV4 | SKESKV6
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data SKESKPayloadV4
    = SKESKPayloadV4
        SymmetricAlgorithm
        S2K
        (Maybe BL.ByteString)
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data SKESKPayloadV6
    = SKESKPayloadV6
        SymmetricAlgorithm
        AEADAlgorithm
        S2K
        BL.ByteString
        BL.ByteString
        BL.ByteString
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data SKESKPayload
    = SKESKPayloadV4Packet SKESKPayloadV4
    | SKESKPayloadV6Packet SKESKPayloadV6
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data OnePassSignatureVersion = OPSV3 | OPSV6
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data OPSPayloadV3
    = OPSPayloadV3
        PacketVersion
        SigType
        HashAlgorithm
        PubKeyAlgorithm
        EightOctetKeyId
        NestedFlag
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data OPSPayloadV6
    = OPSPayloadV6
        SigType
        HashAlgorithm
        PubKeyAlgorithm
        SignatureSalt
        BL.ByteString
        NestedFlag
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data OnePassSignaturePayload
    = OPSPayloadV3Packet OPSPayloadV3
    | OPSPayloadV6Packet OPSPayloadV6
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data SEIPDPayload
    = SEIPD1 PacketVersion BL.ByteString
    | SEIPD2 SymmetricAlgorithm AEADAlgorithm Word8 Salt BL.ByteString
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data KeyPktKind
    = PublicPkt
    | SecretPkt
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data KeyPktRole
    = KeyPktPrimary
    | KeyPktSubkey
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

data KeyPkt (k :: KeyPktKind) where
    KeyPktPublicPrimary :: SomePKPayload -> KeyPkt 'PublicPkt
    KeyPktPublicSubkey :: SomePKPayload -> KeyPkt 'PublicPkt
    KeyPktSecretPrimary
        :: SomePKPayload -> SKAddendum -> KeyPkt 'SecretPkt
    KeyPktSecretSubkey
        :: SomePKPayload -> SKAddendum -> KeyPkt 'SecretPkt

deriving instance Eq (KeyPkt k)
deriving instance Show (KeyPkt k)

instance Ord (KeyPkt k) where
    compare = comparing keyPktToPkt

instance Hashable (KeyPkt k) where
    hashWithSalt s kp = hashWithSalt s (keyPktToPkt kp)

instance Typeable k => Data (KeyPkt k) where
    gfoldl f z (KeyPktPublicPrimary pkp) = z KeyPktPublicPrimary `f` pkp
    gfoldl f z (KeyPktPublicSubkey pkp) = z KeyPktPublicSubkey `f` pkp
    gfoldl f z (KeyPktSecretPrimary pkp ska) = z KeyPktSecretPrimary `f` pkp `f` ska
    gfoldl f z (KeyPktSecretSubkey pkp ska) = z KeyPktSecretSubkey `f` pkp `f` ska

    toConstr (KeyPktPublicPrimary _) = conKeyPktPublicPrimary
    toConstr (KeyPktPublicSubkey _) = conKeyPktPublicSubkey
    toConstr (KeyPktSecretPrimary _ _) = conKeyPktSecretPrimary
    toConstr (KeyPktSecretSubkey _ _) = conKeyPktSecretSubkey

    dataTypeOf _ = tyKeyPkt

    gunfold _ _ _ = error "KeyPkt: gunfold not supported for GADT"

tyKeyPkt :: DD.DataType
tyKeyPkt =
    mkDataType
        "Codec.Encryption.OpenPGP.Types.Internal.Pkt.KeyPkt"
        [ conKeyPktPublicPrimary
        , conKeyPktPublicSubkey
        , conKeyPktSecretPrimary
        , conKeyPktSecretSubkey
        ]

conKeyPktPublicPrimary
    , conKeyPktPublicSubkey
    , conKeyPktSecretPrimary
    , conKeyPktSecretSubkey
        :: Constr
conKeyPktPublicPrimary = mkConstr tyKeyPkt "KeyPktPublicPrimary" [] Prefix
conKeyPktPublicSubkey = mkConstr tyKeyPkt "KeyPktPublicSubkey" [] Prefix
conKeyPktSecretPrimary = mkConstr tyKeyPkt "KeyPktSecretPrimary" [] Prefix
conKeyPktSecretSubkey = mkConstr tyKeyPkt "KeyPktSecretSubkey" [] Prefix

data SomeKeyPkt where
    SomeKeyPkt :: KeyPkt k -> SomeKeyPkt

deriving instance Show SomeKeyPkt

instance Eq SomeKeyPkt where
    SomeKeyPkt left == SomeKeyPkt right =
        someKeyPktToPkt (SomeKeyPkt left)
            == someKeyPktToPkt (SomeKeyPkt right)

data KeyPktCoercionError
    = NotAKeyPacket Pkt
    | ExpectedPublicKeyPacket Pkt
    | ExpectedSecretKeyPacket Pkt
    deriving (Eq, Show)

-- data Pkt = forall a. (Packet a, Show a, Eq a) => Pkt a
data Pkt
    = PKESKPkt PKESKPayload
    | SignaturePkt SignaturePayload
    | SKESKPkt SKESKPayload
    | OnePassSignaturePkt OnePassSignaturePayload
    | SecretKeyPkt SomePKPayload SKAddendum
    | PublicKeyPkt SomePKPayload
    | SecretSubkeyPkt SomePKPayload SKAddendum
    | CompressedDataPkt CompressionAlgorithm CompressedDataPayload
    | SymEncDataPkt ByteString
    | MarkerPkt ByteString
    | LiteralDataPkt
        LiteralDataType
        FileName
        ThirtyTwoBitTimeStamp
        ByteString
    | TrustPkt ByteString
    | UserIdPkt Text
    | PublicSubkeyPkt SomePKPayload
    | UserAttributePkt [UserAttrSubPacket]
    | SymEncIntegrityProtectedDataPkt SEIPDPayload
    | ModificationDetectionCodePkt ByteString
    | PaddingPkt ByteString
    | OtherPacketPkt Word8 ByteString
    | BrokenPacketPkt String Word8 ByteString
    deriving (Data, Eq, Generic, Show, Typeable)

data PktWithBytes
    = PktWithBytes
    { _pktRaw :: ByteString
    , _pktValue :: Pkt
    }
    deriving (Data, Eq, Generic, Show, Typeable)

instance Ord PktWithBytes where
    compare p1 p2 = comparing _pktValue p1 p2 <> comparing _pktRaw p1 p2

instance Hashable PktWithBytes

data PktWithWireRep
    = PktWithWireRep
    { _pktWireRep :: PktWithBytes
    , _pktWireRepRef :: WireRepRef
    , _pktRange :: ByteRange
    , _pktIndex :: Int
    }
    deriving (Data, Eq, Generic, Show, Typeable)

instance Ord PktWithWireRep where
    compare p1 p2 =
        comparing (\p -> _pktValue (_pktWireRep p)) p1 p2
            <> comparing (\p -> _pktRaw (_pktWireRep p)) p1 p2
            <> comparing _pktWireRepRef p1 p2
            <> comparing _pktRange p1 p2
            <> comparing _pktIndex p1 p2

wireRepOfPkt :: PktWithWireRep -> WireRepRef
wireRepOfPkt = _pktWireRepRef

packetsFromWireRep
    :: WireRepRef -> [PktWithWireRep] -> [PktWithWireRep]
packetsFromWireRep src = filter ((== src) . wireRepOfPkt)

instance Hashable Pkt

instance Ord Pkt where
    compare p1 p2 = comparing pktTag p1 p2 <> compareFields p1 p2
      where
        compareFields (PKESKPkt pkesk1) (PKESKPkt pkesk2) = compare pkesk1 pkesk2
        compareFields (SignaturePkt sp1) (SignaturePkt sp2) = compare sp1 sp2
        compareFields (SKESKPkt skesk1) (SKESKPkt skesk2) = compare skesk1 skesk2
        compareFields (OnePassSignaturePkt ops1) (OnePassSignaturePkt ops2) = compare ops1 ops2
        compareFields (SecretKeyPkt pkp1 ska1) (SecretKeyPkt pkp2 ska2) =
            compare pkp1 pkp2 <> compare ska1 ska2
        compareFields (PublicKeyPkt pkp1) (PublicKeyPkt pkp2) = compare pkp1 pkp2
        compareFields (SecretSubkeyPkt pkp1 ska1) (SecretSubkeyPkt pkp2 ska2) =
            compare pkp1 pkp2 <> compare ska1 ska2
        compareFields (CompressedDataPkt ca1 cdp1) (CompressedDataPkt ca2 cdp2) =
            compare ca1 ca2 <> compare cdp1 cdp2
        compareFields (SymEncDataPkt bs1) (SymEncDataPkt bs2) = compare bs1 bs2
        compareFields (MarkerPkt bs1) (MarkerPkt bs2) = compare bs1 bs2
        compareFields (LiteralDataPkt dt1 fn1 ts1 bs1) (LiteralDataPkt dt2 fn2 ts2 bs2) =
            compare dt1 dt2
                <> compare fn1 fn2
                <> compare ts1 ts2
                <> compare bs1 bs2
        compareFields (TrustPkt bs1) (TrustPkt bs2) = compare bs1 bs2
        compareFields (UserIdPkt u1) (UserIdPkt u2) = compare u1 u2
        compareFields (PublicSubkeyPkt pkp1) (PublicSubkeyPkt pkp2) = compare pkp1 pkp2
        compareFields (UserAttributePkt us1) (UserAttributePkt us2) = compare us1 us2
        compareFields (SymEncIntegrityProtectedDataPkt seipd1) (SymEncIntegrityProtectedDataPkt seipd2) = compare seipd1 seipd2
        compareFields (ModificationDetectionCodePkt bs1) (ModificationDetectionCodePkt bs2) = compare bs1 bs2
        compareFields (PaddingPkt bs1) (PaddingPkt bs2) = compare bs1 bs2
        compareFields (OtherPacketPkt t1 bs1) (OtherPacketPkt t2 bs2) = compare t1 t2 <> compare bs1 bs2
        compareFields (BrokenPacketPkt s1 t1 bs1) (BrokenPacketPkt s2 t2 bs2) =
            compare s1 s2 <> compare t1 t2 <> compare bs1 bs2
        compareFields _ _ = EQ

instance Pretty Pkt where
    pretty (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 pv eoki pka mpis))) =
        pretty "PKESK v"
            <> pretty pv
            <> pretty ':'
            <+> pretty eoki
            <+> pretty pka
            <+> (pretty . NE.toList) mpis
    pretty
        ( PKESKPkt
                ( PKESKPayloadV6Packet
                        (PKESKPayloadV6 recipientKeyIdentifier pka esk)
                    )
            ) =
            pretty "PKESK v6:"
                <+> pretty "recipient key identifier"
                <+> pretty (bsToHexUpper recipientKeyIdentifier)
                <+> pretty pka
                <+> pretty (bsToHexUpper esk)
    pretty (SignaturePkt sp) = pretty sp
    pretty (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k mbs))) =
        pretty "SKESK v4:"
            <+> pretty sa
            <+> pretty s2k
            <+> pretty (fmap bsToHexUpper mbs)
    pretty
        ( SKESKPkt
                (SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag))
            ) =
            pretty "SKESK v6:"
                <+> pretty sa
                <+> pretty aa
                <+> pretty s2k
                <+> pretty (bsToHexUpper iv)
                <+> pretty (bsToHexUpper esk)
                <+> pretty (bsToHexUpper tag)
    pretty
        ( OnePassSignaturePkt
                (OPSPayloadV3Packet (OPSPayloadV3 pv st ha pka eoki nestedflag))
            ) =
            pretty "one-pass signature v"
                <> pretty pv
                <> pretty ':'
                <+> pretty st
                <+> pretty ha
                <+> pretty pka
                <+> pretty eoki
                <+> pretty nestedflag
    pretty
        ( OnePassSignaturePkt
                ( OPSPayloadV6Packet
                        (OPSPayloadV6 st ha pka salt signerFingerprint nestedflag)
                    )
            ) =
            pretty "one-pass signature v6:"
                <+> pretty st
                <+> pretty ha
                <+> pretty pka
                <+> pretty salt
                <+> pretty (bsToHexUpper signerFingerprint)
                <+> pretty nestedflag
    pretty (SecretKeyPkt pkp ska) =
        pretty "secret key:" <+> pretty pkp <+> pretty ska
    pretty (PublicKeyPkt pkp) = pretty "public key:" <+> pretty pkp
    pretty (SecretSubkeyPkt pkp ska) =
        pretty "secret subkey:" <+> pretty pkp <+> pretty ska
    pretty (CompressedDataPkt ca cdp) =
        pretty "compressed-data:" <+> pretty ca <+> prettyLBS cdp
    pretty (SymEncDataPkt bs) =
        pretty "symmetrically-encrypted-data:"
            <+> pretty (bsToHexUpper bs)
    pretty (MarkerPkt bs) = pretty "marker:" <+> pretty (bsToHexUpper bs)
    pretty (LiteralDataPkt dt fn ts bs) =
        pretty "literal-data"
            <+> pretty dt
            <+> prettyLBS fn
            <+> pretty ts
            <+> pretty (bsToHexUpper bs)
    pretty (TrustPkt bs) = pretty "trust:" <+> pretty (BL.unpack bs)
    pretty (UserIdPkt u) = pretty "user-ID:" <+> pretty u
    pretty (PublicSubkeyPkt pkp) = pretty "public subkey:" <+> pretty pkp
    pretty (UserAttributePkt us) = pretty "user-attribute:" <+> pretty us
    pretty (SymEncIntegrityProtectedDataPkt (SEIPD1 pv bs)) =
        pretty "symmetrically-encrypted-integrity-protected-data v"
            <> pretty pv
            <> pretty ':'
            <+> pretty (bsToHexUpper bs)
    pretty (SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize salt bs)) =
        pretty "symmetrically-encrypted-integrity-protected-data v2:"
            <+> pretty sa
            <+> pretty aa
            <+> pretty chunkSize
            <+> pretty salt
            <+> pretty (bsToHexUpper bs)
    pretty (ModificationDetectionCodePkt bs) =
        pretty "MDC:" <+> pretty (bsToHexUpper bs)
    pretty (PaddingPkt bs) =
        pretty "Padding:" <+> pretty (bsToHexUpper bs)
    pretty (OtherPacketPkt t bs) =
        pretty "unknown packet type"
            <+> pretty t
            <> pretty ':'
            <+> pretty (bsToHexUpper bs)
    pretty (BrokenPacketPkt s t bs) =
        pretty "BROKEN packet ("
            <> pretty s
            <> pretty ')'
            <+> pretty t
            <> pretty ':'
            <+> pretty (bsToHexUpper bs)

instance A.ToJSON Pkt where
    toJSON (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 pv eoki pka mpis))) =
        object
            [ AK.fromString "pkesk"
                .= object
                    [ AK.fromString "version" .= pv
                    , AK.fromString "keyid" .= eoki
                    , AK.fromString "pkalgo" .= pka
                    , AK.fromString "mpis" .= NE.toList mpis
                    ]
            ]
    toJSON
        ( PKESKPkt
                ( PKESKPayloadV6Packet
                        (PKESKPayloadV6 recipientKeyIdentifier pka esk)
                    )
            ) =
            object
                [ AK.fromString "pkesk"
                    .= object
                        [ AK.fromString "version" .= (6 :: PacketVersion)
                        , AK.fromString "recipient_key_identifier"
                            .= BL.unpack recipientKeyIdentifier
                        , AK.fromString "pkalgo" .= pka
                        , AK.fromString "esk" .= BL.unpack esk
                        ]
                ]
    toJSON (SignaturePkt sp) = object [AK.fromString "signature" .= sp]
    toJSON (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k mbs))) =
        object
            [ AK.fromString "skesk"
                .= object
                    [ AK.fromString "version" .= (4 :: PacketVersion)
                    , AK.fromString "symalgo" .= sa
                    , AK.fromString "s2k" .= s2k
                    , AK.fromString "data" .= maybe mempty BL.unpack mbs
                    ]
            ]
    toJSON
        ( SKESKPkt
                (SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag))
            ) =
            object
                [ AK.fromString "skesk"
                    .= object
                        [ AK.fromString "version" .= (6 :: PacketVersion)
                        , AK.fromString "symalgo" .= sa
                        , AK.fromString "aead" .= aa
                        , AK.fromString "s2k" .= s2k
                        , AK.fromString "iv" .= BL.unpack iv
                        , AK.fromString "esk" .= BL.unpack esk
                        , AK.fromString "tag" .= BL.unpack tag
                        ]
                ]
    toJSON
        ( OnePassSignaturePkt
                (OPSPayloadV3Packet (OPSPayloadV3 pv st ha pka eoki nestedflag))
            ) =
            object
                [ AK.fromString "onepasssignature"
                    .= object
                        [ AK.fromString "version" .= pv
                        , AK.fromString "sigtype" .= st
                        , AK.fromString "hashalgo" .= ha
                        , AK.fromString "pkalgo" .= pka
                        , AK.fromString "keyid" .= eoki
                        , AK.fromString "nested" .= nestedflag
                        ]
                ]
    toJSON
        ( OnePassSignaturePkt
                ( OPSPayloadV6Packet
                        (OPSPayloadV6 st ha pka salt signerFingerprint nestedflag)
                    )
            ) =
            object
                [ AK.fromString "onepasssignature"
                    .= object
                        [ AK.fromString "version" .= (6 :: Word8)
                        , AK.fromString "sigtype" .= st
                        , AK.fromString "hashalgo" .= ha
                        , AK.fromString "pkalgo" .= pka
                        , AK.fromString "salt" .= salt
                        , AK.fromString "fingerprint" .= BL.unpack signerFingerprint
                        , AK.fromString "nested" .= nestedflag
                        ]
                ]
    toJSON (SecretKeyPkt pkp ska) =
        object
            [ AK.fromString "secretkey"
                .= object
                    [AK.fromString "public" .= pkp, AK.fromString "secret" .= ska]
            ]
    toJSON (PublicKeyPkt pkp) = object [AK.fromString "publickey" .= pkp]
    toJSON (SecretSubkeyPkt pkp ska) =
        object
            [ AK.fromString "secretsubkey"
                .= object
                    [AK.fromString "public" .= pkp, AK.fromString "secret" .= ska]
            ]
    toJSON (CompressedDataPkt ca cdp) =
        object
            [ AK.fromString "compresseddata"
                .= object
                    [ AK.fromString "compressionalgo" .= ca
                    , AK.fromString "data" .= BL.unpack cdp
                    ]
            ]
    toJSON (SymEncDataPkt bs) = object [AK.fromString "symencdata" .= BL.unpack bs]
    toJSON (MarkerPkt bs) = object [AK.fromString "marker" .= BL.unpack bs]
    toJSON (LiteralDataPkt dt fn ts bs) =
        object
            [ AK.fromString "literaldata"
                .= object
                    [ AK.fromString "dt" .= dt
                    , AK.fromString "filename" .= BL.unpack fn
                    , AK.fromString "ts" .= ts
                    , AK.fromString "data" .= BL.unpack bs
                    ]
            ]
    toJSON (TrustPkt bs) = object [AK.fromString "trust" .= BL.unpack bs]
    toJSON (UserIdPkt u) = object [AK.fromString "userid" .= u]
    toJSON (PublicSubkeyPkt pkp) = object [AK.fromString "publicsubkkey" .= pkp]
    toJSON (UserAttributePkt us) = object [AK.fromString "userattribute" .= us]
    toJSON (SymEncIntegrityProtectedDataPkt (SEIPD1 pv bs)) =
        object
            [ AK.fromString "symencipd"
                .= object
                    [ AK.fromString "version" .= pv
                    , AK.fromString "data" .= BL.unpack bs
                    ]
            ]
    toJSON (SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize salt bs)) =
        object
            [ AK.fromString "symencipd"
                .= object
                    [ AK.fromString "version" .= (2 :: PacketVersion)
                    , AK.fromString "symalgo" .= sa
                    , AK.fromString "aeadalgo" .= aa
                    , AK.fromString "chunksize" .= chunkSize
                    , AK.fromString "salt" .= salt
                    , AK.fromString "data" .= BL.unpack bs
                    ]
            ]
    toJSON (ModificationDetectionCodePkt bs) =
        object [AK.fromString "mdc" .= BL.unpack bs]
    toJSON (PaddingPkt bs) =
        object [AK.fromString "padding" .= BL.unpack bs]
    toJSON (OtherPacketPkt t bs) =
        object
            [ AK.fromString "otherpacket"
                .= object
                    [AK.fromString "tag" .= t, AK.fromString "data" .= BL.unpack bs]
            ]
    toJSON (BrokenPacketPkt s t bs) =
        object
            [ AK.fromString "brokenpacket"
                .= object
                    [ AK.fromString "error" .= s
                    , AK.fromString "tag" .= t
                    , AK.fromString "data" .= BL.unpack bs
                    ]
            ]

pktTag :: Pkt -> Word8
pktTag PKESKPkt {} = 1
pktTag (SignaturePkt _) = 2
pktTag SKESKPkt {} = 3
pktTag OnePassSignaturePkt {} = 4
pktTag SecretKeyPkt {} = 5
pktTag (PublicKeyPkt _) = 6
pktTag SecretSubkeyPkt {} = 7
pktTag CompressedDataPkt {} = 8
pktTag (SymEncDataPkt _) = 9
pktTag (MarkerPkt _) = 10
pktTag LiteralDataPkt {} = 11
pktTag (TrustPkt _) = 12
pktTag (UserIdPkt _) = 13
pktTag (PublicSubkeyPkt _) = 14
pktTag (UserAttributePkt _) = 17
pktTag SymEncIntegrityProtectedDataPkt {} = 18
pktTag (ModificationDetectionCodePkt _) = 19
pktTag (PaddingPkt _) = 21
pktTag (OtherPacketPkt t _) = t
pktTag (BrokenPacketPkt _ t _) = t -- is this the right thing to do?

renderKeyPktCoercionError :: KeyPktCoercionError -> String
renderKeyPktCoercionError (NotAKeyPacket pkt) =
    "Expected a key packet, got tag " ++ show (pktTag pkt)
renderKeyPktCoercionError (ExpectedPublicKeyPacket pkt) =
    "Expected a public key packet, got tag " ++ show (pktTag pkt)
renderKeyPktCoercionError (ExpectedSecretKeyPacket pkt) =
    "Expected a secret key packet, got tag " ++ show (pktTag pkt)

keyPktRole :: KeyPkt k -> KeyPktRole
keyPktRole KeyPktPublicPrimary {} = KeyPktPrimary
keyPktRole KeyPktPublicSubkey {} = KeyPktSubkey
keyPktRole KeyPktSecretPrimary {} = KeyPktPrimary
keyPktRole KeyPktSecretSubkey {} = KeyPktSubkey

keyPktPKPayload :: KeyPkt k -> SomePKPayload
keyPktPKPayload (KeyPktPublicPrimary pkp) = pkp
keyPktPKPayload (KeyPktPublicSubkey pkp) = pkp
keyPktPKPayload (KeyPktSecretPrimary pkp _) = pkp
keyPktPKPayload (KeyPktSecretSubkey pkp _) = pkp

keyPktMaybeSKAddendum :: KeyPkt k -> Maybe SKAddendum
keyPktMaybeSKAddendum KeyPktPublicPrimary {} = Nothing
keyPktMaybeSKAddendum KeyPktPublicSubkey {} = Nothing
keyPktMaybeSKAddendum (KeyPktSecretPrimary _ ska) = Just ska
keyPktMaybeSKAddendum (KeyPktSecretSubkey _ ska) = Just ska

keyPktTKKey :: KeyPkt k -> (SomePKPayload, Maybe SKAddendum)
keyPktTKKey keyPkt = (keyPktPKPayload keyPkt, keyPktMaybeSKAddendum keyPkt)

secretKeyPktSKAddendum :: KeyPkt 'SecretPkt -> SKAddendum
secretKeyPktSKAddendum (KeyPktSecretPrimary _ ska) = ska
secretKeyPktSKAddendum (KeyPktSecretSubkey _ ska) = ska

mkPrimaryKeyPkt
    :: SomePKPayload -> Maybe SKAddendum -> SomeKeyPkt
mkPrimaryKeyPkt pkp Nothing = SomeKeyPkt (KeyPktPublicPrimary pkp)
mkPrimaryKeyPkt pkp (Just ska) = SomeKeyPkt (KeyPktSecretPrimary pkp ska)

mkSubkeyKeyPkt :: SomePKPayload -> Maybe SKAddendum -> SomeKeyPkt
mkSubkeyKeyPkt pkp Nothing = SomeKeyPkt (KeyPktPublicSubkey pkp)
mkSubkeyKeyPkt pkp (Just ska) = SomeKeyPkt (KeyPktSecretSubkey pkp ska)

keyPktToPublicView :: KeyPkt 'SecretPkt -> KeyPkt 'PublicPkt
keyPktToPublicView (KeyPktSecretPrimary pkp _) = KeyPktPublicPrimary pkp
keyPktToPublicView (KeyPktSecretSubkey pkp _) = KeyPktPublicSubkey pkp

keyPktToPkt :: KeyPkt k -> Pkt
keyPktToPkt (KeyPktPublicPrimary pkp) = PublicKeyPkt pkp
keyPktToPkt (KeyPktPublicSubkey pkp) = PublicSubkeyPkt pkp
keyPktToPkt (KeyPktSecretPrimary pkp ska) = SecretKeyPkt pkp ska
keyPktToPkt (KeyPktSecretSubkey pkp ska) = SecretSubkeyPkt pkp ska

someKeyPktToPkt :: SomeKeyPkt -> Pkt
someKeyPktToPkt (SomeKeyPkt keyPkt) = keyPktToPkt keyPkt

pktToSomeKeyPktEither
    :: Pkt -> Either KeyPktCoercionError SomeKeyPkt
pktToSomeKeyPktEither (PublicKeyPkt pkp) = Right (SomeKeyPkt (KeyPktPublicPrimary pkp))
pktToSomeKeyPktEither (PublicSubkeyPkt pkp) = Right (SomeKeyPkt (KeyPktPublicSubkey pkp))
pktToSomeKeyPktEither (SecretKeyPkt pkp ska) = Right (SomeKeyPkt (KeyPktSecretPrimary pkp ska))
pktToSomeKeyPktEither (SecretSubkeyPkt pkp ska) = Right (SomeKeyPkt (KeyPktSecretSubkey pkp ska))
pktToSomeKeyPktEither pkt = Left (NotAKeyPacket pkt)

pktToSomeKeyPkt :: Pkt -> Maybe SomeKeyPkt
pktToSomeKeyPkt = either (const Nothing) Just . pktToSomeKeyPktEither

pktToPublicKeyPktEither
    :: Pkt -> Either KeyPktCoercionError (KeyPkt 'PublicPkt)
pktToPublicKeyPktEither (PublicKeyPkt pkp) = Right (KeyPktPublicPrimary pkp)
pktToPublicKeyPktEither (PublicSubkeyPkt pkp) = Right (KeyPktPublicSubkey pkp)
pktToPublicKeyPktEither pkt = Left (ExpectedPublicKeyPacket pkt)

pktToPublicKeyPkt :: Pkt -> Maybe (KeyPkt 'PublicPkt)
pktToPublicKeyPkt = either (const Nothing) Just . pktToPublicKeyPktEither

pktToSecretKeyPktEither
    :: Pkt -> Either KeyPktCoercionError (KeyPkt 'SecretPkt)
pktToSecretKeyPktEither (SecretKeyPkt pkp ska) = Right (KeyPktSecretPrimary pkp ska)
pktToSecretKeyPktEither (SecretSubkeyPkt pkp ska) = Right (KeyPktSecretSubkey pkp ska)
pktToSecretKeyPktEither pkt = Left (ExpectedSecretKeyPacket pkt)

pktToSecretKeyPkt :: Pkt -> Maybe (KeyPkt 'SecretPkt)
pktToSecretKeyPkt = either (const Nothing) Just . pktToSecretKeyPktEither

{- | Convert secret key/subkey packets to their public-key packet forms.
Non-secret packets are returned unchanged.
-}
publicKeyPacketOf :: Pkt -> Pkt
publicKeyPacketOf pkt =
    maybe
        pkt
        (keyPktToPkt . keyPktToPublicView)
        (pktToSecretKeyPkt pkt)

data Verification
    = Verification
    { _verificationSigner :: SomePKPayload
    , _verificationSignature :: SignaturePayload
    , _verificationWarnings :: [VerificationWarning]
    }

data VerificationWarning
    = MissingSubkeyBackSignatureWarning
    | DeprecatedHashAlgorithmWarning HashAlgorithm
    | UnsupportedHashAlgorithmWarning HashAlgorithm
    | PkaMismatchWarning PubKeyAlgorithm PubKeyAlgorithm
    | UnsupportedCriticalSubpacketWarning SigType
    | LegacyIssuerKeyIdInV6Warning
    | InvalidSignatureContextWarning SigType
    | ExpiredSignatureWarning
    deriving (Eq, Show)

data SOPVVerification
    = SOPVVerification
    { _sopvvDateStamp :: UTCTime
    , _sopvvFingerprint :: Fingerprint
    , _sopvvPrimaryFingerprint :: Fingerprint
    , _sopvvMode :: String
    , _sopvvDescription :: String
    }

$(makeLenses ''Verification)
$(makeLenses ''SOPVVerification)
$(makeLenses ''PktWithBytes)
$(makeLenses ''PktWithWireRep)
