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

{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TemplateHaskell, TypeFamilies #-}

module Codec.Encryption.OpenPGP.Types where

import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.DSA as DSA

import Control.Arrow ((***))
import Control.Lens (makeLenses)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Char (toLower, toUpper)
import Data.Data (Data)
import Data.IxSet (IxSet)
import Data.List.Split (chunksOf)
import Data.Monoid ((<>))
import Data.Ord (comparing)
import Data.Set (Set)
import Data.Typeable (Typeable)
import Data.Word (Word8, Word16, Word32)
import Numeric (readHex, showHex)

type TimeStamp = Word32
type Exportability = Bool
type TrustLevel = Word8
type TrustAmount = Word8
type AlmostPublicDomainRegex = ByteString
type Revocability = Bool
type RevocationReason = ByteString
type KeyServer = ByteString
type URL = ByteString
type NotationName = ByteString
type NotationValue = ByteString
type SignatureHash = ByteString
type PacketVersion = Word8
type Salt = ByteString
type Count = Int
type V3Expiration = Word16
type CompressedDataPayload = ByteString
type FileName = ByteString
type ImageData = ByteString
type NestedFlag = Bool
type IV = ByteString

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

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

instance Ord SymmetricAlgorithm where
    compare a b = fromFVal a `compare` fromFVal b

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 (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 o = OtherSA o

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

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

instance Ord NotationFlag where
    compare a b = fromFFlag a `compare` fromFFlag b

instance FutureFlag NotationFlag where
    fromFFlag HumanReadable = 0
    fromFFlag (OtherNF o) = fromIntegral o

    toFFlag 0 = HumanReadable
    toFFlag o = OtherNF (fromIntegral o)

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

instance Show SigSubPacket where
    show x = (if _sspCriticality x then "*" else "") ++ (show . _sspPayload) x

data SigSubPacketPayload = SigCreationTime TimeStamp
                  | SigExpirationTime TimeStamp
                  | ExportableCertification Exportability
                  | TrustSignature TrustLevel TrustAmount
                  | RegularExpression AlmostPublicDomainRegex
                  | Revocable Revocability
                  | KeyExpirationTime TimeStamp
                  | 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 String
                  | ReasonForRevocation RevocationCode RevocationReason
                  | Features (Set FeatureFlag)
                  | SignatureTarget PubKeyAlgorithm HashAlgorithm SignatureHash
                  | EmbeddedSignature SignaturePayload
                  | UserDefinedSigSub Word8 ByteString
                  | OtherSigSub Word8 ByteString
    deriving (Data, Eq, Show, Typeable) -- FIXME

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

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

instance Ord HashAlgorithm where
    compare a b = fromFVal a `compare` fromFVal b

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

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

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

instance Ord CompressionAlgorithm where
    compare a b = fromFVal a `compare` fromFVal b

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

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

data PubKeyAlgorithm = RSA
                     | DeprecatedRSAEncryptOnly
                     | DeprecatedRSASignOnly
                     | ElgamalEncryptOnly
                     | DSA
                     | EC
                     | ECDSA
                     | ForbiddenElgamal
                     | DH
                     | OtherPKA Word8
    deriving (Show, Data, Typeable)

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

instance Ord PubKeyAlgorithm where
    compare a b = fromFVal a `compare` fromFVal b

instance FutureVal PubKeyAlgorithm where
    fromFVal RSA = 1
    fromFVal DeprecatedRSAEncryptOnly = 2
    fromFVal DeprecatedRSASignOnly = 3
    fromFVal ElgamalEncryptOnly = 16
    fromFVal DSA = 17
    fromFVal EC = 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 = EC
    toFVal 19 = ECDSA
    toFVal 20 = ForbiddenElgamal
    toFVal 21 = DH
    toFVal o = OtherPKA o

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

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

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

instance Ord KSPFlag where
    compare a b = fromFFlag a `compare` fromFFlag b

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

    toFFlag 0 = NoModify
    toFFlag i = KSPOther (fromIntegral i)

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

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

instance Ord KeyFlag where
    compare a b = fromFFlag a `compare` fromFFlag b

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)

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

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

instance Ord RevocationClass where
    compare a b = fromFFlag a `compare` fromFFlag b

instance FutureFlag RevocationClass where
    fromFFlag SensitiveRK = 1
    fromFFlag (RClOther i) = fromIntegral i

    toFFlag 1 = SensitiveRK
    toFFlag i = RClOther (fromIntegral i)

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

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

instance Ord RevocationCode where
    compare a b = fromFVal a `compare` fromFVal b

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

data FeatureFlag = ModificationDetection
                 | FeatureOther Int
    deriving (Show, Data, Typeable)

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

instance Ord FeatureFlag where
    compare a b = fromFFlag a `compare` fromFFlag b

instance FutureFlag FeatureFlag where
    fromFFlag ModificationDetection = 7
    fromFFlag (FeatureOther i) = fromIntegral i

    toFFlag 7 = ModificationDetection
    toFFlag i = FeatureOther (fromIntegral i)

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

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

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

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

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

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

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

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

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

instance Ord DataType where
    compare a b = fromFVal a `compare` fromFVal b

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

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

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

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

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

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

instance Ord ImageFormat where
    compare a b = fromFVal a `compare` fromFVal b

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

    toFVal 1 = JPEG
    toFVal o = OtherImage o

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

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

instance Ord SigType where
    compare a b = fromFVal a `compare` fromFVal b

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 Ord DSA.PublicKey
instance Ord RSA.PublicKey

data PKey = RSAPubKey RSA.PublicKey
          | DSAPubKey DSA.PublicKey
          | ElGamalPubKey [Integer]
	  | UnknownPKey ByteString
    deriving (Data, Eq, Ord, Show, Typeable)

data SKey = RSAPrivateKey RSA.PrivateKey
          | DSAPrivateKey DSA.PrivateKey
          | ElGamalPrivateKey [Integer]
	  | UnknownSKey ByteString
    deriving (Data, Eq, Show, Typeable)

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

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

instance Show EightOctetKeyId where
    show = w8sToHex . B.unpack . unEOKI

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

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

instance Show TwentyOctetFingerprint where
    show = take 50 . concatMap (++" ") . concatMap (++[""]) . chunksOf 5 . chunksOf 4 . w8sToHex . B.unpack . unTOF

instance Read TwentyOctetFingerprint where
    readsPrec _ = map ((TwentyOctetFingerprint . B.pack *** concat) . unzip) . chunksOf 20 . hexToW8s . filter (/= ' ')

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 :: [(String, [SignaturePayload])]
  , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])]
  , _tkSubs :: [(Pkt, [SignaturePayload])]
  } deriving (Data, Eq, Show, Typeable)

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

