{-# 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
{ _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
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)