-- Base.hs: OpenPGP (RFC4880) data types
-- Copyright © 2012-2016  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE CPP #-}
{-# 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)

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Applicative ((<|>))
import Control.Arrow ((***))
import Control.Lens (makeLenses)
import Control.Monad (mzero)
import Control.Newtype (Newtype(..))
import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import Data.Aeson ((.=), object)
import qualified Data.Aeson as A
import Data.Byteable (Byteable)
import Data.ByteArray (ByteArrayAccess)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Char (toLower, toUpper)
import Data.Data (Data)
import Data.Hashable (Hashable(..))
import Data.IxSet.Typed (IxSet)
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)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid, mempty)
#endif
import Data.Monoid ((<>))
import Data.Ord (comparing)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Time.Format (formatTime)
import Data.Typeable (Typeable)
import Data.Word (Word8, Word16, Word32)
import Network.URI (URI(..), uriToString, nullURI, parseURI)
import Numeric (readHex, showHex)
import Data.Time.Locale.Compat (defaultTimeLocale)
import Text.PrettyPrint.Free (Pretty(..), (<+>), char, hsep, punctuate, space, text, tupled)

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

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 = text "plaintext"
    pretty IDEA = text "IDEA"
    pretty TripleDES = text "3DES"
    pretty CAST5 = text "CAST-128"
    pretty Blowfish = text "Blowfish"
    pretty ReservedSAFER = text "(reserved) SAFER"
    pretty ReservedDES = text "(reserved) DES"
    pretty AES128 = text "AES-128"
    pretty AES192 = text "AES-192"
    pretty AES256 = text "AES-256"
    pretty Twofish = text "Twofish"
    pretty Camellia128 = text "Camellia-128"
    pretty Camellia192 = text "Camellia-192"
    pretty Camellia256 = text "Camellia-256"
    pretty (OtherSA sa) = text "unknown symmetric algorithm" <+> (text . show) sa

instance A.ToJSON SymmetricAlgorithm
instance A.FromJSON 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 = text "human-readable"
    pretty (OtherNF o) = text "unknown notation flag type" <+> pretty o

instance A.ToJSON NotationFlag
instance A.FromJSON NotationFlag

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

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

instance Hashable SigSubPacket

instance A.ToJSON SigSubPacket
instance A.FromJSON SigSubPacket

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 = text . formatTime defaultTimeLocale "%Y%m%d-%H%M%S" . posixSecondsToUTCTime . realToFrac

instance A.ToJSON ThirtyTwoBitTimeStamp
instance A.FromJSON ThirtyTwoBitTimeStamp

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 = text . concat . unfoldr durU . unpack

instance A.ToJSON ThirtyTwoBitDuration
instance A.FromJSON ThirtyTwoBitDuration

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

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

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

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 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
                  | UserDefinedSigSub Word8 ByteString
                  | OtherSigSub Word8 ByteString
    deriving (Data, Eq, Generic, Show, Typeable) -- FIXME

instance Hashable SigSubPacketPayload