type Keyring = IxSet TK

class Packet a where
    data PacketType a :: *
    packetType :: a -> PacketType a
    packetCode :: PacketType a -> Word8
    toPkt :: a -> Pkt
    fromPkt :: Pkt -> a

-- data Pkt = forall a. (Packet a, Show a, Eq a) => Pkt a
data Pkt = PKESKPkt PacketVersion EightOctetKeyId PubKeyAlgorithm [MPI]
         | SignaturePkt SignaturePayload
         | SKESKPkt PacketVersion SymmetricAlgorithm S2K (Maybe B.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 TimeStamp ByteString
         | TrustPkt ByteString
         | UserIdPkt String
         | PublicSubkeyPkt PKPayload
         | UserAttributePkt [UserAttrSubPacket]
         | SymEncIntegrityProtectedDataPkt PacketVersion ByteString
         | ModificationDetectionCodePkt ByteString
         | OtherPacketPkt Word8 ByteString
         | BrokenPacketPkt String Word8 ByteString
    deriving (Data, Eq, Show, Typeable) -- FIXME

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

data PKESK = PKESK
    { _pkeskPacketVersion :: PacketVersion
    , _pkeskEightOctetKeyId :: EightOctetKeyId
    , _pkeskPubKeyAlgorithm :: PubKeyAlgorithm
    , _pkeskMPIs :: [MPI]
    } deriving (Data, Eq, Show, Typeable)
instance Packet PKESK where
    data PacketType PKESK = PKESKType deriving (Show, Eq)
    packetType _ = PKESKType
    packetCode _ = 1
    toPkt (PKESK a b c d) = PKESKPkt a b c d
    fromPkt (PKESKPkt a b c d) = PKESK a b c d

data Signature = Signature   -- FIXME?
    { _signaturePayload :: SignaturePayload
    } deriving (Data, Eq, Show, Typeable)
instance Packet Signature where
    data PacketType Signature = SignatureType deriving (Show, Eq)
    packetType _ = SignatureType
    packetCode _ = 2
    toPkt (Signature a ) = SignaturePkt a
    fromPkt (SignaturePkt a) = Signature a

data SKESK = SKESK
    { _skeskPacketVersion :: PacketVersion
    , _skeskSymmetricAlgorithm :: SymmetricAlgorithm
    , _skeskS2K :: S2K
    , _skeskESK :: Maybe B.ByteString
    } deriving (Data, Eq, Show, Typeable)
instance Packet SKESK where
    data PacketType SKESK = SKESKType deriving (Show, Eq)
    packetType _ = SKESKType
    packetCode _ = 3
    toPkt (SKESK a b c d) = SKESKPkt a b c d
    fromPkt (SKESKPkt a b c d) = SKESK a b c d

data OnePassSignature = OnePassSignature
    { _onePassSignaturePacketVersion :: PacketVersion
    , _onePassSignatureSigType :: SigType
    , _onePassSignatureHashAlgorithm :: HashAlgorithm
    , _onePassSignaturePubKeyAlgorithm :: PubKeyAlgorithm
    , _onePassSignatureEightOctetKeyId :: EightOctetKeyId
    , _onePassSignatureNestedFlag :: NestedFlag
    } deriving (Data, Eq, Show, Typeable)
instance Packet OnePassSignature where
    data PacketType OnePassSignature = OnePassSignatureType deriving (Show, Eq)
    packetType _ = OnePassSignatureType
    packetCode _ = 4
    toPkt (OnePassSignature a b c d e f) = OnePassSignaturePkt a b c d e f
    fromPkt (OnePassSignaturePkt a b c d e f) = OnePassSignature a b c d e f

data SecretKey = SecretKey
    { _secretKeyPKPayload :: PKPayload
    , _secretKeySKAddendum :: SKAddendum
    } deriving (Data, Eq, Show, Typeable)
instance Packet SecretKey where
    data PacketType SecretKey = SecretKeyType deriving (Show, Eq)
    packetType _ = SecretKeyType
    packetCode _ = 5
    toPkt (SecretKey a b) = SecretKeyPkt a b
    fromPkt (SecretKeyPkt a b) = SecretKey a b

data PublicKey = PublicKey
    { _publicKeyPKPayload :: PKPayload
    } deriving (Data, Eq, Show, Typeable)
instance Packet PublicKey where
    data PacketType PublicKey = PublicKeyType deriving (Show, Eq)
    packetType _ = PublicKeyType
    packetCode _ = 6
    toPkt (PublicKey a) = PublicKeyPkt a
    fromPkt (PublicKeyPkt a) = PublicKey a

data SecretSubkey = SecretSubkey
    { _secretSubkeyPKPayload :: PKPayload
    , _secretSubkeySKAddendum :: SKAddendum
    } deriving (Data, Eq, Show, Typeable)
instance Packet SecretSubkey where
    data PacketType SecretSubkey = SecretSubkeyType deriving (Show, Eq)
    packetType _ = SecretSubkeyType
    packetCode _ = 7
    toPkt (SecretSubkey a b) = SecretSubkeyPkt a b
    fromPkt (SecretSubkeyPkt a b) = SecretSubkey a b

data CompressedData = CompressedData
    { _compressedDataCompressionAlgorithm :: CompressionAlgorithm
    , _compressedDataPayload :: CompressedDataPayload
    } deriving (Data, Eq, Show, Typeable)
instance Packet CompressedData where
    data PacketType CompressedData = CompressedDataType deriving (Show, Eq)
    packetType _ = CompressedDataType
    packetCode _ = 8
    toPkt (CompressedData a b) = CompressedDataPkt a b
    fromPkt (CompressedDataPkt a b) = CompressedData a b

data SymEncData = SymEncData
    { _symEncDataPayload :: ByteString
    } deriving (Data, Eq, Show, Typeable)
instance Packet SymEncData where
    data PacketType SymEncData = SymEncDataType deriving (Show, Eq)
    packetType _ = SymEncDataType
    packetCode _ = 9
    toPkt (SymEncData a) = SymEncDataPkt a
    fromPkt (SymEncDataPkt a) = SymEncData a

data Marker = Marker
    { _markerPayload :: ByteString
    } deriving (Data, Eq, Show, Typeable)
instance Packet Marker where
    data PacketType Marker = MarkerType deriving (Show, Eq)
    packetType _ = MarkerType
    packetCode _ = 10
    toPkt (Marker a) = MarkerPkt a
    fromPkt (MarkerPkt a) = Marker a

data LiteralData = LiteralData
    { _literalDataDataType :: DataType
    , _literalDataFileName :: FileName
    , _literalDataTimeStamp :: TimeStamp
    , _literalDataPayload :: ByteString
    } deriving (Data, Eq, Show, Typeable)
instance Packet LiteralData where
    data PacketType LiteralData = LiteralDataType deriving (Show, Eq)
    packetType _ = LiteralDataType
    packetCode _ = 11
    toPkt (LiteralData a b c d) = LiteralDataPkt a b c d
    fromPkt (LiteralDataPkt a b c d) = LiteralData a b c d

data Trust = Trust
    { _trustPayload :: ByteString
    } deriving (Data, Eq, Show, Typeable)
instance Packet Trust where
    data PacketType Trust = TrustType deriving (Show, Eq)
    packetType _ = TrustType
    packetCode _ = 12
    toPkt (Trust a) = TrustPkt a
    fromPkt (TrustPkt a) = Trust a

data UserId = UserId
    { _userIdPayload :: String
    } deriving (Data, Eq, Show, Typeable)
instance Packet UserId where
    data PacketType UserId = UserIdType deriving (Show, Eq)
    packetType _ = UserIdType
    packetCode _ = 13
    toPkt (UserId a) = UserIdPkt a
    fromPkt (UserIdPkt a) = UserId a

data PublicSubkey = PublicSubkey
    { _publicSubkeyPKPayload :: PKPayload
    } deriving (Data, Eq, Show, Typeable)
instance Packet PublicSubkey where
    data PacketType PublicSubkey = PublicSubkeyType deriving (Show, Eq)
    packetType _ = PublicSubkeyType
    packetCode _ = 14
    toPkt (PublicSubkey a) = PublicSubkeyPkt a
    fromPkt (PublicSubkeyPkt a) = PublicSubkey a

data UserAttribute = UserAttribute
    { _userAttributeSubPackets :: [UserAttrSubPacket]
    } deriving (Data, Eq, Show, Typeable)
instance Packet UserAttribute where
    data PacketType UserAttribute = UserAttributeType deriving (Show, Eq)
    packetType _ = UserAttributeType
    packetCode _ = 17
    toPkt (UserAttribute a) = UserAttributePkt a
    fromPkt (UserAttributePkt a) = UserAttribute a

data SymEncIntegrityProtectedData = SymEncIntegrityProtectedData
    { _symEncIntegrityProtectedDataPacketVersion :: PacketVersion
    , _symEncIntegrityProtectedDataPayload :: ByteString
    } deriving (Data, Eq, Show, Typeable)
instance Packet SymEncIntegrityProtectedData where
    data PacketType SymEncIntegrityProtectedData = SymEncIntegrityProtectedDataType deriving (Show, Eq)
    packetType _ = SymEncIntegrityProtectedDataType
    packetCode _ = 18
    toPkt (SymEncIntegrityProtectedData a b) = SymEncIntegrityProtectedDataPkt a b
    fromPkt (SymEncIntegrityProtectedDataPkt a b) = SymEncIntegrityProtectedData a b

data ModificationDetectionCode = ModificationDetectionCode
    { _modificationDetectionCodePayload :: ByteString
    } deriving (Data, Eq, Show, Typeable)
instance Packet ModificationDetectionCode where
    data PacketType ModificationDetectionCode = ModificationDetectionCodeType deriving (Show, Eq)
    packetType _ = ModificationDetectionCodeType
    packetCode _ = 19
    toPkt (ModificationDetectionCode a) = ModificationDetectionCodePkt a
    fromPkt (ModificationDetectionCodePkt a) = ModificationDetectionCode a

data OtherPacket = OtherPacket
    { _otherPacketType :: Word8
    , _otherPacketPayload :: ByteString
    } deriving (Data, Eq, Show, Typeable)
instance Packet OtherPacket where
    data PacketType OtherPacket = OtherPacketType deriving (Show, Eq)
    packetType _ = OtherPacketType
    packetCode _ = undefined -- FIXME
    toPkt (OtherPacket a b) = OtherPacketPkt a b
    fromPkt (OtherPacketPkt a b) = OtherPacket a b

data BrokenPacket = BrokenPacket
    { _brokenPacketParseError :: String
    , _brokenPacketType :: Word8
    , _brokenPacketPayload :: ByteString
    } deriving (Data, Eq, Show, Typeable)
instance Packet BrokenPacket where
    data PacketType BrokenPacket = BrokenPacketType deriving (Show, Eq)
    packetType _ = BrokenPacketType
    packetCode _ = undefined
    toPkt (BrokenPacket a b c) = BrokenPacketPkt a b c
    fromPkt (BrokenPacketPkt a b c) = BrokenPacket a b c

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

$(makeLenses ''PKESK)
$(makeLenses ''Signature)
$(makeLenses ''SKESK)
$(makeLenses ''OnePassSignature)
$(makeLenses ''SecretKey)
$(makeLenses ''PKPayload)
$(makeLenses ''PublicKey)
$(makeLenses ''SecretSubkey)
$(makeLenses ''CompressedData)
$(makeLenses ''SymEncData)
$(makeLenses ''Marker)
$(makeLenses ''LiteralData)
$(makeLenses ''Trust)
$(makeLenses ''UserId)
$(makeLenses ''PublicSubkey)
$(makeLenses ''UserAttribute)
$(makeLenses ''SymEncIntegrityProtectedData)
$(makeLenses ''ModificationDetectionCode)
$(makeLenses ''OtherPacket)
$(makeLenses ''TK)
$(makeLenses ''Verification)
$(makeLenses ''SigSubPacket)