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

module Codec.Encryption.OpenPGP.Types.Internal.Base
    ( KeyVersion (..)
    , IV (..)
    , S2K (..)
    , SymmetricAlgorithm (..)
    , AEADAlgorithm (..)
    , PubKeyAlgorithm (..)
    , ThirtyTwoBitTimeStamp (..)
    , ThirtyTwoBitDuration (..)
    , Exportability
    , TrustLevel
    , TrustAmount
    , AlmostPublicDomainRegex
    , Revocability
    , RevocationReason
    , KeyServer
    , SignatureHash
    , PacketVersion
    , V3Expiration
    , CompressedDataPayload
    , FileName
    , ImageData
    , NestedFlag
    , HashAlgorithm (..)
    , bsToHexUpper
    , Hashed
    , Unhashed
    , V4Sig
    , V6Sig
    , ByteRange (..)
    , WireRepSourceId (..)
    , WireRepRef (..)
    , WireRepRefs
    , wireRepRef
    , namedWireRepRef
    , mkWireRepRefWithLength
    , mkWireRepRef
    , SignaturePayload (..)
    , _SigV3
    , _SigV4
    , _SigV6
    , _SigVOther
    , Fingerprint (..)
    , SessionKey (..)
    , SigType (..)
    , SignatureSalt (..)
    , Salt (..)
    , Salt8 (..)
    , Salt16 (..)
    , CompressionAlgorithm (..)
    , LiteralDataType (..)
    , UserAttrSubPacket (..)
    , EightOctetKeyId (..)
    , MPI (..)
    , SignaturePayloadVersion (..)
    , SignaturePayloadV (..)
    , SomeSignaturePayload (..)
    , toSignaturePayload
    , toSomeSignaturePayload
    , signaturePayloadVersion
    , asSignaturePayloadV3
    , asSignaturePayloadV4
    , asSignaturePayloadV6
    , asSignaturePayloadOther
    , FutureVal (..)
    , SigSubPacket (..)
    , SigSubPacketPayload (..)
    , ECCCurve (..)
    , IssuerFingerprintVersion (..)
    , IterationCount (..)
    , salt8FromSalt
    , salt16FromSalt
    , saltFromSalt8
    , saltFromSalt16
    , Block (..)
    , FutureFlag (..)
    , ImageHeader (..)
    , issuerFingerprintVersionToPacketVersion
    , packetVersionToIssuerFingerprintVersion
    , NotationName (..)
    , NotationValue (..)
    , URL (..)
    , RevocationClass (..)
    , SubpacketList (..)
    , fromSubpacketList
    , toSubpacketList
    , emptyHashedSubpackets
    , emptyUnhashedSubpackets
    , consHashedSubpacket
    , consUnhashedSubpacket
    , spanByteRanges
    , RevocationCode (..)
    , KeyFlag (..)
    , KeyIdentifier (..)
    , FeatureFlag (..)
    , NotationFlag (..)
    , KSPFlag (..)
    , mkRevocationClass
    , mkNotationFlag
    , SpacedFingerprint (..)
    , ImageFormat (..)
    , Passphrase (..)
    ) where