instance Pretty SigSubPacketPayload where
    pretty (SigCreationTime ts) = text "creation-time" <+> pretty ts
    pretty (SigExpirationTime d) = text "sig expiration time" <+> pretty d
    pretty (ExportableCertification e) = text "exportable certification" <+> pretty e
    pretty (TrustSignature tl ta) = text "trust signature" <+> pretty tl <+> pretty ta
    pretty (RegularExpression apdre) = text "regular expression" <+> pretty apdre
    pretty (Revocable r) = text "revocable" <+> pretty r
    pretty (KeyExpirationTime d) = text "key expiration time" <+> pretty d
    pretty (PreferredSymmetricAlgorithms sas) = text "preferred symmetric algorithms" <+> prettyList sas
    pretty (RevocationKey rcs pka tof) = text "revocation key" <+> prettyList (Set.toList rcs) <+> pretty pka <+> pretty tof
    pretty (Issuer eoki) = text "issuer" <+> pretty eoki
    pretty (NotationData nfs nn nv) = text "notation data" <+> prettyList (Set.toList nfs) <+> pretty nn <+> pretty nv
    pretty (PreferredHashAlgorithms phas) = text "preferred hash algorithms" <+> prettyList phas
    pretty (PreferredCompressionAlgorithms pcas) = text "preferred compression algorithms" <+> pretty pcas
    pretty (KeyServerPreferences kspfs) = text "keyserver preferences" <+> prettyList (Set.toList kspfs)
    pretty (PreferredKeyServer ks) = text "preferred keyserver" <+> pretty ks
    pretty (PrimaryUserId p) = (if p then mempty else text "NOT ") <> text "primary user-ID"
    pretty (PolicyURL u) = text "policy URL" <+> pretty u
    pretty (KeyFlags kfs) = text "key flags" <+> prettyList (Set.toList kfs)
    pretty (SignersUserId u) = text "signer's user-ID" <+> pretty u
    pretty (ReasonForRevocation rc rr) = text "reason for revocation" <+> pretty rc <+> pretty rr
    pretty (Features ffs) = text "features" <+> prettyList (Set.toList ffs)
    pretty (SignatureTarget pka ha sh) = text "signature target" <+> pretty pka <+> pretty ha <+> pretty sh
    pretty (EmbeddedSignature sp) = text "embedded signature" <+> pretty sp
    pretty (UserDefinedSigSub t bs) = text "user-defined signature subpacket type" <+> pretty t <+> pretty (BL.unpack bs)
    pretty (OtherSigSub t bs) = text "unknown signature subpacket type" <+> pretty t <+> pretty 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 (UserDefinedSigSub t bs) = object [T.pack "userDefinedSigSub" .= (t, BL.unpack bs)]
    toJSON (OtherSigSub t bs) = object [T.pack "otherSigSub" .= (t, BL.unpack bs)]

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

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

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 = text "(deprecated) MD5"
    pretty SHA1 = text "SHA-1"
    pretty RIPEMD160 = text "RIPEMD-160"
    pretty SHA256 = text "SHA-256"
    pretty SHA384 = text "SHA-384"
    pretty SHA512 = text "SHA-512"
    pretty SHA224 = text "SHA-224"
    pretty (OtherHA ha) = text "unknown hash algorithm type" <+> (text . show) ha

instance A.ToJSON HashAlgorithm
instance A.FromJSON 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 = text "uncompressed"
    pretty ZIP = text "ZIP"
    pretty ZLIB = text "zlib"
    pretty BZip2 = text "bzip2"
    pretty (OtherCA ca) = text "unknown compression algorithm type" <+> (text . show) ca

instance A.ToJSON CompressionAlgorithm
instance A.FromJSON CompressionAlgorithm

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

data PubKeyAlgorithm = RSA
                     | DeprecatedRSAEncryptOnly
                     | DeprecatedRSASignOnly
                     | ElgamalEncryptOnly
                     | DSA
                     | ECDH
                     | ECDSA
                     | ForbiddenElgamal
                     | DH
                     | 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 (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 o = OtherPKA o

instance Hashable PubKeyAlgorithm

instance Pretty PubKeyAlgorithm where
    pretty RSA = text "RSA"
    pretty DeprecatedRSAEncryptOnly = text "(deprecated) RSA encrypt-only"
    pretty DeprecatedRSASignOnly = text "(deprecated) RSA sign-only"
    pretty ElgamalEncryptOnly = text "Elgamal encrypt-only"
    pretty DSA = text "DSA"
    pretty ECDH = text "ECDH"
    pretty ECDSA = text "ECDSA"
    pretty ForbiddenElgamal = text "(forbidden) Elgamal"
    pretty DH = text "DH"
    pretty pka = text "unknown pubkey algorithm type" <+> (text . show) pka

instance A.ToJSON PubKeyAlgorithm
instance A.FromJSON PubKeyAlgorithm

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

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 = text "no-modify"
    pretty (KSPOther o) = text "unknown keyserver preference flag type" <+> pretty o

instance A.ToJSON KSPFlag
instance A.FromJSON 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 = text "group"
    pretty AuthKey = text "auth"
    pretty SplitKey = text "split"
    pretty EncryptStorageKey = text "encrypt-storage"
    pretty EncryptCommunicationsKey = text "encrypt-communications"
    pretty SignDataKey = text "sign-data"
    pretty CertifyKeysKey = text "certify-keys"
    pretty (KFOther o) = text "unknown key flag type" <+> pretty o

instance A.ToJSON KeyFlag
instance A.FromJSON KeyFlag

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 = text "sensitive"
    pretty (RClOther o) = text "unknown revocation class" <+> pretty o

instance A.ToJSON RevocationClass
instance A.FromJSON RevocationClass

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 = text "no reason"
    pretty KeySuperseded = text "key superseded"
    pretty KeyMaterialCompromised = text "key material compromised"
    pretty KeyRetiredAndNoLongerUsed = text "key retired and no longer used"
    pretty UserIdInfoNoLongerValid = text "user-ID info no longer valid"
    pretty (RCoOther o) = text "unknown revocation code" <+> pretty o

instance A.ToJSON RevocationCode
instance A.FromJSON 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 = text "modification-detection"
    pretty (FeatureOther o) = text "unknown feature flag type" <+> pretty o

instance A.ToJSON FeatureFlag
instance A.FromJSON FeatureFlag

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

instance A.ToJSON MPI
instance A.FromJSON 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) = text "signature v3" <> char ':' <+> pretty st <+> pretty ts <+> pretty eoki <+> pretty pka <+> pretty ha <+> pretty w16 <+> (prettyList . NE.toList) mpis
    pretty (SigV4 st pka ha hsps usps w16 mpis) = text "signature v4" <> char ':' <+> pretty st <+> pretty pka <+> pretty ha <+> prettyList hsps <+> prettyList usps <+> pretty w16 <+> (prettyList . NE.toList) mpis
    pretty (SigVOther t bs) = text "unknown signature v" <> pretty t <> char ':' <+> 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 KeyVersion = DeprecatedV3 | V4
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Hashable KeyVersion

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

