{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
module Codec.Encryption.OpenPGP.Types.Internal.Pkt where
import GHC.Generics (Generic)
import Codec.Encryption.OpenPGP.Types.Internal.Base
import Codec.Encryption.OpenPGP.Types.Internal.PKITypes
import Control.Lens (makeLenses)
import Data.Aeson ((.=), object)
import qualified Data.Aeson as A
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Data (Data)
import Data.Hashable (Hashable(..))
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mempty)
#endif
import Data.Monoid ((<>))
import Data.Ord (comparing)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (Typeable)
import Data.Word (Word8)
import Text.PrettyPrint.Free (Pretty(..), (<+>), char, text)
data Pkt = PKESKPkt PacketVersion EightOctetKeyId PubKeyAlgorithm (NonEmpty MPI)
| SignaturePkt SignaturePayload
| SKESKPkt PacketVersion SymmetricAlgorithm S2K (Maybe BL.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 ThirtyTwoBitTimeStamp ByteString
| TrustPkt ByteString
| UserIdPkt Text
| PublicSubkeyPkt PKPayload
| UserAttributePkt [UserAttrSubPacket]
| SymEncIntegrityProtectedDataPkt PacketVersion ByteString
| ModificationDetectionCodePkt ByteString
| OtherPacketPkt Word8 ByteString
| BrokenPacketPkt String Word8 ByteString
deriving (Data, Eq, Generic, Show, Typeable)
instance Hashable Pkt
instance Ord Pkt where
compare = comparing pktTag <> comparing hash
instance Pretty Pkt where
pretty (PKESKPkt pv eoki pka mpis) = text "PKESK v" <> pretty pv <> char ':' <+> pretty eoki <+> pretty pka <+> (pretty . NE.toList) mpis
pretty (SignaturePkt sp) = pretty sp
pretty (SKESKPkt pv sa s2k mbs) = text "SKESK v" <> pretty pv <> char ':' <+> pretty sa <+> pretty s2k <+> pretty (fmap bsToHexUpper mbs)
pretty (OnePassSignaturePkt pv st ha pka eoki nestedflag) = text "one-pass signature v" <> pretty pv <> char ':' <+> pretty st <+> pretty ha <+> pretty pka <+> pretty eoki <+> pretty nestedflag
pretty (SecretKeyPkt pkp ska) = text "secret key:" <+> pretty pkp <+> pretty ska
pretty (PublicKeyPkt pkp) = text "public key:" <+> pretty pkp
pretty (SecretSubkeyPkt pkp ska) = text "secret subkey:" <+> pretty pkp <+> pretty ska
pretty (CompressedDataPkt ca cdp) = text "compressed-data:" <+> pretty ca <+> pretty cdp
pretty (SymEncDataPkt bs) = text "symmetrically-encrypted-data:" <+> pretty (bsToHexUpper bs)
pretty (MarkerPkt bs) = text "marker:" <+> pretty (bsToHexUpper bs)
pretty (LiteralDataPkt dt fn ts bs) = text "literal-data" <+> pretty dt <+> pretty fn <+> pretty ts <+> pretty (bsToHexUpper bs)
pretty (TrustPkt bs) = text "trust:" <+> pretty (BL.unpack bs)
pretty (UserIdPkt u) = text "user-ID:" <+> pretty u
pretty (PublicSubkeyPkt pkp) = text "public subkey:" <+> pretty pkp
pretty (UserAttributePkt us) = text "user-attribute:" <+> pretty us
pretty (SymEncIntegrityProtectedDataPkt pv bs) = text "symmetrically-encrypted-integrity-protected-data v" <> pretty pv <> char ':' <+> pretty (bsToHexUpper bs)
pretty (ModificationDetectionCodePkt bs) = text "MDC:" <+> pretty (bsToHexUpper bs)
pretty (OtherPacketPkt t bs) = text "unknown packet type" <+> pretty t <> char ':' <+> pretty (bsToHexUpper bs)
pretty (BrokenPacketPkt s t bs) = text "BROKEN packet (" <> pretty s <> char ')' <+> pretty t <> char ':' <+> pretty (bsToHexUpper bs)
instance A.ToJSON Pkt where
toJSON (PKESKPkt pv eoki pka mpis) = object [T.pack "pkesk" .= object [T.pack "version" .= pv, T.pack "keyid" .= eoki, T.pack "pkalgo" .= pka, T.pack "mpis" .= NE.toList mpis]]
toJSON (SignaturePkt sp) = object [T.pack "signature" .= sp]
toJSON (SKESKPkt pv sa s2k mbs) = object [T.pack "skesk" .= object [T.pack "version" .= pv, T.pack "symalgo" .= sa, T.pack "s2k" .= s2k, T.pack "data" .= maybe mempty BL.unpack mbs]]
toJSON (OnePassSignaturePkt pv st ha pka eoki nestedflag) = object [T.pack "onepasssignature" .= object [T.pack "version" .= pv, T.pack "sigtype" .= st, T.pack "hashalgo" .= ha, T.pack "pkalgo" .= pka, T.pack "keyid" .= eoki, T.pack "nested" .= nestedflag]]
toJSON (SecretKeyPkt pkp ska) = object [T.pack "secretkey" .= object [T.pack "public" .= pkp, T.pack "secret" .= ska]]
toJSON (PublicKeyPkt pkp) = object [T.pack "publickey" .= pkp]
toJSON (SecretSubkeyPkt pkp ska) = object [T.pack "secretsubkey" .= object [T.pack "public" .= pkp, T.pack "secret" .= ska]]
toJSON (CompressedDataPkt ca cdp) = object [T.pack "compresseddata" .= object [T.pack "compressionalgo" .= ca, T.pack "data" .= BL.unpack cdp]]
toJSON (SymEncDataPkt bs) = object [T.pack "symencdata" .= BL.unpack bs]
toJSON (MarkerPkt bs) = object [T.pack "marker" .= BL.unpack bs]
toJSON (LiteralDataPkt dt fn ts bs) = object [T.pack "literaldata" .= object [T.pack "dt" .= dt, T.pack "filename" .= BL.unpack fn, T.pack "ts" .= ts, T.pack "data" .= BL.unpack bs]]
toJSON (TrustPkt bs) = object [T.pack "trust" .= BL.unpack bs]
toJSON (UserIdPkt u) = object [T.pack "userid" .= u]
toJSON (PublicSubkeyPkt pkp) = object [T.pack "publicsubkkey" .= pkp]
toJSON (UserAttributePkt us) = object [T.pack "userattribute" .= us]
toJSON (SymEncIntegrityProtectedDataPkt pv bs) = object [T.pack "symencipd" .= object [T.pack "version" .= pv, T.pack "data" .= BL.unpack bs]]
toJSON (ModificationDetectionCodePkt bs) = object [T.pack "mdc" .= BL.unpack bs]
toJSON (OtherPacketPkt t bs) = object [T.pack "otherpacket" .= object [T.pack "tag" .= t, T.pack "data" .= BL.unpack bs]]
toJSON (BrokenPacketPkt s t bs) = object [T.pack "brokenpacket" .= object [T.pack "error" .= s, T.pack "tag" .= t, T.pack "data" .= BL.unpack bs]]
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
pktTag (BrokenPacketPkt _ t _) = t
data Verification = Verification {
_verificationSigner :: PKPayload
, _verificationSignature :: SignaturePayload
}
$(makeLenses ''Verification)