-- PacketClass.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 DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

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

import Codec.Encryption.OpenPGP.Types.Internal.Base
import Codec.Encryption.OpenPGP.Types.Internal.PKITypes
import Codec.Encryption.OpenPGP.Types.Internal.Pkt

import Control.Lens (makeLenses)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Data (Data)
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Data.Word (Word8)
import Text.PrettyPrint.Free (Pretty(..))

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

data PKESK = PKESK
    { _pkeskPacketVersion :: PacketVersion
    , _pkeskEightOctetKeyId :: EightOctetKeyId
    , _pkeskPubKeyAlgorithm :: PubKeyAlgorithm
    , _pkeskMPIs :: NonEmpty 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
    fromPkt _ = error "Cannot coerce non-PKESK packet"

instance Pretty PKESK where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-Signature packet"

instance Pretty Signature where
    pretty = pretty . toPkt

data SKESK = SKESK
    { _skeskPacketVersion :: PacketVersion
    , _skeskSymmetricAlgorithm :: SymmetricAlgorithm
    , _skeskS2K :: S2K
    , _skeskESK :: Maybe BL.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
    fromPkt _ = error "Cannot coerce non-SKESK packet"

instance Pretty SKESK where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-OnePassSignature packet"

instance Pretty OnePassSignature where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-SecretKey packet"

instance Pretty SecretKey where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-PublicKey packet"

instance Pretty PublicKey where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-SecretSubkey packet"

instance Pretty SecretSubkey where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-CompressedData packet"

instance Pretty CompressedData where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-SymEncData packet"

instance Pretty SymEncData where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-Marker packet"

instance Pretty Marker where
    pretty = pretty . toPkt

data LiteralData = LiteralData
    { _literalDataDataType :: DataType
    , _literalDataFileName :: FileName
    , _literalDataTimeStamp :: ThirtyTwoBitTimeStamp
    , _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
    fromPkt _ = error "Cannot coerce non-LiteralData packet"

instance Pretty LiteralData where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-Trust packet"

instance Pretty Trust where
    pretty = pretty . toPkt

data UserId = UserId
    { _userIdPayload :: Text
    } 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
    fromPkt _ = error "Cannot coerce non-UserId packet"

instance Pretty UserId where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-PublicSubkey packet"

instance Pretty PublicSubkey where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-UserAttribute packet"

instance Pretty UserAttribute where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-SymEncIntegrityProtectedData packet"

instance Pretty SymEncIntegrityProtectedData where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-ModificationDetectionCode packet"

instance Pretty ModificationDetectionCode where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-OtherPacket packet"

instance Pretty OtherPacket where
    pretty = pretty . toPkt

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
    fromPkt _ = error "Cannot coerce non-BrokenPacket packet"

instance Pretty BrokenPacket where
    pretty = pretty . toPkt

$(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 ''BrokenPacket)