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

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

    import GHC.Generics (Generic)

    import Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils (prettyLBS)
    import Control.Applicative ((<|>))
    import Control.Arrow ((***))
    import Control.Lens (makeLenses)
    import Control.Monad (mzero)
    import Control.Newtype (Newtype(..))
    import Data.Aeson ((.=), object)
    import qualified Data.Aeson as A
    import qualified Data.Aeson.TH as ATH
    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.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.Monoid ((<>))
    import Data.Ord (comparing)
    import Data.Semigroup (Semigroup)
    import Data.Set (Set)
    import qualified Data.Set as Set
    import Data.Text (Text)
    import qualified Data.Text as T
    import Data.Text.Prettyprint.Doc (Pretty(..), (<+>), hsep, punctuate, space)
    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 Network.URI (URI(..), nullURI, parseURI, uriToString)
    import Numeric (readHex)

    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

    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 -- FIXME: this should be constrained to 4 bits?
      deriving (Data, Generic, Show, Typeable)

    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
      toFFlag 0 = HumanReadable
      toFFlag o = OtherNF (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 Newtype ThirtyTwoBitTimeStamp Word32 where
      pack = ThirtyTwoBitTimeStamp
      unpack (ThirtyTwoBitTimeStamp o) = o

    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 Newtype ThirtyTwoBitDuration Word32 where
      pack = ThirtyTwoBitDuration
      unpack (ThirtyTwoBitDuration o) = o

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

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

    data RevocationClass
      = SensitiveRK
      | RClOther Word8 -- FIXME: this should be constrained to 3 bits
      deriving (Data, Generic, Show, Typeable)

    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
      toFFlag 1 = SensitiveRK
      toFFlag i = RClOther (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
      | OtherPKA Word8
      deriving (Show, Data, Generic, 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 (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 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 (OtherPKA pka) = pretty "unknown pubkey algorithm type" <+> pretty pka

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

    newtype TwentyOctetFingerprint =
      TwentyOctetFingerprint
        { unTOF :: ByteString
        }
      deriving (Data, Eq, Generic, Ord, Show, Typeable)

    instance Newtype TwentyOctetFingerprint ByteString where
      pack = TwentyOctetFingerprint
      unpack (TwentyOctetFingerprint o) = o

    -- FIXME: read-show
    instance Read TwentyOctetFingerprint where
      readsPrec _ =
        map ((TwentyOctetFingerprint . BL.pack *** concat) . unzip) .
        chunksOf 20 . hexToW8s . filter (/= ' ')

    instance Hashable TwentyOctetFingerprint

    instance Pretty TwentyOctetFingerprint where
      pretty = pretty . take 40 . bsToHexUpper . unTOF

    instance A.ToJSON TwentyOctetFingerprint where
      toJSON e = object [T.pack "fpr" .= (A.toJSON . show . pretty) e]

    instance A.FromJSON TwentyOctetFingerprint where
      parseJSON (A.Object v) = TwentyOctetFingerprint . read <$> v A..: T.pack "fpr"
      parseJSON _ = mzero

    newtype SpacedFingerprint =
      SpacedFingerprint
        { unSpacedFingerprint :: TwentyOctetFingerprint
        }

    instance Newtype SpacedFingerprint TwentyOctetFingerprint where
      pack = SpacedFingerprint
      unpack (SpacedFingerprint o) = o

    instance Pretty SpacedFingerprint where
      pretty =
        hsep .
        punctuate space .
        map hsep .
        chunksOf 5 .
        map pretty . chunksOf 4 . take 40 . bsToHexUpper . unTOF . unpack

    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, Show, Typeable)

    instance Newtype EightOctetKeyId ByteString where
      pack = EightOctetKeyId
      unpack (EightOctetKeyId o) = o

    instance Pretty EightOctetKeyId where
      pretty = pretty . bsToHexUpper . unpack

    -- FIXME: read-show
    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 [T.pack "eoki" .= (bsToHexUpper . unpack) e]

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

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

    instance Pretty NotationName where
      pretty = prettyLBS . unNotationName

    instance Newtype NotationName ByteString where
      pack = NotationName
      unpack (NotationName nn) = nn

    instance A.ToJSON NotationName where
      toJSON nn = object [T.pack "notationname" .= show (unpack nn)]

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

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

    instance Pretty NotationValue where
      pretty = prettyLBS . unNotationValue

    instance Newtype NotationValue ByteString where
      pack = NotationValue
      unpack (NotationValue nv) = nv

    instance A.ToJSON NotationValue where
      toJSON nv = object [T.pack "notationvalue" .= show (unpack nv)]

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

    data HashAlgorithm
      = DeprecatedMD5
      | SHA1
      | RIPEMD160
      | SHA256
      | SHA384
      | SHA512
      | SHA224
      | 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 (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 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 (OtherHA ha) = pretty "unknown hash algorithm type" <+> pretty ha

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

    data CompressionAlgorithm
      = Uncompressed
      | ZIP
      | ZLIB
      | BZip2
      | OtherCA Word8
      deriving (Show, Data, Generic, 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 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
      = ModificationDetection
      | 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 ModificationDetection = 7
      fromFFlag (FeatureOther i) = fromIntegral i
      toFFlag 7 = ModificationDetection
      toFFlag i = FeatureOther (fromIntegral i)

    instance Hashable FeatureFlag

    instance Hashable a => Hashable (Set a) where
      hashWithSalt salt = hashWithSalt salt . Set.toList

    instance Pretty FeatureFlag where
      pretty ModificationDetection = pretty "modification-detection"
      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 Newtype URL URI where
      pack = URL
      unpack (URL o) = o

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

    instance A.ToJSON URL where
      toJSON u = object [T.pack "uri" .= (\uri -> uriToString id uri "") (unpack u)]

    instance A.FromJSON URL where
      parseJSON (A.Object v) =
        URL . fromMaybe nullURI . parseURI <$> v A..: T.pack "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 Newtype MPI Integer where
      pack = MPI
      unpack (MPI o) = o

    instance Hashable MPI

    instance Pretty MPI where
      pretty = pretty . unpack

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

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

    instance Hashable SignaturePayload

    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 (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 (SigVOther t bs) = A.toJSON (t, BL.unpack bs)

    data SigSubPacketPayload
      = SigCreationTime ThirtyTwoBitTimeStamp
      | SigExpirationTime ThirtyTwoBitDuration
      | ExportableCertification Exportability
      | TrustSignature TrustLevel TrustAmount
      | RegularExpression AlmostPublicDomainRegex
      | Revocable Revocability
      | KeyExpirationTime ThirtyTwoBitDuration
      | PreferredSymmetricAlgorithms [SymmetricAlgorithm]
      | RevocationKey (Set RevocationClass) PubKeyAlgorithm TwentyOctetFingerprint
      | 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 Word8 TwentyOctetFingerprint
      | UserDefinedSigSub Word8 ByteString
      | OtherSigSub Word8 ByteString
      deriving (Data, Eq, Generic, Show, Typeable) -- FIXME

    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 (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 (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 [T.pack "sigCreationTime" .= ts]
      toJSON (SigExpirationTime d) = object [T.pack "sigExpirationTime" .= d]
      toJSON (ExportableCertification e) =
        object [T.pack "exportableCertification" .= e]
      toJSON (TrustSignature tl ta) = object [T.pack "trustSignature" .= (tl, ta)]
      toJSON (RegularExpression apdre) =
        object [T.pack "regularExpression" .= BL.unpack apdre]
      toJSON (Revocable r) = object [T.pack "revocable" .= r]
      toJSON (KeyExpirationTime d) = object [T.pack "keyExpirationTime" .= d]
      toJSON (PreferredSymmetricAlgorithms sas) =
        object [T.pack "preferredSymmetricAlgorithms" .= sas]
      toJSON (RevocationKey rcs pka tof) =
        object [T.pack "revocationKey" .= (rcs, pka, tof)]
      toJSON (Issuer eoki) = object [T.pack "issuer" .= eoki]
      toJSON (NotationData nfs (NotationName nn) (NotationValue nv)) =
        object [T.pack "notationData" .= (nfs, BL.unpack nn, BL.unpack nv)]
      toJSON (PreferredHashAlgorithms phas) =
        object [T.pack "preferredHashAlgorithms" .= phas]
      toJSON (PreferredCompressionAlgorithms pcas) =
        object [T.pack "preferredCompressionAlgorithms" .= pcas]
      toJSON (KeyServerPreferences kspfs) =
        object [T.pack "keyServerPreferences" .= kspfs]
      toJSON (PreferredKeyServer ks) =
        object [T.pack "preferredKeyServer" .= show ks]
      toJSON (PrimaryUserId p) = object [T.pack "primaryUserId" .= p]
      toJSON (PolicyURL u) = object [T.pack "policyURL" .= u]
      toJSON (KeyFlags kfs) = object [T.pack "keyFlags" .= kfs]
      toJSON (SignersUserId u) = object [T.pack "signersUserId" .= u]
      toJSON (ReasonForRevocation rc rr) =
        object [T.pack "reasonForRevocation" .= (rc, rr)]
      toJSON (Features ffs) = object [T.pack "features" .= ffs]
      toJSON (SignatureTarget pka ha sh) =
        object [T.pack "signatureTarget" .= (pka, ha, BL.unpack sh)]
      toJSON (EmbeddedSignature sp) = object [T.pack "embeddedSignature" .= sp]
      toJSON (IssuerFingerprint kv ifp) =
        object [T.pack "issuerFingerprint" .= (kv, ifp)]
      toJSON (UserDefinedSigSub t bs) =
        object [T.pack "userDefinedSigSub" .= (t, BL.unpack bs)]
      toJSON (OtherSigSub t bs) = object [T.pack "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..: T.pack "sigCreationTime") <|>
        (SigExpirationTime <$> v A..: T.pack "sigExpirationTime") <|>
        (ExportableCertification <$> v A..: T.pack "exportableCertification") <|>
        (uncurry TrustSignature <$> v A..: T.pack "trustSignature") <|>
        (RegularExpression . BL.pack <$> v A..: T.pack "regularExpression") <|>
        (Revocable <$> v A..: T.pack "revocable") <|>
        (KeyExpirationTime <$> v A..: T.pack "keyExpirationTime") <|>
        (PreferredSymmetricAlgorithms <$>
         v A..: T.pack "preferredSymmetricAlgorithms") <|>
        (uc3 RevocationKey <$> v A..: T.pack "revocationKey") <|>
        (Issuer <$> v A..: T.pack "issuer") <|>
        (uc3 NotationData <$> v A..: T.pack "notationData")
      parseJSON _ = mzero

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

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

    instance Hashable SigSubPacket

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

    $(makeLenses ''SigSubPacket)

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

    instance Hashable KeyVersion

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

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

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

    instance Newtype IV B.ByteString where
      pack = IV
      unpack (IV o) = o

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

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

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

    instance Hashable DataType

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

    instance Ord DataType where
      compare = comparing fromFVal

    instance FutureVal DataType 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 DataType 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 ''DataType)

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

    instance Newtype Salt B.ByteString where
      pack = Salt
      unpack (Salt o) = o

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

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

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

    instance Newtype IterationCount Int where
      pack = IterationCount
      unpack (IterationCount o) = o

    instance Pretty IterationCount where
      pretty = pretty . unpack

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

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

    instance Hashable S2K

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

    data ECCCurve
      = NISTP256
      | NISTP384
      | NISTP521
      | Curve25519
      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"

    instance Hashable ECCCurve

    newtype Block a =
      Block
        { unBlock :: [a]
        } -- so we can override cereal instance
      deriving (Show, Eq)