instance A.ToJSON KeyVersion
instance A.FromJSON KeyVersion

data PKPayload = PKPayload {
      _keyVersion :: KeyVersion
    , _timestamp :: ThirtyTwoBitTimeStamp
    , _v3exp :: V3Expiration
    , _pkalgo :: PubKeyAlgorithm
    , _pubkey :: PKey
    } deriving (Data, Eq, Generic, Show, Typeable)

instance Ord PKPayload where
    compare = comparing _keyVersion <> comparing _timestamp <> comparing _v3exp <> comparing _pkalgo <> comparing _pubkey

instance Hashable PKPayload

instance Pretty PKPayload where
    pretty (PKPayload kv ts v3e pka p) = pretty kv <+> pretty ts <+> pretty v3e <+> pretty pka <+> pretty p

instance A.ToJSON PKPayload

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

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

instance Pretty IV where
    pretty = pretty . unpack

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

data SKAddendum = SUS16bit SymmetricAlgorithm S2K IV ByteString
                | SUSSHA1 SymmetricAlgorithm S2K IV ByteString
                | SUSym SymmetricAlgorithm IV ByteString
                | SUUnencrypted SKey Word16
    deriving (Data, Eq, Generic, Show, Typeable)

instance Ord SKAddendum where
    compare a b = show a `compare` show b -- FIXME: this is ridiculous

instance Hashable SKAddendum

instance Pretty SKAddendum where
    pretty (SUS16bit sa s2k iv bs) = text "SUS16bit" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty bs
    pretty (SUSSHA1 sa s2k iv bs) = text "SUSSHA1" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty bs
    pretty (SUSym sa iv bs) = text "SUSym" <+> pretty sa <+> pretty iv <+> pretty bs
    pretty (SUUnencrypted s ck) = text "SUUnencrypted" <+> pretty s <+> pretty ck

instance A.ToJSON SKAddendum where
    toJSON (SUS16bit sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs)
    toJSON (SUSSHA1 sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs)
    toJSON (SUSym sa iv bs) = A.toJSON (sa, iv, BL.unpack bs)
    toJSON (SUUnencrypted s ck) = A.toJSON (s, ck)

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 = text "binary"
    pretty TextData = text "text"
    pretty UTF8Data = text "UTF-8"
    pretty (OtherData o) = text "other data type " <+> (text . show) o

instance A.ToJSON DataType
instance A.FromJSON DataType

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

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

instance Pretty Salt where
    pretty = pretty . 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

