{-# 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.Text.Prettyprint.Doc (Pretty(..))
import Data.Typeable (Typeable)
import Data.Word (Word8)
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
newtype 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
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
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)