-- PacketClass.hs: OpenPGP (RFC4880) data types
-- Copyright © 2012-2022  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 qualified Data.Kind
import Prettyprinter (Pretty(..))

class Packet a where
  data PacketType a :: Data.Kind.Type
  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

newtype 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

newtype 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

newtype 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

newtype 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

newtype 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

newtype 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

newtype 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

newtype 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

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