instance A.ToJSON IterationCount
instance A.FromJSON 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) = text "simple S2K," <+> pretty ha
    pretty (Salted ha salt) = text "simple S2K," <+> pretty ha <+> pretty salt
    pretty (IteratedSalted ha salt icount) = text "simple S2K," <+> pretty ha <+> pretty salt <+> pretty icount
    pretty (OtherS2K t bs) = text "unknown S2K type" <+> pretty t <+> pretty 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 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) = text "image-attribute" <+> pretty ih <+> pretty (BL.unpack d)
    pretty (OtherUASub t bs) = text "unknown attribute type" <> (text . show) 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 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) = text "imghdr v1" <+> pretty f

instance A.ToJSON ImageHeader
instance A.FromJSON ImageHeader

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 = text "JPEG"
    pretty (OtherImage o) = text "unknown image format" <+> pretty o

instance A.ToJSON ImageFormat
instance A.FromJSON ImageFormat

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

instance A.ToJSON SigType
instance A.FromJSON SigType

newtype DSA_PublicKey = DSA_PublicKey {unDSA_PublicKey :: DSA.PublicKey}
    deriving (Data, Eq, Generic, Show, Typeable)
instance Ord DSA_PublicKey
instance A.ToJSON DSA_PublicKey where
    toJSON (DSA_PublicKey (DSA.PublicKey p y)) = A.toJSON (DSA_Params p, y)
instance Pretty DSA_PublicKey where
    pretty (DSA_PublicKey (DSA.PublicKey p y)) = pretty (DSA_Params p) <+> pretty y
newtype RSA_PublicKey = RSA_PublicKey {unRSA_PublicKey :: RSA.PublicKey}
    deriving (Data, Eq, Generic, Show, Typeable)
instance Ord RSA_PublicKey
instance A.ToJSON RSA_PublicKey where
    toJSON (RSA_PublicKey (RSA.PublicKey size n e)) = A.toJSON (size, n, e)
instance Pretty RSA_PublicKey where
    pretty (RSA_PublicKey (RSA.PublicKey size n e)) = pretty size <+> pretty n <+> pretty e
newtype ECDSA_PublicKey = ECDSA_PublicKey {unECDSA_PublicKey :: ECDSA.PublicKey}
    deriving (Data, Eq, Generic, Show, Typeable)