import Control.Applicative ((<|>))
import Control.Arrow ((***))
import Control.Lens (Wrapped, makeLenses, makePrisms, op)
import Control.Monad (mzero)
import Data.Aeson (object, (.=))
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as AK
import qualified Data.Aeson.TH as ATH
import Data.Bits ((.&.))
import Data.ByteArray (ByteArrayAccess)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16.Lazy as B16L
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC8
import Data.Char (toLower, toUpper)
import Data.Data (Data)
import Data.Hashable (Hashable (..))
import Data.IORef (IORef, atomicModifyIORef', newIORef)
import Data.Int (Int64)
import Data.Kind (Type)
import Data.List (unfoldr)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import Data.List.Split (chunksOf)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Time.Format (formatTime)
import Data.Time.Locale.Compat (defaultTimeLocale)
import Data.Typeable (Typeable)
import Data.Word (Word16, Word32, Word8)
import GHC.Generics (Generic)
import Network.URI (URI (..), nullURI, parseURI, uriToString)
import Numeric (readHex)
import Prettyprinter (Pretty (..), hsep, punctuate, space, (<+>))
import System.IO.Unsafe (unsafePerformIO)

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

type Exportability = Bool

type TrustLevel = Word8

type TrustAmount = Word8

type AlmostPublicDomainRegex = ByteString

type Revocability = Bool

type RevocationReason = Text

type KeyServer = ByteString

type SignatureHash = ByteString

type PacketVersion = Word8

type V3Expiration = Word16

type CompressedDataPayload = ByteString

type FileName = ByteString

type ImageData = ByteString

type NestedFlag = Bool

{- | Phantom types for tracking subpacket classification and signature version
These types are never instantiated; they exist purely for compile-time type safety.
-}

-- | Phantom marker for hashed subpackets (included in signature hash computation)
data Hashed

-- | Phantom marker for unhashed subpackets (not included in signature hash computation)
data Unhashed

-- | Phantom marker for v4 signatures (8-octet issuer, no salt)
data V4Sig

-- | Phantom marker for v6 signatures (fingerprint issuer, requires salt)
data V6Sig

data ByteRange
    = ByteRange
    { _rangeOffset :: Int64
    , _rangeLength :: Int64
    }
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

newtype WireRepSourceId
    = WireRepSourceId
    { _unWireRepSourceId :: Int64
    }
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

data WireRepRef
    = WireRepRef
    { _wireRepSourceId :: WireRepSourceId
    , _wireRepLength :: Int64
    , _wireRepName :: Maybe Text
    , _wireRepWasOriginallyArmored :: Bool
    }
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

type WireRepRefs = NonEmpty WireRepRef

-- FIXME: these functions should be moved into a separate module
wireRepRef :: ByteString -> WireRepRef
wireRepRef = mkWireRepRefWithLength Nothing False . BL.length

namedWireRepRef :: Text -> ByteString -> WireRepRef
namedWireRepRef name = mkWireRepRefWithLength (Just name) False . BL.length

mkWireRepRefWithLength
    :: Maybe Text -> Bool -> Int64 -> WireRepRef
mkWireRepRefWithLength mname wasOriginallyArmored payloadLen =
    WireRepRef
        { _wireRepSourceId = freshWireRepSourceId payloadLen
        , _wireRepLength = payloadLen
        , _wireRepName = mname
        , _wireRepWasOriginallyArmored = wasOriginallyArmored
        }

mkWireRepRef :: Maybe Text -> Bool -> ByteString -> WireRepRef
mkWireRepRef mname wasOriginallyArmored =
    mkWireRepRefWithLength mname wasOriginallyArmored . BL.length

wireRepSourceCounter :: IORef Int64
wireRepSourceCounter = unsafePerformIO (newIORef 0)
{-# NOINLINE wireRepSourceCounter #-}
freshWireRepSourceId :: Int64 -> WireRepSourceId
freshWireRepSourceId !_ =
    unsafePerformIO $
        atomicModifyIORef'
            wireRepSourceCounter
            ( \n ->
                let n' = n + 1
                 in (n', WireRepSourceId n')
            )
{-# NOINLINE freshWireRepSourceId #-}
rangeEnd :: ByteRange -> Int64
rangeEnd r = _rangeOffset r + _rangeLength r

spanByteRanges :: [ByteRange] -> Maybe ByteRange
spanByteRanges [] = Nothing
spanByteRanges (r : rs) =
    let start = minimum (_rangeOffset <$> (r : rs))
        ending = maximum (rangeEnd <$> (r : rs))
     in Just (ByteRange start (ending - start))

$(makeLenses ''ByteRange)

$(makeLenses ''WireRepRef)

class
    (Eq a, Ord a) =>
    FutureFlag a
    where
    fromFFlag :: a -> Int
    toFFlag :: Int -> a

class
    (Eq a, Ord a) =>
    FutureVal a
    where
    fromFVal :: a -> Word8
    toFVal :: Word8 -> a

data SymmetricAlgorithm
    = Plaintext
    | IDEA
    | TripleDES
    | CAST5
    | Blowfish
    | ReservedSAFER
    | ReservedDES
    | AES128
    | AES192
    | AES256
    | Twofish
    | Camellia128
    | Camellia192
    | Camellia256
    | OtherSA Word8
    deriving (Data, Generic, Show, Typeable)

instance Eq SymmetricAlgorithm where
    (==) a b = fromFVal a == fromFVal b

instance Ord SymmetricAlgorithm where
    compare = comparing fromFVal

instance FutureVal SymmetricAlgorithm where
    fromFVal Plaintext = 0
    fromFVal IDEA = 1
    fromFVal TripleDES = 2
    fromFVal CAST5 = 3
    fromFVal Blowfish = 4
    fromFVal ReservedSAFER = 5
    fromFVal ReservedDES = 6
    fromFVal AES128 = 7
    fromFVal AES192 = 8
    fromFVal AES256 = 9
    fromFVal Twofish = 10
    fromFVal Camellia128 = 11
    fromFVal Camellia192 = 12
    fromFVal Camellia256 = 13
    fromFVal (OtherSA o) = o
    toFVal 0 = Plaintext
    toFVal 1 = IDEA
    toFVal 2 = TripleDES
    toFVal 3 = CAST5
    toFVal 4 = Blowfish
    toFVal 5 = ReservedSAFER
    toFVal 6 = ReservedDES
    toFVal 7 = AES128
    toFVal 8 = AES192
    toFVal 9 = AES256
    toFVal 10 = Twofish
    toFVal 11 = Camellia128
    toFVal 12 = Camellia192
    toFVal 13 = Camellia256
    toFVal o = OtherSA o

instance Hashable SymmetricAlgorithm

instance Pretty SymmetricAlgorithm where
    pretty Plaintext = pretty "plaintext"
    pretty IDEA = pretty "IDEA"
    pretty TripleDES = pretty "3DES"
    pretty CAST5 = pretty "CAST-128"
    pretty Blowfish = pretty "Blowfish"
    pretty ReservedSAFER = pretty "(reserved) SAFER"
    pretty ReservedDES = pretty "(reserved) DES"
    pretty AES128 = pretty "AES-128"
    pretty AES192 = pretty "AES-192"
    pretty AES256 = pretty "AES-256"
    pretty Twofish = pretty "Twofish"
    pretty Camellia128 = pretty "Camellia-128"
    pretty Camellia192 = pretty "Camellia-192"
    pretty Camellia256 = pretty "Camellia-256"
    pretty (OtherSA sa) = pretty "unknown symmetric algorithm" <+> pretty sa

$(ATH.deriveJSON ATH.defaultOptions ''SymmetricAlgorithm)

data NotationFlag
    = HumanReadable
    | OtherNF Word8
    deriving (Data, Generic, Show, Typeable)

mkNotationFlag :: Word8 -> NotationFlag
mkNotationFlag o
    | o' == 0 = HumanReadable
    | otherwise = OtherNF o'
  where
    o' = o .&. 0x0f

instance Eq NotationFlag where
    (==) a b = fromFFlag a == fromFFlag b

instance Ord NotationFlag where
    compare = comparing fromFFlag

instance FutureFlag NotationFlag where
    fromFFlag HumanReadable = 0
    fromFFlag (OtherNF o) = fromIntegral (o .&. 0x0f)
    toFFlag 0 = HumanReadable
    toFFlag o = mkNotationFlag (fromIntegral o)

instance Hashable NotationFlag

instance Pretty NotationFlag where
    pretty HumanReadable = pretty "human-readable"
    pretty (OtherNF o) = pretty "unknown notation flag type" <+> pretty o

$(ATH.deriveJSON ATH.defaultOptions ''NotationFlag)

newtype ThirtyTwoBitTimeStamp
    = ThirtyTwoBitTimeStamp
    { unThirtyTwoBitTimeStamp :: Word32
    }
    deriving
        ( Bounded
        , Data
        , Enum
        , Eq
        , Generic
        , Hashable
        , Integral
        , Num
        , Ord
        , Real
        , Show
        , Typeable
        )

instance Wrapped ThirtyTwoBitTimeStamp

instance Pretty ThirtyTwoBitTimeStamp where
    pretty =
        pretty
            . formatTime defaultTimeLocale "%Y%m%d-%H%M%S"
            . posixSecondsToUTCTime
            . realToFrac

$(ATH.deriveJSON ATH.defaultOptions ''ThirtyTwoBitTimeStamp)

durU :: (Integral a, Show a) => a -> Maybe (String, a)
durU x
    | x >= 31557600 =
        Just ((++ "y") . show $ x `div` 31557600, x `mod` 31557600)
    | x >= 2629800 =
        Just ((++ "m") . show $ x `div` 2629800, x `mod` 2629800)
    | x >= 86400 =
        Just ((++ "d") . show $ x `div` 86400, x `mod` 86400)
    | x > 0 = Just ((++ "s") . show $ x, 0)
    | otherwise = Nothing

newtype ThirtyTwoBitDuration
    = ThirtyTwoBitDuration
    { unThirtyTwoBitDuration :: Word32
    }
    deriving
        ( Bounded
        , Data
        , Enum
        , Eq
        , Generic
        , Hashable
        , Integral
        , Num
        , Ord
        , Real
        , Show
        , Typeable
        )

instance Wrapped ThirtyTwoBitDuration

instance Pretty ThirtyTwoBitDuration where
    pretty = pretty . concat . unfoldr durU . op ThirtyTwoBitDuration

$(ATH.deriveJSON ATH.defaultOptions ''ThirtyTwoBitDuration)

data RevocationClass
    = SensitiveRK
    | RClOther Word8
    deriving (Data, Generic, Show, Typeable)

mkRevocationClass :: Word8 -> RevocationClass
mkRevocationClass i
    | i' == 1 = SensitiveRK
    | otherwise = RClOther i'
  where
    i' = i .&. 0x07

instance Eq RevocationClass where
    (==) a b = fromFFlag a == fromFFlag b

instance Ord RevocationClass where
    compare = comparing fromFFlag

instance FutureFlag RevocationClass where
    fromFFlag SensitiveRK = 1
    fromFFlag (RClOther i) = fromIntegral (i .&. 0x07)
    toFFlag 1 = SensitiveRK
    toFFlag i = mkRevocationClass (fromIntegral i)

instance Hashable RevocationClass

instance Pretty RevocationClass where
    pretty SensitiveRK = pretty "sensitive"
    pretty (RClOther o) = pretty "unknown revocation class" <+> pretty o

$(ATH.deriveJSON ATH.defaultOptions ''RevocationClass)

data PubKeyAlgorithm
    = RSA
    | DeprecatedRSAEncryptOnly
    | DeprecatedRSASignOnly
    | ElgamalEncryptOnly
    | DSA
    | ECDH
    | ECDSA
    | ForbiddenElgamal
    | DH
    | EdDSA
    | X25519
    | X448
    | Ed25519
    | Ed448
    | MLDSA65Ed25519 -- ID 30: ML-DSA-65+Ed25519
    | MLDSA87Ed448 -- ID 31: ML-DSA-87+Ed448
    | SLHDSASHAKE128s -- ID 32: SLH-DSA-SHAKE-128s
    | SLHDSASHAKE128f -- ID 33: SLH-DSA-SHAKE-128f
    | SLHDSASHAKE256s -- ID 34: SLH-DSA-SHAKE-256s
    | MLKEM768X25519 -- ID 35: ML-KEM-768+X25519
    | MLKEM1024X448 -- ID 36: ML-KEM-1024+X448
    | OtherPKA Word8
    deriving (Data, Generic, Show, Typeable)

instance Eq PubKeyAlgorithm where
    (==) a b = fromFVal a == fromFVal b

instance Ord PubKeyAlgorithm where
    compare = comparing fromFVal

instance FutureVal PubKeyAlgorithm where
    fromFVal RSA = 1
    fromFVal DeprecatedRSAEncryptOnly = 2
    fromFVal DeprecatedRSASignOnly = 3
    fromFVal ElgamalEncryptOnly = 16
    fromFVal DSA = 17
    fromFVal ECDH = 18
    fromFVal ECDSA = 19
    fromFVal ForbiddenElgamal = 20
    fromFVal DH = 21
    fromFVal EdDSA = 22
    fromFVal X25519 = 25
    fromFVal X448 = 26
    fromFVal Ed25519 = 27
    fromFVal Ed448 = 28
    fromFVal MLDSA65Ed25519 = 30
    fromFVal MLDSA87Ed448 = 31
    fromFVal SLHDSASHAKE128s = 32
    fromFVal SLHDSASHAKE128f = 33
    fromFVal SLHDSASHAKE256s = 34
    fromFVal MLKEM768X25519 = 35
    fromFVal MLKEM1024X448 = 36
    fromFVal (OtherPKA o) = o
    toFVal 1 = RSA
    toFVal 2 = DeprecatedRSAEncryptOnly
    toFVal 3 = DeprecatedRSASignOnly
    toFVal 16 = ElgamalEncryptOnly
    toFVal 17 = DSA
    toFVal 18 = ECDH
    toFVal 19 = ECDSA
    toFVal 20 = ForbiddenElgamal
    toFVal 21 = DH
    toFVal 22 = EdDSA
    toFVal 25 = X25519
    toFVal 26 = X448
    toFVal 27 = Ed25519
    toFVal 28 = Ed448
    toFVal 30 = MLDSA65Ed25519
    toFVal 31 = MLDSA87Ed448
    toFVal 32 = SLHDSASHAKE128s
    toFVal 33 = SLHDSASHAKE128f
    toFVal 34 = SLHDSASHAKE256s
    toFVal 35 = MLKEM768X25519
    toFVal 36 = MLKEM1024X448
    toFVal o = OtherPKA o

instance Hashable PubKeyAlgorithm

instance Pretty PubKeyAlgorithm where
    pretty RSA = pretty "RSA"
    pretty DeprecatedRSAEncryptOnly = pretty "(deprecated) RSA encrypt-only"
    pretty DeprecatedRSASignOnly = pretty "(deprecated) RSA sign-only"
    pretty ElgamalEncryptOnly = pretty "Elgamal encrypt-only"
    pretty DSA = pretty "DSA"
    pretty ECDH = pretty "ECDH"
    pretty ECDSA = pretty "ECDSA"
    pretty ForbiddenElgamal = pretty "(forbidden) Elgamal"
    pretty DH = pretty "DH"
    pretty EdDSA = pretty "EdDSA"
    pretty X25519 = pretty "X25519"
    pretty X448 = pretty "X448"
    pretty Ed25519 = pretty "Ed25519"
    pretty Ed448 = pretty "Ed448"
    pretty MLDSA65Ed25519 = pretty "ML-DSA-65+Ed25519"
    pretty MLDSA87Ed448 = pretty "ML-DSA-87+Ed448"
    pretty SLHDSASHAKE128s = pretty "SLH-DSA-SHAKE-128s"
    pretty SLHDSASHAKE128f = pretty "SLH-DSA-SHAKE-128f"
    pretty SLHDSASHAKE256s = pretty "SLH-DSA-SHAKE-256s"
    pretty MLKEM768X25519 = pretty "ML-KEM-768+X25519"
    pretty MLKEM1024X448 = pretty "ML-KEM-1024+X448"
    pretty (OtherPKA pka) = pretty "unknown pubkey algorithm type" <+> pretty pka

$(ATH.deriveJSON ATH.defaultOptions ''PubKeyAlgorithm)

{- | An OpenPGP fingerprint.  Length depends on key version:
16 bytes (v3/MD5), 20 bytes (v4/SHA-1), or 32 bytes (v6/SHA-256).
-}
newtype Fingerprint
    = Fingerprint
    { unFingerprint :: ByteString
    }
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Wrapped Fingerprint

instance Read Fingerprint where
    readsPrec _ s =
        let ws = hexToW8s (filter (/= ' ') s)
         in if null ws
                then []
                else [(Fingerprint (BL.pack (map fst ws)), snd (last ws))]

instance Hashable Fingerprint

instance Pretty Fingerprint where
    pretty = pretty . bsToHexUpper . unFingerprint

instance A.ToJSON Fingerprint where
    toJSON e = object [AK.fromString "fpr" .= (A.toJSON . show . pretty) e]

instance A.FromJSON Fingerprint where
    parseJSON (A.Object v) = Fingerprint . read <$> v A..: AK.fromString "fpr"
    parseJSON _ = mzero

newtype SpacedFingerprint
    = SpacedFingerprint
    { unSpacedFingerprint :: Fingerprint
    }
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Wrapped SpacedFingerprint

instance Pretty SpacedFingerprint where
    pretty =
        hsep
            . punctuate space
            . map hsep
            . chunksOf 5
            . map pretty
            . chunksOf 4
            . bsToHexUpper
            . unFingerprint
            . op SpacedFingerprint

bsToHexUpper :: ByteString -> String
bsToHexUpper = map toUpper . BLC8.unpack . B16L.encode

hexToW8s :: ReadS Word8
hexToW8s = concatMap readHex . chunksOf 2 . map toLower

newtype EightOctetKeyId
    = EightOctetKeyId
    { unEOKI :: ByteString
    }
    deriving (Data, Eq, Generic, Ord, Typeable)

instance Wrapped EightOctetKeyId

instance Pretty EightOctetKeyId where
    pretty = pretty . bsToHexUpper . op EightOctetKeyId

instance Show EightOctetKeyId where
    show = bsToHexUpper . op EightOctetKeyId

instance Read EightOctetKeyId where
    readsPrec _ =
        map ((EightOctetKeyId . BL.pack *** concat) . unzip)
            . chunksOf 8
            . hexToW8s

instance Hashable EightOctetKeyId

instance A.ToJSON EightOctetKeyId where
    toJSON e =
        object
            [AK.fromString "eoki" .= (bsToHexUpper . op EightOctetKeyId) e]

instance A.FromJSON EightOctetKeyId where
    parseJSON (A.Object v) =
        EightOctetKeyId . read <$> v A..: AK.fromString "eoki"
    parseJSON _ = mzero

data KeyIdentifier
    = KeyIdentifierWildcard
    | KeyIdentifierEightOctet EightOctetKeyId
    | KeyIdentifierFingerprint Fingerprint
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Pretty KeyIdentifier where
    pretty KeyIdentifierWildcard = pretty "wildcard"
    pretty (KeyIdentifierEightOctet kid) = pretty "key-id" <+> pretty kid
    pretty (KeyIdentifierFingerprint fp) = pretty "fingerprint" <+> pretty fp

instance A.ToJSON KeyIdentifier where
    toJSON KeyIdentifierWildcard =
        object [AK.fromString "wildcard" .= A.Bool True]
    toJSON (KeyIdentifierEightOctet kid) = object [AK.fromString "keyId" .= kid]
    toJSON (KeyIdentifierFingerprint fp) =
        object [AK.fromString "fingerprint" .= fp]

instance A.FromJSON KeyIdentifier where
    parseJSON (A.Object v) =
        ( (v A..: AK.fromString "wildcard") >>= \isWildcard ->
            if isWildcard
                then pure KeyIdentifierWildcard
                else mzero
        )
            <|> (KeyIdentifierEightOctet <$> v A..: AK.fromString "keyId")
            <|> (KeyIdentifierFingerprint <$> v A..: AK.fromString "fingerprint")
    parseJSON _ = mzero

newtype NotationName
    = NotationName
    { unNotationName :: ByteString
    }
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

instance Pretty NotationName where
    pretty = prettyLBS . unNotationName

instance Wrapped NotationName

instance A.ToJSON NotationName where
    toJSON nn =
        object
            [AK.fromString "notationname" .= show (op NotationName nn)]

instance A.FromJSON NotationName where
    parseJSON (A.Object v) =
        NotationName . read <$> v A..: AK.fromString "notationname"
    parseJSON _ = mzero

newtype NotationValue
    = NotationValue
    { unNotationValue :: ByteString
    }
    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)

instance Pretty NotationValue where
    pretty = prettyLBS . unNotationValue

instance Wrapped NotationValue

instance A.ToJSON NotationValue where
    toJSON nv =
        object
            [AK.fromString "notationvalue" .= show (op NotationValue nv)]

instance A.FromJSON NotationValue where
    parseJSON (A.Object v) =
        NotationValue . read <$> v A..: AK.fromString "notationvalue"
    parseJSON _ = mzero

data HashAlgorithm
    = DeprecatedMD5
    | SHA1
    | RIPEMD160
    | SHA256
    | SHA384
    | SHA512
    | SHA224
    | SHA3_256
    | SHA3_512
    | OtherHA Word8
    deriving (Data, Generic, Show, Typeable)

instance Eq HashAlgorithm where
    (==) a b = fromFVal a == fromFVal b

instance Ord HashAlgorithm where
    compare = comparing fromFVal

instance FutureVal HashAlgorithm where
    fromFVal DeprecatedMD5 = 1
    fromFVal SHA1 = 2
    fromFVal RIPEMD160 = 3
    fromFVal SHA256 = 8
    fromFVal SHA384 = 9
    fromFVal SHA512 = 10
    fromFVal SHA224 = 11
    fromFVal SHA3_256 = 12
    fromFVal SHA3_512 = 14
    fromFVal (OtherHA o) = o
    toFVal 1 = DeprecatedMD5
    toFVal 2 = SHA1
    toFVal 3 = RIPEMD160
    toFVal 8 = SHA256
    toFVal 9 = SHA384
    toFVal 10 = SHA512
    toFVal 11 = SHA224
    toFVal 12 = SHA3_256
    toFVal 14 = SHA3_512
    toFVal o = OtherHA o

instance Hashable HashAlgorithm

instance Pretty HashAlgorithm where
    pretty DeprecatedMD5 = pretty "(deprecated) MD5"
    pretty SHA1 = pretty "SHA-1"
    pretty RIPEMD160 = pretty "RIPEMD-160"
    pretty SHA256 = pretty "SHA-256"
    pretty SHA384 = pretty "SHA-384"
    pretty SHA512 = pretty "SHA-512"
    pretty SHA224 = pretty "SHA-224"
    pretty SHA3_256 = pretty "SHA3-256"
    pretty SHA3_512 = pretty "SHA3-512"
    pretty (OtherHA ha) = pretty "unknown hash algorithm type" <+> pretty ha

$(ATH.deriveJSON ATH.defaultOptions ''HashAlgorithm)

data CompressionAlgorithm
    = Uncompressed
    | ZIP
    | ZLIB
    | BZip2
    | OtherCA Word8
    deriving (Data, Generic, Show, Typeable)

instance Eq CompressionAlgorithm where
    (==) a b = fromFVal a == fromFVal b

instance Ord CompressionAlgorithm where
    compare = comparing fromFVal

instance FutureVal CompressionAlgorithm where
    fromFVal Uncompressed = 0
    fromFVal ZIP = 1
    fromFVal ZLIB = 2
    fromFVal BZip2 = 3
    fromFVal (OtherCA o) = o
    toFVal 0 = Uncompressed
    toFVal 1 = ZIP
    toFVal 2 = ZLIB
    toFVal 3 = BZip2
    toFVal o = OtherCA o

instance Hashable CompressionAlgorithm

instance Pretty CompressionAlgorithm where
    pretty Uncompressed = pretty "uncompressed"
    pretty ZIP = pretty "ZIP"
    pretty ZLIB = pretty "zlib"
    pretty BZip2 = pretty "bzip2"
    pretty (OtherCA ca) =
        pretty "unknown compression algorithm type" <+> pretty ca

$(ATH.deriveJSON ATH.defaultOptions ''CompressionAlgorithm)

data AEADAlgorithm
    = EAX
    | OCB
    | GCM
    | OtherAEADAlgo Word8
    deriving (Data, Generic, Show, Typeable)

instance Eq AEADAlgorithm where
    (==) a b = fromFVal a == fromFVal b

instance Ord AEADAlgorithm where
    compare = comparing fromFVal

instance FutureVal AEADAlgorithm where
    fromFVal EAX = 1
    fromFVal OCB = 2
    fromFVal GCM = 3
    fromFVal (OtherAEADAlgo o) = o
    toFVal 1 = EAX
    toFVal 2 = OCB
    toFVal 3 = GCM
    toFVal o = OtherAEADAlgo o

instance Hashable AEADAlgorithm

instance Pretty AEADAlgorithm where
    pretty EAX = pretty "EAX"
    pretty OCB = pretty "OCB"
    pretty GCM = pretty "GCM"
    pretty (OtherAEADAlgo aa) = pretty "unknown AEAD algorithm type" <+> pretty aa

$(ATH.deriveJSON ATH.defaultOptions ''AEADAlgorithm)

data KSPFlag
    = NoModify
    | KSPOther Int
    deriving (Data, Generic, Show, Typeable)

instance Eq KSPFlag where
    (==) a b = fromFFlag a == fromFFlag b

instance Ord KSPFlag where
    compare = comparing fromFFlag

instance FutureFlag KSPFlag where
    fromFFlag NoModify = 0
    fromFFlag (KSPOther i) = fromIntegral i
    toFFlag 0 = NoModify
    toFFlag i = KSPOther (fromIntegral i)

instance Hashable KSPFlag

instance Pretty KSPFlag where
    pretty NoModify = pretty "no-modify"
    pretty (KSPOther o) =
        pretty "unknown keyserver preference flag type" <+> pretty o

$(ATH.deriveJSON ATH.defaultOptions ''KSPFlag)

data KeyFlag
    = GroupKey
    | AuthKey
    | SplitKey
    | EncryptStorageKey
    | EncryptCommunicationsKey
    | SignDataKey
    | CertifyKeysKey
    | KFOther Int
    deriving (Data, Generic, Show, Typeable)

instance Eq KeyFlag where
    (==) a b = fromFFlag a == fromFFlag b

instance Ord KeyFlag where
    compare = comparing fromFFlag

instance FutureFlag KeyFlag where
    fromFFlag GroupKey = 0
    fromFFlag AuthKey = 2
    fromFFlag SplitKey = 3
    fromFFlag EncryptStorageKey = 4
    fromFFlag EncryptCommunicationsKey = 5
    fromFFlag SignDataKey = 6
    fromFFlag CertifyKeysKey = 7
    fromFFlag (KFOther i) = fromIntegral i
    toFFlag 0 = GroupKey
    toFFlag 2 = AuthKey
    toFFlag 3 = SplitKey
    toFFlag 4 = EncryptStorageKey
    toFFlag 5 = EncryptCommunicationsKey
    toFFlag 6 = SignDataKey
    toFFlag 7 = CertifyKeysKey
    toFFlag i = KFOther (fromIntegral i)

instance Hashable KeyFlag

instance Pretty KeyFlag where
    pretty GroupKey = pretty "group"
    pretty AuthKey = pretty "auth"
    pretty SplitKey = pretty "split"
    pretty EncryptStorageKey = pretty "encrypt-storage"
    pretty EncryptCommunicationsKey = pretty "encrypt-communications"
    pretty SignDataKey = pretty "sign-data"
    pretty CertifyKeysKey = pretty "certify-keys"
    pretty (KFOther o) = pretty "unknown key flag type" <+> pretty o

$(ATH.deriveJSON ATH.defaultOptions ''KeyFlag)

data RevocationCode
    = NoReason
    | KeySuperseded
    | KeyMaterialCompromised
    | KeyRetiredAndNoLongerUsed
    | UserIdInfoNoLongerValid
    | RCoOther Word8
    deriving (Data, Generic, Show, Typeable)

instance Eq RevocationCode where
    (==) a b = fromFVal a == fromFVal b

instance Ord RevocationCode where
    compare = comparing fromFVal

instance FutureVal RevocationCode where
    fromFVal NoReason = 0
    fromFVal KeySuperseded = 1
    fromFVal KeyMaterialCompromised = 2
    fromFVal KeyRetiredAndNoLongerUsed = 3
    fromFVal UserIdInfoNoLongerValid = 32
    fromFVal (RCoOther o) = o
    toFVal 0 = NoReason
    toFVal 1 = KeySuperseded
    toFVal 2 = KeyMaterialCompromised
    toFVal 3 = KeyRetiredAndNoLongerUsed
    toFVal 32 = UserIdInfoNoLongerValid
    toFVal o = RCoOther o

instance Hashable RevocationCode

instance Pretty RevocationCode where
    pretty NoReason = pretty "no reason"
    pretty KeySuperseded = pretty "key superseded"
    pretty KeyMaterialCompromised = pretty "key material compromised"
    pretty KeyRetiredAndNoLongerUsed = pretty "key retired and no longer used"
    pretty UserIdInfoNoLongerValid = pretty "user-ID info no longer valid"
    pretty (RCoOther o) = pretty "unknown revocation code" <+> pretty o

$(ATH.deriveJSON ATH.defaultOptions ''RevocationCode)

data FeatureFlag
    = FeatureSEIPDv1
    | FeatureSEIPDv2
    | FeatureOther Int
    deriving (Data, Generic, Show, Typeable)

instance Eq FeatureFlag where
    (==) a b = fromFFlag a == fromFFlag b

instance Ord FeatureFlag where
    compare = comparing fromFFlag

instance FutureFlag FeatureFlag where
    fromFFlag FeatureSEIPDv1 = 7
    fromFFlag FeatureSEIPDv2 = 4
    fromFFlag (FeatureOther i) = fromIntegral i
    toFFlag 7 = FeatureSEIPDv1
    toFFlag 4 = FeatureSEIPDv2
    toFFlag i = FeatureOther (fromIntegral i)

instance Hashable FeatureFlag

instance Pretty FeatureFlag where
    pretty FeatureSEIPDv1 = pretty "seipd-v1"
    pretty FeatureSEIPDv2 = pretty "seipd-v2"
    pretty (FeatureOther o) = pretty "unknown feature flag type" <+> pretty o

$(ATH.deriveJSON ATH.defaultOptions ''FeatureFlag)

newtype URL
    = URL
    { unURL :: URI
    }
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Wrapped URL

instance Hashable URL where
    hashWithSalt salt (URL (URI s a p q f)) =
        salt
            `hashWithSalt` s
            `hashWithSalt` show a
            `hashWithSalt` p
            `hashWithSalt` q
            `hashWithSalt` f

instance Pretty URL where
    pretty = pretty . (\uri -> uriToString id uri "") . op URL

instance A.ToJSON URL where
    toJSON u =
        object
            [ AK.fromString "uri" .= (\uri -> uriToString id uri "") (op URL u)
            ]

instance A.FromJSON URL where
    parseJSON (A.Object v) =
        URL . fromMaybe nullURI . parseURI <$> v A..: AK.fromString "uri"
    parseJSON _ = mzero

data SigType
    = BinarySig
    | CanonicalTextSig
    | StandaloneSig
    | GenericCert
    | PersonaCert
    | CasualCert
    | PositiveCert
    | SubkeyBindingSig
    | PrimaryKeyBindingSig
    | SignatureDirectlyOnAKey
    | KeyRevocationSig
    | SubkeyRevocationSig
    | CertRevocationSig
    | TimestampSig
    | ThirdPartyConfirmationSig
    | OtherSig Word8
    deriving (Data, Generic, Show, Typeable)

instance Eq SigType where
    (==) a b = fromFVal a == fromFVal b

instance Ord SigType where
    compare = comparing fromFVal

instance FutureVal SigType where
    fromFVal BinarySig = 0x00
    fromFVal CanonicalTextSig = 0x01
    fromFVal StandaloneSig = 0x02
    fromFVal GenericCert = 0x10
    fromFVal PersonaCert = 0x11
    fromFVal CasualCert = 0x12
    fromFVal PositiveCert = 0x13
    fromFVal SubkeyBindingSig = 0x18
    fromFVal PrimaryKeyBindingSig = 0x19
    fromFVal SignatureDirectlyOnAKey = 0x1F
    fromFVal KeyRevocationSig = 0x20
    fromFVal SubkeyRevocationSig = 0x28
    fromFVal CertRevocationSig = 0x30
    fromFVal TimestampSig = 0x40
    fromFVal ThirdPartyConfirmationSig = 0x50
    fromFVal (OtherSig o) = o
    toFVal 0x00 = BinarySig
    toFVal 0x01 = CanonicalTextSig
    toFVal 0x02 = StandaloneSig
    toFVal 0x10 = GenericCert
    toFVal 0x11 = PersonaCert
    toFVal 0x12 = CasualCert
    toFVal 0x13 = PositiveCert
    toFVal 0x18 = SubkeyBindingSig
    toFVal 0x19 = PrimaryKeyBindingSig
    toFVal 0x1F = SignatureDirectlyOnAKey
    toFVal 0x20 = KeyRevocationSig
    toFVal 0x28 = SubkeyRevocationSig
    toFVal 0x30 = CertRevocationSig
    toFVal 0x40 = TimestampSig
    toFVal 0x50 = ThirdPartyConfirmationSig
    toFVal o = OtherSig o

instance Hashable SigType

instance Pretty SigType where
    pretty BinarySig = pretty "binary"
    pretty CanonicalTextSig = pretty "canonical-pretty"
    pretty StandaloneSig = pretty "standalone"
    pretty GenericCert = pretty "generic"
    pretty PersonaCert = pretty "persona"
    pretty CasualCert = pretty "casual"
    pretty PositiveCert = pretty "positive"
    pretty SubkeyBindingSig = pretty "subkey-binding"
    pretty PrimaryKeyBindingSig = pretty "primary-key-binding"
    pretty SignatureDirectlyOnAKey = pretty "signature directly on a key"
    pretty KeyRevocationSig = pretty "key-revocation"
    pretty SubkeyRevocationSig = pretty "subkey-revocation"
    pretty CertRevocationSig = pretty "cert-revocation"
    pretty TimestampSig = pretty "timestamp"
    pretty ThirdPartyConfirmationSig = pretty "third-party-confirmation"
    pretty (OtherSig o) = pretty "unknown signature type" <+> pretty o

$(ATH.deriveJSON ATH.defaultOptions ''SigType)

newtype MPI
    = MPI
    { unMPI :: Integer
    }
    deriving (Data, Eq, Generic, Show, Typeable)

instance Wrapped MPI

instance Ord MPI where
    compare (MPI a) (MPI b) = compare a b

instance Hashable MPI

instance Pretty MPI where
    pretty = pretty . op MPI

$(ATH.deriveJSON ATH.defaultOptions ''MPI)

newtype SignatureSalt
    = SignatureSalt
    { unSignatureSalt :: ByteString
    }
    deriving (Data, Eq, Generic, Show, Typeable)

instance Ord SignatureSalt where
    compare (SignatureSalt a) (SignatureSalt b) = compare a b

instance Hashable SignatureSalt

instance Pretty SignatureSalt where
    pretty (SignatureSalt bs) = prettyLBS bs

instance A.ToJSON SignatureSalt where
    toJSON (SignatureSalt bs) = A.toJSON (BL.unpack bs)

data SignaturePayloadVersion
    = SigPayloadV3
    | SigPayloadV4
    | SigPayloadV6
    | SigPayloadVOther
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Hashable SignaturePayloadVersion

data SignaturePayloadV (v :: SignaturePayloadVersion) where
    SigPayloadV3Data
        :: SigType
        -> ThirtyTwoBitTimeStamp
        -> EightOctetKeyId
        -> PubKeyAlgorithm
        -> HashAlgorithm
        -> Word16
        -> NonEmpty MPI
        -> SignaturePayloadV 'SigPayloadV3
    SigPayloadV4Data
        :: SigType
        -> PubKeyAlgorithm
        -> HashAlgorithm
        -> [SigSubPacket]
        -> [SigSubPacket]
        -> Word16
        -> NonEmpty MPI
        -> SignaturePayloadV 'SigPayloadV4
    SigPayloadV6Data
        :: SigType
        -> PubKeyAlgorithm
        -> HashAlgorithm
        -> SignatureSalt
        -> [SigSubPacket]
        -> [SigSubPacket]
        -> Word16
        -> NonEmpty MPI
        -> SignaturePayloadV 'SigPayloadV6
    SigPayloadOtherData
        :: Word8 -> ByteString -> SignaturePayloadV 'SigPayloadVOther

deriving instance Eq (SignaturePayloadV v)

deriving instance Show (SignaturePayloadV v)

data SomeSignaturePayload where
    SomeSignaturePayload
        :: SignaturePayloadV v -> SomeSignaturePayload

-- FIXME: these functions belong in a separate module
toSignaturePayload :: SignaturePayloadV v -> SignaturePayload
toSignaturePayload (SigPayloadV3Data st ts eoki pka ha w16 mpis) =
    SigV3 st ts eoki pka ha w16 mpis
toSignaturePayload (SigPayloadV4Data st pka ha hsps usps w16 mpis) =
    SigV4 st pka ha hsps usps w16 mpis
toSignaturePayload (SigPayloadV6Data st pka ha salt hsps usps w16 mpis) =
    SigV6 st pka ha salt hsps usps w16 mpis
toSignaturePayload (SigPayloadOtherData v bs) = SigVOther v bs

toSomeSignaturePayload
    :: SignaturePayload -> SomeSignaturePayload
toSomeSignaturePayload (SigV3 st ts eoki pka ha w16 mpis) =
    SomeSignaturePayload
        (SigPayloadV3Data st ts eoki pka ha w16 mpis)
toSomeSignaturePayload (SigV4 st pka ha hsps usps w16 mpis) =
    SomeSignaturePayload
        (SigPayloadV4Data st pka ha hsps usps w16 mpis)
toSomeSignaturePayload (SigV6 st pka ha salt hsps usps w16 mpis) =
    SomeSignaturePayload
        (SigPayloadV6Data st pka ha salt hsps usps w16 mpis)
toSomeSignaturePayload (SigVOther v bs) =
    SomeSignaturePayload (SigPayloadOtherData v bs)

signaturePayloadVersion
    :: SignaturePayload -> SignaturePayloadVersion
signaturePayloadVersion (SigV3 _ _ _ _ _ _ _) = SigPayloadV3
signaturePayloadVersion (SigV4 _ _ _ _ _ _ _) = SigPayloadV4
signaturePayloadVersion (SigV6 _ _ _ _ _ _ _ _) = SigPayloadV6
signaturePayloadVersion (SigVOther _ _) = SigPayloadVOther

asSignaturePayloadV3
    :: SignaturePayload
    -> Either String (SignaturePayloadV 'SigPayloadV3)
asSignaturePayloadV3 (SigV3 st ts eoki pka ha w16 mpis) =
    Right (SigPayloadV3Data st ts eoki pka ha w16 mpis)
asSignaturePayloadV3 _ =
    Left
        "Cannot coerce non-v3 SignaturePayload to SignaturePayloadV3"

asSignaturePayloadV4
    :: SignaturePayload
    -> Either String (SignaturePayloadV 'SigPayloadV4)
asSignaturePayloadV4 (SigV4 st pka ha hsps usps w16 mpis) =
    Right (SigPayloadV4Data st pka ha hsps usps w16 mpis)
asSignaturePayloadV4 _ =
    Left
        "Cannot coerce non-v4 SignaturePayload to SignaturePayloadV4"

asSignaturePayloadV6
    :: SignaturePayload
    -> Either String (SignaturePayloadV 'SigPayloadV6)
asSignaturePayloadV6 (SigV6 st pka ha salt hsps usps w16 mpis) =
    Right (SigPayloadV6Data st pka ha salt hsps usps w16 mpis)
asSignaturePayloadV6 _ =
    Left
        "Cannot coerce non-v6 SignaturePayload to SignaturePayloadV6"

asSignaturePayloadOther
    :: SignaturePayload
    -> Either String (SignaturePayloadV 'SigPayloadVOther)
asSignaturePayloadOther (SigVOther v bs) = Right (SigPayloadOtherData v bs)
asSignaturePayloadOther _ =
    Left
        "Cannot coerce known-version SignaturePayload to SignaturePayloadVOther"

data SignaturePayload
    = SigV3
        SigType
        ThirtyTwoBitTimeStamp
        EightOctetKeyId
        PubKeyAlgorithm
        HashAlgorithm
        Word16
        (NonEmpty MPI)
    | SigV4
        SigType
        PubKeyAlgorithm
        HashAlgorithm
        [SigSubPacket]
        [SigSubPacket]
        Word16
        (NonEmpty MPI)
    | SigV6
        SigType
        PubKeyAlgorithm
        HashAlgorithm
        SignatureSalt
        [SigSubPacket]
        [SigSubPacket]
        Word16
        (NonEmpty MPI)
    | SigVOther Word8 ByteString
    deriving (Data, Eq, Generic, Show, Typeable)

instance Hashable SignaturePayload

instance Ord SignaturePayload where
    compare (SigV3 st1 ts1 eoki1 pka1 ha1 w161 mpis1) (SigV3 st2 ts2 eoki2 pka2 ha2 w162 mpis2) =
        compare st1 st2
            <> compare ts1 ts2
            <> compare eoki1 eoki2
            <> compare pka1 pka2
            <> compare ha1 ha2
            <> compare w161 w162
            <> compare (NE.toList mpis1) (NE.toList mpis2)
    compare (SigV4 st1 pka1 ha1 hsp1 usp1 w161 mpis1) (SigV4 st2 pka2 ha2 hsp2 usp2 w162 mpis2) =
        compare st1 st2
            <> compare pka1 pka2
            <> compare ha1 ha2
            <> compare hsp1 hsp2
            <> compare usp1 usp2
            <> compare w161 w162
            <> compare (NE.toList mpis1) (NE.toList mpis2)
    compare (SigV6 st1 pka1 ha1 salt1 hsp1 usp1 w161 mpis1) (SigV6 st2 pka2 ha2 salt2 hsp2 usp2 w162 mpis2) =
        compare st1 st2
            <> compare pka1 pka2
            <> compare ha1 ha2
            <> compare salt1 salt2
            <> compare hsp1 hsp2
            <> compare usp1 usp2
            <> compare w161 w162
            <> compare (NE.toList mpis1) (NE.toList mpis2)
    compare (SigVOther t1 bs1) (SigVOther t2 bs2) =
        compare t1 t2 <> compare bs1 bs2
    compare SigV3 {} SigV4 {} = LT
    compare SigV3 {} SigV6 {} = LT
    compare SigV3 {} SigVOther {} = LT
    compare SigV4 {} SigV3 {} = GT
    compare SigV4 {} SigV6 {} = LT
    compare SigV4 {} SigVOther {} = LT
    compare SigV6 {} SigV3 {} = GT
    compare SigV6 {} SigV4 {} = GT
    compare SigV6 {} SigVOther {} = LT
    compare SigVOther {} SigV3 {} = GT
    compare SigVOther {} SigV4 {} = GT
    compare SigVOther {} SigV6 {} = GT

instance Pretty SignaturePayload where
    pretty (SigV3 st ts eoki pka ha w16 mpis) =
        pretty "signature v3"
            <> pretty ':'
            <+> pretty st
            <+> pretty ts
            <+> pretty eoki
            <+> pretty pka
            <+> pretty ha
            <+> pretty w16
            <+> (pretty . NE.toList) mpis
    pretty (SigV4 st pka ha hsps usps w16 mpis) =
        pretty "signature v4"
            <> pretty ':'
            <+> pretty st
            <+> pretty pka
            <+> pretty ha
            <+> pretty hsps
            <+> pretty usps
            <+> pretty w16
            <+> (pretty . NE.toList) mpis
    pretty (SigV6 st pka ha salt hsps usps w16 mpis) =
        pretty "signature v6"
            <> pretty ':'
            <+> pretty st
            <+> pretty pka
            <+> pretty ha
            <+> pretty salt
            <+> pretty hsps
            <+> pretty usps
            <+> pretty w16
            <+> (pretty . NE.toList) mpis
    pretty (SigVOther t bs) =
        pretty "unknown signature v"
            <> pretty t
            <> pretty ':'
            <+> pretty (BL.unpack bs)

instance A.ToJSON SignaturePayload where
    toJSON (SigV3 st ts eoki pka ha w16 mpis) =
        A.toJSON (st, ts, eoki, pka, ha, w16, NE.toList mpis)
    toJSON (SigV4 st pka ha hsps usps w16 mpis) =
        A.toJSON (st, pka, ha, hsps, usps, w16, NE.toList mpis)
    toJSON (SigV6 st pka ha salt hsps usps w16 mpis) =
        A.toJSON (st, pka, ha, salt, hsps, usps, w16, NE.toList mpis)
    toJSON (SigVOther t bs) = A.toJSON (t, BL.unpack bs)

data IssuerFingerprintVersion
    = IssuerFingerprintV4
    | IssuerFingerprintV6
    deriving (Data, Eq, Generic, Show, Typeable)

instance Ord IssuerFingerprintVersion where
    IssuerFingerprintV4 `compare` IssuerFingerprintV4 = EQ
    IssuerFingerprintV4 `compare` IssuerFingerprintV6 = LT
    IssuerFingerprintV6 `compare` IssuerFingerprintV4 = GT
    IssuerFingerprintV6 `compare` IssuerFingerprintV6 = EQ

instance Hashable IssuerFingerprintVersion

instance Pretty IssuerFingerprintVersion where
    pretty IssuerFingerprintV4 = pretty "4"
    pretty IssuerFingerprintV6 = pretty "6"

instance A.ToJSON IssuerFingerprintVersion where
    toJSON IssuerFingerprintV4 = A.toJSON (4 :: Word8)
    toJSON IssuerFingerprintV6 = A.toJSON (6 :: Word8)

instance A.FromJSON IssuerFingerprintVersion where
    parseJSON (A.Number n) =
        case round n of
            4 -> pure IssuerFingerprintV4
            6 -> pure IssuerFingerprintV6
            _ -> mzero
    parseJSON _ = mzero

-- FIXME: these functions should be in a separate module
issuerFingerprintVersionToPacketVersion
    :: IssuerFingerprintVersion -> PacketVersion
issuerFingerprintVersionToPacketVersion IssuerFingerprintV4 = 4
issuerFingerprintVersionToPacketVersion IssuerFingerprintV6 = 6

packetVersionToIssuerFingerprintVersion
    :: PacketVersion -> Maybe IssuerFingerprintVersion
packetVersionToIssuerFingerprintVersion 4 = Just IssuerFingerprintV4
packetVersionToIssuerFingerprintVersion 6 = Just IssuerFingerprintV6
packetVersionToIssuerFingerprintVersion _ = Nothing

data SigSubPacketPayload
    = SigCreationTime ThirtyTwoBitTimeStamp
    | SigExpirationTime ThirtyTwoBitDuration
    | ExportableCertification Exportability
    | TrustSignature TrustLevel TrustAmount
    | RegularExpression AlmostPublicDomainRegex
    | Revocable Revocability
    | KeyExpirationTime ThirtyTwoBitDuration
    | PreferredSymmetricAlgorithms [SymmetricAlgorithm]
    | RevocationKey (Set RevocationClass) PubKeyAlgorithm Fingerprint
    | Issuer EightOctetKeyId
    | NotationData (Set NotationFlag) NotationName NotationValue
    | PreferredHashAlgorithms [HashAlgorithm]
    | PreferredCompressionAlgorithms [CompressionAlgorithm]
    | KeyServerPreferences (Set KSPFlag)
    | PreferredKeyServer KeyServer
    | PrimaryUserId Bool
    | PolicyURL URL
    | KeyFlags (Set KeyFlag)
    | SignersUserId Text
    | ReasonForRevocation RevocationCode RevocationReason
    | Features (Set FeatureFlag)
    | SignatureTarget PubKeyAlgorithm HashAlgorithm SignatureHash
    | EmbeddedSignature SignaturePayload
    | IssuerFingerprint IssuerFingerprintVersion Fingerprint
    | IntendedRecipient IssuerFingerprintVersion Fingerprint
    | PreferredAEADCiphersuites [(SymmetricAlgorithm, AEADAlgorithm)]
    | UserDefinedSigSub Word8 ByteString
    | OtherSigSub Word8 ByteString
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Hashable SigSubPacketPayload

instance Pretty SigSubPacketPayload where
    pretty (SigCreationTime ts) = pretty "creation-time" <+> pretty ts
    pretty (SigExpirationTime d) = pretty "sig expiration time" <+> pretty d
    pretty (ExportableCertification e) =
        pretty "exportable certification" <+> pretty e
    pretty (TrustSignature tl ta) =
        pretty "trust signature" <+> pretty tl <+> pretty ta
    pretty (RegularExpression apdre) =
        pretty "regular expression" <+> prettyLBS apdre
    pretty (Revocable r) = pretty "revocable" <+> pretty r
    pretty (KeyExpirationTime d) = pretty "key expiration time" <+> pretty d
    pretty (PreferredSymmetricAlgorithms sas) =
        pretty "preferred symmetric algorithms" <+> pretty sas
    pretty (IntendedRecipient kv fp) =
        pretty "intended recipient (v"
            <> pretty kv
            <> pretty ")"
            <+> pretty fp
    pretty (RevocationKey rcs pka tof) =
        pretty "revocation key"
            <+> pretty (Set.toList rcs)
            <+> pretty pka
            <+> pretty tof
    pretty (Issuer eoki) = pretty "issuer" <+> pretty eoki
    pretty (NotationData nfs nn nv) =
        pretty "notation data"
            <+> pretty (Set.toList nfs)
            <+> pretty nn
            <+> pretty nv
    pretty (PreferredHashAlgorithms phas) =
        pretty "preferred hash algorithms" <+> pretty phas
    pretty (PreferredCompressionAlgorithms pcas) =
        pretty "preferred compression algorithms" <+> pretty pcas
    pretty (KeyServerPreferences kspfs) =
        pretty "keyserver preferences" <+> pretty (Set.toList kspfs)
    pretty (PreferredKeyServer ks) = pretty "preferred keyserver" <+> prettyLBS ks
    pretty (PrimaryUserId p) =
        ( if p
            then mempty
            else pretty "NOT "
        )
            <> pretty "primary user-ID"
    pretty (PolicyURL u) = pretty "policy URL" <+> pretty u
    pretty (KeyFlags kfs) = pretty "key flags" <+> pretty (Set.toList kfs)
    pretty (SignersUserId u) = pretty "signer's user-ID" <+> pretty u
    pretty (ReasonForRevocation rc rr) =
        pretty "reason for revocation" <+> pretty rc <+> pretty rr
    pretty (Features ffs) = pretty "features" <+> pretty (Set.toList ffs)
    pretty (SignatureTarget pka ha sh) =
        pretty "signature target"
            <+> pretty pka
            <+> pretty ha
            <+> prettyLBS sh
    pretty (EmbeddedSignature sp) = pretty "embedded signature" <+> pretty sp
    pretty (IssuerFingerprint kv ifp) =
        pretty "issuer fingerprint (v"
            <> pretty kv
            <> pretty ")"
            <+> pretty ifp
    pretty (PreferredAEADCiphersuites ps) =
        pretty "preferred AEAD ciphersuites"
            <+> pretty ps
    pretty (UserDefinedSigSub t bs) =
        pretty "user-defined signature subpacket type"
            <+> pretty t
            <+> pretty (BL.unpack bs)
    pretty (OtherSigSub t bs) =
        pretty "unknown signature subpacket type"
            <+> pretty t
            <+> prettyLBS bs

instance A.ToJSON SigSubPacketPayload where
    toJSON (SigCreationTime ts) = object [AK.fromString "sigCreationTime" .= ts]
    toJSON (SigExpirationTime d) = object [AK.fromString "sigExpirationTime" .= d]
    toJSON (ExportableCertification e) =
        object [AK.fromString "exportableCertification" .= e]
    toJSON (TrustSignature tl ta) =
        object [AK.fromString "trustSignature" .= (tl, ta)]
    toJSON (RegularExpression apdre) =
        object [AK.fromString "regularExpression" .= BL.unpack apdre]
    toJSON (Revocable r) = object [AK.fromString "revocable" .= r]
    toJSON (KeyExpirationTime d) = object [AK.fromString "keyExpirationTime" .= d]
    toJSON (PreferredSymmetricAlgorithms sas) =
        object [AK.fromString "preferredSymmetricAlgorithms" .= sas]
    toJSON (RevocationKey rcs pka tof) =
        object [AK.fromString "revocationKey" .= (rcs, pka, tof)]
    toJSON (Issuer eoki) = object [AK.fromString "issuer" .= eoki]
    toJSON (NotationData nfs (NotationName nn) (NotationValue nv)) =
        object
            [ AK.fromString "notationData" .= (nfs, BL.unpack nn, BL.unpack nv)
            ]
    toJSON (PreferredHashAlgorithms phas) =
        object [AK.fromString "preferredHashAlgorithms" .= phas]
    toJSON (PreferredCompressionAlgorithms pcas) =
        object [AK.fromString "preferredCompressionAlgorithms" .= pcas]
    toJSON (KeyServerPreferences kspfs) =
        object [AK.fromString "keyServerPreferences" .= kspfs]
    toJSON (PreferredKeyServer ks) =
        object [AK.fromString "preferredKeyServer" .= show ks]
    toJSON (PrimaryUserId p) = object [AK.fromString "primaryUserId" .= p]
    toJSON (PolicyURL u) = object [AK.fromString "policyURL" .= u]
    toJSON (KeyFlags kfs) = object [AK.fromString "keyFlags" .= kfs]
    toJSON (SignersUserId u) = object [AK.fromString "signersUserId" .= u]
    toJSON (ReasonForRevocation rc rr) =
        object [AK.fromString "reasonForRevocation" .= (rc, rr)]
    toJSON (Features ffs) = object [AK.fromString "features" .= ffs]
    toJSON (SignatureTarget pka ha sh) =
        object
            [AK.fromString "signatureTarget" .= (pka, ha, BL.unpack sh)]
    toJSON (EmbeddedSignature sp) =
        object [AK.fromString "embeddedSignature" .= sp]
    toJSON (IssuerFingerprint kv ifp) =
        object [AK.fromString "issuerFingerprint" .= (kv, ifp)]
    toJSON (IntendedRecipient kv ifp) =
        object [AK.fromString "intendedRecipient" .= (kv, ifp)]
    toJSON (PreferredAEADCiphersuites ps) =
        object [AK.fromString "preferredAEADCiphersuites" .= ps]
    toJSON (UserDefinedSigSub t bs) =
        object [AK.fromString "userDefinedSigSub" .= (t, BL.unpack bs)]
    toJSON (OtherSigSub t bs) =
        object [AK.fromString "otherSigSub" .= (t, BL.unpack bs)]

uc3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uc3 f ~(a, b, c) = f a b c

instance A.FromJSON SigSubPacketPayload where
    parseJSON (A.Object v) =
        (SigCreationTime <$> v A..: AK.fromString "sigCreationTime")
            <|> (SigExpirationTime <$> v A..: AK.fromString "sigExpirationTime")
            <|> ( ExportableCertification
                    <$> v A..: AK.fromString "exportableCertification"
                )
            <|> (uncurry TrustSignature <$> v A..: AK.fromString "trustSignature")
            <|> ( RegularExpression . BL.pack
                    <$> v A..: AK.fromString "regularExpression"
                )
            <|> (Revocable <$> v A..: AK.fromString "revocable")
            <|> (KeyExpirationTime <$> v A..: AK.fromString "keyExpirationTime")
            <|> ( PreferredSymmetricAlgorithms
                    <$> v A..: AK.fromString "preferredSymmetricAlgorithms"
                )
            <|> (uc3 RevocationKey <$> v A..: AK.fromString "revocationKey")
            <|> (Issuer <$> v A..: AK.fromString "issuer")
            <|> (uc3 NotationData <$> v A..: AK.fromString "notationData")
            <|> ( uncurry IssuerFingerprint
                    <$> v A..: AK.fromString "issuerFingerprint"
                )
            <|> ( uncurry IntendedRecipient
                    <$> v A..: AK.fromString "intendedRecipient"
                )
            <|> ( PreferredAEADCiphersuites
                    <$> v A..: AK.fromString "preferredAEADCiphersuites"
                )
    parseJSON _ = mzero

data SigSubPacket
    = SigSubPacket
    { _sspCriticality :: Bool
    , _sspPayload :: SigSubPacketPayload
    }
    deriving (Data, Eq, Generic, Show, Typeable)

instance Ord SigSubPacket where
    compare (SigSubPacket crit1 payload1) (SigSubPacket crit2 payload2) =
        compare crit1 crit2 <> compare payload1 payload2

instance Pretty SigSubPacket where
    pretty x =
        ( if _sspCriticality x
            then pretty '*'
            else mempty
        )
            <> (pretty . _sspPayload) x

instance Hashable SigSubPacket

instance A.ToJSON SigSubPacket

instance A.FromJSON SigSubPacket

$(makeLenses ''SigSubPacket)

$(makePrisms ''SignaturePayload)

-- FIXME: the SubpacketList type and associated functions should be moved into a separate module

{- | Type-safe subpacket list with phantom types to distinguish hashed vs unhashed
and signature version constraints (v4 vs v6).
-}
newtype SubpacketList (hashedness :: Type) (version :: Type)
    = SubpacketList [SigSubPacket]
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Functor (SubpacketList h) where
    fmap _ (SubpacketList sps) = SubpacketList sps

-- | Extract the underlying list from a phantom-typed SubpacketList
fromSubpacketList :: SubpacketList h v -> [SigSubPacket]
fromSubpacketList (SubpacketList sps) = sps

-- | Wrap a plain list into a phantom-typed SubpacketList
toSubpacketList :: [SigSubPacket] -> SubpacketList h v
toSubpacketList = SubpacketList

-- | Create an empty hashed subpacket list for a given signature version
emptyHashedSubpackets :: SubpacketList Hashed v
emptyHashedSubpackets = SubpacketList []

-- | Create an empty unhashed subpacket list for a given signature version
emptyUnhashedSubpackets :: SubpacketList Unhashed v
emptyUnhashedSubpackets = SubpacketList []

-- | Append a subpacket to a hashed list, preserving phantom type
consHashedSubpacket
    :: SigSubPacket -> SubpacketList Hashed v -> SubpacketList Hashed v
consHashedSubpacket sp (SubpacketList sps) = SubpacketList (sp : sps)

-- | Append a subpacket to an unhashed list, preserving phantom type
consUnhashedSubpacket
    :: SigSubPacket
    -> SubpacketList Unhashed v
    -> SubpacketList Unhashed v
consUnhashedSubpacket sp (SubpacketList sps) = SubpacketList (sp : sps)

data KeyVersion
    = DeprecatedV3
    | V4
    | V6
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Hashable KeyVersion

instance Pretty KeyVersion where
    pretty DeprecatedV3 = pretty "(deprecated) v3"
    pretty V4 = pretty "v4"
    pretty V6 = pretty "v6"

$(ATH.deriveJSON ATH.defaultOptions ''KeyVersion)

newtype IV
    = IV
    { unIV :: B.ByteString
    }
    deriving
        ( ByteArrayAccess
        , Data
        , Eq
        , Generic
        , Hashable
        , Monoid
        , Semigroup
        , Show
        , Typeable
        )

instance Wrapped IV

instance Ord IV where
    compare (IV b1) (IV b2) = compare b1 b2

instance Pretty IV where
    pretty = pretty . ("iv:" ++) . bsToHexUpper . BL.fromStrict . op IV

instance A.ToJSON IV where
    toJSON = A.toJSON . show . op IV

data LiteralDataType
    = BinaryData
    | TextData
    | UTF8Data
    | OtherData Word8
    deriving (Data, Generic, Show, Typeable)

instance Hashable LiteralDataType

instance Eq LiteralDataType where
    (==) a b = fromFVal a == fromFVal b

instance Ord LiteralDataType where
    compare = comparing fromFVal

instance FutureVal LiteralDataType where
    fromFVal BinaryData = fromIntegral . fromEnum $ 'b'
    fromFVal TextData = fromIntegral . fromEnum $ 't'
    fromFVal UTF8Data = fromIntegral . fromEnum $ 'u'
    fromFVal (OtherData o) = o
    toFVal 0x62 = BinaryData
    toFVal 0x74 = TextData
    toFVal 0x75 = UTF8Data
    toFVal o = OtherData o

instance Pretty LiteralDataType where
    pretty BinaryData = pretty "binary"
    pretty TextData = pretty "text"
    pretty UTF8Data = pretty "UTF-8"
    pretty (OtherData o) = pretty "other data type " <+> pretty o

$(ATH.deriveJSON ATH.defaultOptions ''LiteralDataType)

newtype SessionKey
    = SessionKey
    { unSessionKey :: B.ByteString
    }
    deriving (Data, Eq, Generic, Hashable, Show, Typeable)

instance Wrapped SessionKey

instance Ord SessionKey where
    compare (SessionKey b1) (SessionKey b2) = compare b1 b2

newtype Salt
    = Salt
    { unSalt :: B.ByteString
    }
    deriving (Data, Eq, Generic, Hashable, Show, Typeable)

instance Wrapped Salt

instance Ord Salt where
    compare (Salt b1) (Salt b2) = compare b1 b2

instance Pretty Salt where
    pretty = pretty . ("salt:" ++) . bsToHexUpper . BL.fromStrict . op Salt

instance A.ToJSON Salt where
    toJSON = A.toJSON . show . op Salt

newtype Salt8
    = Salt8
    { unSalt8 :: B.ByteString
    }
    deriving (Data, Eq, Generic, Hashable, Show, Typeable)

instance Wrapped Salt8

instance Ord Salt8 where
    compare (Salt8 b1) (Salt8 b2) = compare b1 b2

instance Pretty Salt8 where
    pretty =
        pretty . ("salt8:" ++) . bsToHexUpper . BL.fromStrict . op Salt8

instance A.ToJSON Salt8 where
    toJSON = A.toJSON . show . op Salt8

newtype Salt16
    = Salt16
    { unSalt16 :: B.ByteString
    }
    deriving (Data, Eq, Generic, Hashable, Show, Typeable)

instance Wrapped Salt16

instance Ord Salt16 where
    compare (Salt16 b1) (Salt16 b2) = compare b1 b2

instance Pretty Salt16 where
    pretty =
        pretty
            . ("salt16:" ++)
            . bsToHexUpper
            . BL.fromStrict
            . op Salt16

instance A.ToJSON Salt16 where
    toJSON = A.toJSON . show . op Salt16

-- FIXME: these functions should be in a separate module
salt8FromSalt :: Salt -> Maybe Salt8
salt8FromSalt (Salt bs)
    | B.length bs == 8 = Just (Salt8 bs)
    | otherwise = Nothing

salt16FromSalt :: Salt -> Maybe Salt16
salt16FromSalt (Salt bs)
    | B.length bs == 16 = Just (Salt16 bs)
    | otherwise = Nothing

saltFromSalt8 :: Salt8 -> Salt
saltFromSalt8 (Salt8 bs) = Salt bs

saltFromSalt16 :: Salt16 -> Salt
saltFromSalt16 (Salt16 bs) = Salt bs

newtype IterationCount
    = IterationCount
    { unIterationCount :: Int
    }
    deriving
        ( Bounded
        , Data
        , Enum
        , Eq
        , Generic
        , Hashable
        , Integral
        , Num
        , Ord
        , Real
        , Show
        , Typeable
        )

instance Wrapped IterationCount

instance Pretty IterationCount where
    pretty = pretty . op IterationCount

$(ATH.deriveJSON ATH.defaultOptions ''IterationCount)

data S2K
    = Simple HashAlgorithm
    | Salted HashAlgorithm Salt8
    | IteratedSalted HashAlgorithm Salt8 IterationCount
    | Argon2 Salt16 Word8 Word8 Word8
    | OtherS2K Word8 ByteString
    deriving (Data, Eq, Generic, Show, Typeable)

instance Hashable S2K

instance Ord S2K where
    compare (Simple ha1) (Simple ha2) = compare ha1 ha2
    compare (Salted ha1 s1) (Salted ha2 s2) = compare ha1 ha2 <> compare s1 s2
    compare (IteratedSalted ha1 s1 ic1) (IteratedSalted ha2 s2 ic2) =
        compare ha1 ha2 <> compare s1 s2 <> compare ic1 ic2
    compare (Argon2 salt1 t1 p1 em1) (Argon2 salt2 t2 p2 em2) =
        compare salt1 salt2
            <> compare t1 t2
            <> compare p1 p2
            <> compare em1 em2
    compare (OtherS2K t1 bs1) (OtherS2K t2 bs2) = compare t1 t2 <> compare bs1 bs2
    compare Simple {} Salted {} = LT
    compare Simple {} IteratedSalted {} = LT
    compare Simple {} Argon2 {} = LT
    compare Simple {} OtherS2K {} = LT
    compare Salted {} Simple {} = GT
    compare Salted {} IteratedSalted {} = LT
    compare Salted {} Argon2 {} = LT
    compare Salted {} OtherS2K {} = LT
    compare IteratedSalted {} Simple {} = GT
    compare IteratedSalted {} Salted {} = GT
    compare IteratedSalted {} Argon2 {} = LT
    compare IteratedSalted {} OtherS2K {} = LT
    compare Argon2 {} Simple {} = GT
    compare Argon2 {} Salted {} = GT
    compare Argon2 {} IteratedSalted {} = GT
    compare Argon2 {} OtherS2K {} = LT
    compare OtherS2K {} _ = GT

instance Pretty S2K where
    pretty (Simple ha) = pretty "simple S2K," <+> pretty ha
    pretty (Salted ha salt) = pretty "salted S2K," <+> pretty ha <+> pretty salt
    pretty (IteratedSalted ha salt icount) =
        pretty "iterated-salted S2K,"
            <+> pretty ha
            <+> pretty salt
            <+> pretty icount
    pretty (Argon2 salt t p em) =
        pretty "Argon2 S2K,"
            <+> pretty salt
            <+> pretty t
            <+> pretty p
            <+> pretty em
    pretty (OtherS2K t bs) =
        pretty "unknown S2K type"
            <+> pretty t
            <+> pretty (bsToHexUpper bs)

instance A.ToJSON S2K where
    toJSON (Simple ha) = A.toJSON ha
    toJSON (Salted ha salt) = A.toJSON (ha, salt)
    toJSON (IteratedSalted ha salt icount) = A.toJSON (ha, salt, icount)
    toJSON (Argon2 salt t p em) = A.toJSON (salt, t, p, em)
    toJSON (OtherS2K t bs) = A.toJSON (t, BL.unpack bs)

data ImageFormat
    = JPEG
    | OtherImage Word8
    deriving (Data, Generic, Show, Typeable)

instance Eq ImageFormat where
    (==) a b = fromFVal a == fromFVal b

instance Ord ImageFormat where
    compare = comparing fromFVal

instance FutureVal ImageFormat where
    fromFVal JPEG = 1
    fromFVal (OtherImage o) = o
    toFVal 1 = JPEG
    toFVal o = OtherImage o

instance Hashable ImageFormat

instance Pretty ImageFormat where
    pretty JPEG = pretty "JPEG"
    pretty (OtherImage o) = pretty "unknown image format" <+> pretty o

$(ATH.deriveJSON ATH.defaultOptions ''ImageFormat)

newtype ImageHeader
    = ImageHV1 ImageFormat
    deriving (Data, Eq, Generic, Show, Typeable)

instance Ord ImageHeader where
    compare (ImageHV1 a) (ImageHV1 b) = compare a b

instance Hashable ImageHeader

instance Pretty ImageHeader where
    pretty (ImageHV1 f) = pretty "imghdr v1" <+> pretty f

$(ATH.deriveJSON ATH.defaultOptions ''ImageHeader)

data UserAttrSubPacket
    = ImageAttribute ImageHeader ImageData
    | OtherUASub Word8 ByteString
    deriving (Data, Eq, Generic, Show, Typeable)

instance Hashable UserAttrSubPacket

instance Ord UserAttrSubPacket where
    compare (ImageAttribute h1 d1) (ImageAttribute h2 d2) =
        compare h1 h2 <> compare d1 d2
    compare (ImageAttribute _ _) (OtherUASub _ _) = LT
    compare (OtherUASub _ _) (ImageAttribute _ _) = GT
    compare (OtherUASub t1 b1) (OtherUASub t2 b2) = compare t1 t2 <> compare b1 b2

instance Pretty UserAttrSubPacket where
    pretty (ImageAttribute ih d) =
        pretty "image-attribute" <+> pretty ih <+> pretty (BL.unpack d)
    pretty (OtherUASub t bs) =
        pretty "unknown attribute type"
            <> pretty t
            <+> pretty (BL.unpack bs)

instance A.ToJSON UserAttrSubPacket where
    toJSON (ImageAttribute ih d) = A.toJSON (ih, BL.unpack d)
    toJSON (OtherUASub t bs) = A.toJSON (t, BL.unpack bs)

-- FIXME: should this be merged with EdSigningCurve somehow?
data ECCCurve
    = NISTP256
    | NISTP384
    | NISTP521
    | Curve25519
    | Curve448
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Pretty ECCCurve where
    pretty NISTP256 = pretty "NIST P-256"
    pretty NISTP384 = pretty "NIST P-384"
    pretty NISTP521 = pretty "NIST P-521"
    pretty Curve25519 = pretty "Curve25519"
    pretty Curve448 = pretty "Curve448"

instance Hashable ECCCurve

-- Packet stream wrapper used to provide an EOF-delimited Binary instance.
newtype Block a
    = Block
    { unBlock :: [a]
    } -- intentionally not encoded as a list length prefix
    deriving (Eq, Show)

newtype Passphrase = Passphrase {unPassphrase :: BL.ByteString}
    deriving (Eq, Ord, Show)
