-- Pkt.hs: OpenPGP (RFC4880) Pkt data types -- Copyright © 2012-2018 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 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 Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils (prettyLBS) 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 import Data.Monoid ((<>)) import Data.Ord (comparing) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Prettyprint.Doc (Pretty(..), (<+>)) import Data.Typeable (Typeable) import Data.Word (Word8) -- data Pkt = forall a. (Packet a, Show a, Eq a) => Pkt a 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) -- FIXME instance Hashable Pkt instance Ord Pkt where compare = comparing pktTag <> comparing hash -- FIXME: is there something saner? instance Pretty Pkt where pretty (PKESKPkt pv eoki pka mpis) = pretty "PKESK v" <> pretty pv <> pretty ':' <+> pretty eoki <+> pretty pka <+> (pretty . NE.toList) mpis pretty (SignaturePkt sp) = pretty sp pretty (SKESKPkt pv sa s2k mbs) = pretty "SKESK v" <> pretty pv <> pretty ':' <+> pretty sa <+> pretty s2k <+> pretty (fmap bsToHexUpper mbs) pretty (OnePassSignaturePkt pv st ha pka eoki nestedflag) = pretty "one-pass signature v" <> pretty pv <> pretty ':' <+> pretty st <+> pretty ha <+> pretty pka <+> pretty eoki <+> pretty nestedflag pretty (SecretKeyPkt pkp ska) = pretty "secret key:" <+> pretty pkp <+> pretty ska pretty (PublicKeyPkt pkp) = pretty "public key:" <+> pretty pkp pretty (SecretSubkeyPkt pkp ska) = pretty "secret subkey:" <+> pretty pkp <+> pretty ska pretty (CompressedDataPkt ca cdp) = pretty "compressed-data:" <+> pretty ca <+> prettyLBS cdp pretty (SymEncDataPkt bs) = pretty "symmetrically-encrypted-data:" <+> pretty (bsToHexUpper bs) pretty (MarkerPkt bs) = pretty "marker:" <+> pretty (bsToHexUpper bs) pretty (LiteralDataPkt dt fn ts bs) = pretty "literal-data" <+> pretty dt <+> prettyLBS fn <+> pretty ts <+> pretty (bsToHexUpper bs) pretty (TrustPkt bs) = pretty "trust:" <+> pretty (BL.unpack bs) pretty (UserIdPkt u) = pretty "user-ID:" <+> pretty u pretty (PublicSubkeyPkt pkp) = pretty "public subkey:" <+> pretty pkp pretty (UserAttributePkt us) = pretty "user-attribute:" <+> pretty us pretty (SymEncIntegrityProtectedDataPkt pv bs) = pretty "symmetrically-encrypted-integrity-protected-data v" <> pretty pv <> pretty ':' <+> pretty (bsToHexUpper bs) pretty (ModificationDetectionCodePkt bs) = pretty "MDC:" <+> pretty (bsToHexUpper bs) pretty (OtherPacketPkt t bs) = pretty "unknown packet type" <+> pretty t <> pretty ':' <+> pretty (bsToHexUpper bs) pretty (BrokenPacketPkt s t bs) = pretty "BROKEN packet (" <> pretty s <> pretty ')' <+> pretty t <> pretty ':' <+> 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 -- is this the right thing to do? data Verification = Verification { _verificationSigner :: PKPayload , _verificationSignature :: SignaturePayload } $(makeLenses ''Verification)