instance Ord ECDSA_PublicKey
instance A.ToJSON ECDSA_PublicKey where
    toJSON (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = A.toJSON (show curve, show q)
instance Pretty ECDSA_PublicKey where
    pretty (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = pretty (show curve, show q)
newtype DSA_PrivateKey = DSA_PrivateKey {unDSA_PrivateKey :: DSA.PrivateKey}
    deriving (Data, Eq, Generic, Show, Typeable)
instance Ord DSA_PrivateKey
instance A.ToJSON DSA_PrivateKey where
    toJSON (DSA_PrivateKey (DSA.PrivateKey p x)) = A.toJSON (DSA_Params p, x)
instance Pretty DSA_PrivateKey where
    pretty (DSA_PrivateKey (DSA.PrivateKey p x)) = pretty (DSA_Params p, x)
newtype RSA_PrivateKey = RSA_PrivateKey {unRSA_PrivateKey :: RSA.PrivateKey}
    deriving (Data, Eq, Generic, Show, Typeable)
instance Ord RSA_PrivateKey
instance A.ToJSON RSA_PrivateKey where
    toJSON (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) = A.toJSON (RSA_PublicKey pub, d, p, q, dP, dQ, qinv)
instance Pretty RSA_PrivateKey where
    pretty (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) = pretty (RSA_PublicKey pub) <+> tupled (map pretty [d, p, q, dP, dQ, qinv])
newtype ECDSA_PrivateKey = ECDSA_PrivateKey {unECDSA_PrivateKey :: ECDSA.PrivateKey}
    deriving (Data, Eq, Generic, Show, Typeable)
instance Ord ECDSA_PrivateKey
instance A.ToJSON ECDSA_PrivateKey where
    toJSON (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = A.toJSON (show curve, show d)
instance Pretty ECDSA_PrivateKey where
    pretty (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = pretty (show curve, show d)

newtype DSA_Params = DSA_Params {unDSA_Params :: DSA.Params}
    deriving (Data, Eq, Generic, Show, Typeable)
instance A.ToJSON DSA_Params where
    toJSON (DSA_Params (DSA.Params p g q)) = A.toJSON (p, g, q)
instance Pretty DSA_Params where
    pretty (DSA_Params (DSA.Params p g q)) = pretty (p, g, q)
instance Hashable DSA_Params where
    hashWithSalt s (DSA_Params (DSA.Params p g q)) = s `hashWithSalt` p `hashWithSalt` g `hashWithSalt` q
instance Hashable DSA_PublicKey where
    hashWithSalt s (DSA_PublicKey (DSA.PublicKey p y)) = s `hashWithSalt` DSA_Params p `hashWithSalt` y
instance Hashable DSA_PrivateKey where
    hashWithSalt s (DSA_PrivateKey (DSA.PrivateKey p x)) = s `hashWithSalt` DSA_Params p `hashWithSalt` x
instance Hashable RSA_PublicKey where
    hashWithSalt s (RSA_PublicKey (RSA.PublicKey size n e)) = s `hashWithSalt` size `hashWithSalt` n `hashWithSalt` e
instance Hashable RSA_PrivateKey where
    hashWithSalt s (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) = s `hashWithSalt` RSA_PublicKey pub `hashWithSalt` d `hashWithSalt` p `hashWithSalt` q `hashWithSalt` dP `hashWithSalt` dQ `hashWithSalt` qinv
instance Hashable ECDSA_PublicKey where
    hashWithSalt s (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = s `hashWithSalt` show curve `hashWithSalt` show q   -- FIXME: don't use show
instance Hashable ECDSA_PrivateKey where
    hashWithSalt s (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = s `hashWithSalt` show curve `hashWithSalt` show d  -- FIXME: don't use show

data ECCCurve = BrokenNISTP256
              | BrokenNISTP384
              | BrokenNISTP521
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Hashable ECCCurve

data PKey = RSAPubKey RSA_PublicKey
          | DSAPubKey DSA_PublicKey
          | ElGamalPubKey [Integer]
          | ECDHPubKey ECDSA_PublicKey HashAlgorithm SymmetricAlgorithm
          | ECDSAPubKey ECDSA_PublicKey
          | UnknownPKey ByteString
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Hashable PKey

instance Pretty PKey where
    pretty (RSAPubKey p) = text "RSA" <+> pretty p
    pretty (DSAPubKey p) = text "DSA" <+> pretty p
    pretty (ElGamalPubKey p) = text "Elgamal" <+> pretty p
    pretty (ECDHPubKey p ha sa) = text "ECDH" <+> pretty p <+> pretty ha <+> pretty sa
    pretty (ECDSAPubKey p) = text "ECDSA" <+> pretty p
    pretty (UnknownPKey bs) = text "unknown" <+> pretty bs

instance A.ToJSON PKey where
    toJSON (RSAPubKey p) = A.toJSON p
    toJSON (DSAPubKey p) = A.toJSON p
    toJSON (ElGamalPubKey p) = A.toJSON p
    toJSON (ECDHPubKey p ha sa) = A.toJSON (p, ha, sa)
    toJSON (ECDSAPubKey p) = A.toJSON p
    toJSON (UnknownPKey bs) = A.toJSON (BL.unpack bs)

data SKey = RSAPrivateKey RSA_PrivateKey
          | DSAPrivateKey DSA_PrivateKey
          | ElGamalPrivateKey [Integer]
          | ECDHPrivateKey ECDSA_PrivateKey
          | ECDSAPrivateKey ECDSA_PrivateKey
          | UnknownSKey ByteString
    deriving (Data, Eq, Generic, Show, Typeable)

instance Hashable SKey

instance Pretty SKey where
    pretty (RSAPrivateKey p) = text "RSA" <+> pretty p
    pretty (DSAPrivateKey p) = text "DSA" <+> pretty p
    pretty (ElGamalPrivateKey p) = text "Elgamal" <+> pretty p
    pretty (ECDHPrivateKey p) = text "ECDH" <+> pretty p
    pretty (ECDSAPrivateKey p) = text "ECDSA" <+> pretty p
    pretty (UnknownSKey bs) = text "unknown" <+> pretty bs

instance A.ToJSON SKey where
    toJSON (RSAPrivateKey k) = A.toJSON k
    toJSON (DSAPrivateKey k) = A.toJSON k
    toJSON (ElGamalPrivateKey k) = A.toJSON k
    toJSON (ECDHPrivateKey k) = A.toJSON k
    toJSON (ECDSAPrivateKey k) = A.toJSON k
    toJSON (UnknownSKey bs) = A.toJSON (BL.unpack bs)

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

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 = text . w8sToHex . BL.unpack . 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" .= (w8sToHex . BL.unpack . unpack) e]

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

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 = text . take 40 . w8sToHex . BL.unpack . 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 text . chunksOf 4 . take 40 . w8sToHex . BL.unpack . unTOF . unpack

w8sToHex :: [Word8] -> String
w8sToHex = map toUpper . concatMap ((\x -> if length x == 1 then '0':x else x) . flip showHex "")

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

data TK = TK {
    _tkKey  :: (PKPayload, Maybe SKAddendum)
  , _tkRevs :: [SignaturePayload]
  , _tkUIDs :: [(Text, [SignaturePayload])]
  , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])]
  , _tkSubs :: [(Pkt, [SignaturePayload])]
  } deriving (Data, Eq, Generic, Show, Typeable)

instance Ord TK where
    compare = comparing _tkKey -- FIXME: is this ridiculous?

instance A.ToJSON TK

type KeyringIxs = '[EightOctetKeyId, TwentyOctetFingerprint, Text]
type Keyring = IxSet KeyringIxs TK

-- data Pkt = forall a. (Packet a, Show a, Eq a) => Pkt a
data Pkt = PKESKPkt PacketVersion EightOctetKeyId PubKeyAlgorithm (NonEmpty MPI)
         | SignaturePkt SignaturePayload
         | SKESKPkt PacketVersion SymmetricAlgorithm S2K (Maybe BL.ByteString)
         | OnePassSignaturePkt PacketVersion SigType HashAlgorithm PubKeyAlgorithm EightOctetKeyId NestedFlag
         | SecretKeyPkt PKPayload SKAddendum
         | PublicKeyPkt PKPayload
         | SecretSubkeyPkt PKPayload SKAddendum
         | CompressedDataPkt CompressionAlgorithm CompressedDataPayload
         | SymEncDataPkt ByteString
         | MarkerPkt ByteString
         | LiteralDataPkt DataType FileName ThirtyTwoBitTimeStamp ByteString
         | TrustPkt ByteString
         | UserIdPkt Text
         | PublicSubkeyPkt PKPayload
         | UserAttributePkt [UserAttrSubPacket]
         | SymEncIntegrityProtectedDataPkt PacketVersion ByteString
         | ModificationDetectionCodePkt ByteString
         | OtherPacketPkt Word8 ByteString
         | BrokenPacketPkt String Word8 ByteString
    deriving (Data, Eq, Generic, Show, Typeable) -- FIXME

instance Hashable Pkt

instance Ord Pkt where
    compare = comparing pktTag <> comparing hash -- FIXME: is there something saner?

instance Pretty Pkt where
    pretty (PKESKPkt pv eoki pka mpis) = text "PKESK v" <> (text . show) pv <> char ':' <+> pretty eoki <+> pretty pka <+> (prettyList . NE.toList) mpis
    pretty (SignaturePkt sp) = pretty sp
    pretty (SKESKPkt pv sa s2k mbs) = text "SKESK v" <> (text . show) pv <> char ':' <+> pretty sa <+> pretty s2k <+> pretty mbs
    pretty (OnePassSignaturePkt pv st ha pka eoki nestedflag) = text "one-pass signature v" <> (text . show) pv <> char ':' <+> pretty st <+> pretty ha <+> pretty pka <+> pretty eoki <+> pretty nestedflag
    pretty (SecretKeyPkt pkp ska) = text "secret key:" <+> pretty pkp <+> pretty ska
    pretty (PublicKeyPkt pkp) = text "public key:" <+> pretty pkp
    pretty (SecretSubkeyPkt pkp ska) = text "secret subkey:" <+> pretty pkp <+> pretty ska
    pretty (CompressedDataPkt ca cdp) = text "compressed-data:" <+> pretty ca <+> pretty cdp
    pretty (SymEncDataPkt bs) = text "symmetrically-encrypted-data:" <+> pretty bs
    pretty (MarkerPkt bs) = text "marker:" <+> pretty bs
    pretty (LiteralDataPkt dt fn ts bs) = text "literal-data" <+> pretty dt <+> pretty fn <+> pretty ts <+> pretty bs
    pretty (TrustPkt bs) = text "trust:" <+> pretty (BL.unpack bs)
    pretty (UserIdPkt u) = text "user-ID:" <+> pretty u
    pretty (PublicSubkeyPkt pkp) = text "public subkey:" <+> pretty pkp
    pretty (UserAttributePkt us) = text "user-attribute:" <+> prettyList us
    pretty (SymEncIntegrityProtectedDataPkt pv bs) = text "symmetrically-encrypted-integrity-protected-data v" <> (text . show) pv <> char ':' <+> pretty bs
    pretty (ModificationDetectionCodePkt bs) = text "MDC:" <+> pretty bs
    pretty (OtherPacketPkt t bs) = text "unknown packet type" <+> pretty t <> char ':' <+> pretty bs
    pretty (BrokenPacketPkt s t bs) = text "BROKEN packet (" <> pretty s <> char ')' <+> pretty t <> char ':' <+> pretty bs

instance A.ToJSON Pkt where
    toJSON (PKESKPkt pv eoki pka mpis) = object [T.pack "pkesk" .= object [T.pack "version" .= pv, T.pack "keyid" .= eoki, T.pack "pkalgo" .= pka, T.pack "mpis" .= NE.toList mpis]]
    toJSON (SignaturePkt sp) = object [T.pack "signature" .= sp]
    toJSON (SKESKPkt pv sa s2k mbs) = object [T.pack "skesk" .= object [T.pack "version" .= pv, T.pack "symalgo" .= sa, T.pack "s2k" .= s2k, T.pack "data" .= maybe mempty BL.unpack mbs]]
    toJSON (OnePassSignaturePkt pv st ha pka eoki nestedflag) = object [T.pack "onepasssignature" .= object [T.pack "version" .= pv, T.pack "sigtype" .= st, T.pack "hashalgo" .= ha, T.pack "pkalgo" .= pka, T.pack "keyid" .= eoki, T.pack "nested" .= nestedflag]]
    toJSON (SecretKeyPkt pkp ska) = object [T.pack "secretkey" .= object [T.pack "public" .= pkp, T.pack "secret" .= ska]]
    toJSON (PublicKeyPkt pkp) = object [T.pack "publickey" .= pkp]
    toJSON (SecretSubkeyPkt pkp ska) = object [T.pack "secretsubkey" .= object [T.pack "public" .= pkp, T.pack "secret" .= ska]]
    toJSON (CompressedDataPkt ca cdp) = object [T.pack "compresseddata" .= object [T.pack "compressionalgo" .= ca, T.pack "data" .= BL.unpack cdp]]
    toJSON (SymEncDataPkt bs) = object [T.pack "symencdata" .= BL.unpack bs]
    toJSON (MarkerPkt bs) = object [T.pack "marker" .= BL.unpack bs]
    toJSON (LiteralDataPkt dt fn ts bs) = object [T.pack "literaldata" .= object [T.pack "dt" .= dt, T.pack "filename" .= BL.unpack fn, T.pack "ts" .= ts, T.pack "data" .= BL.unpack bs]]
    toJSON (TrustPkt bs) = object [T.pack "trust" .= BL.unpack bs]
    toJSON (UserIdPkt u) = object [T.pack "userid" .= u]
    toJSON (PublicSubkeyPkt pkp) = object [T.pack "publicsubkkey" .= pkp]
    toJSON (UserAttributePkt us) = object [T.pack "userattribute" .= us]
    toJSON (SymEncIntegrityProtectedDataPkt pv bs) = object [T.pack "symencipd" .= object [T.pack "version" .= pv, T.pack "data" .= BL.unpack bs]]
    toJSON (ModificationDetectionCodePkt bs) =  object [T.pack "mdc" .= BL.unpack bs]
    toJSON (OtherPacketPkt t bs) = object [T.pack "otherpacket" .= object [T.pack "tag" .= t, T.pack "data" .= BL.unpack bs]]
    toJSON (BrokenPacketPkt s t bs) = object [T.pack "brokenpacket" .= object [T.pack "error" .= s, T.pack "tag" .= t, T.pack "data" .= BL.unpack bs]]

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

data Verification = Verification {
      _verificationSigner :: PKPayload
    , _verificationSignature :: SignaturePayload
    }

$(makeLenses ''TK)
$(makeLenses ''Verification)
$(makeLenses ''SigSubPacket)