-- 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 (Typeable Pkt
DataType
Constr
Typeable Pkt =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Pkt -> c Pkt)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pkt)
-> (Pkt -> Constr)
-> (Pkt -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Pkt))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pkt))
-> ((forall b. Data b => b -> b) -> Pkt -> Pkt)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pkt -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pkt -> r)
-> (forall u. (forall d. Data d => d -> u) -> Pkt -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Pkt -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pkt -> m Pkt)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pkt -> m Pkt)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pkt -> m Pkt)
-> Data Pkt
Pkt -> DataType
Pkt -> Constr
(forall b. Data b => b -> b) -> Pkt -> Pkt
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pkt -> c Pkt
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pkt
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Pkt -> u
forall u. (forall d. Data d => d -> u) -> Pkt -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pkt -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pkt -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pkt -> m Pkt
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pkt -> m Pkt
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pkt
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pkt -> c Pkt
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pkt)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pkt)
$cBrokenPacketPkt :: Constr
$cOtherPacketPkt :: Constr
$cModificationDetectionCodePkt :: Constr
$cSymEncIntegrityProtectedDataPkt :: Constr
$cUserAttributePkt :: Constr
$cPublicSubkeyPkt :: Constr
$cUserIdPkt :: Constr
$cTrustPkt :: Constr
$cLiteralDataPkt :: Constr
$cMarkerPkt :: Constr
$cSymEncDataPkt :: Constr
$cCompressedDataPkt :: Constr
$cSecretSubkeyPkt :: Constr
$cPublicKeyPkt :: Constr
$cSecretKeyPkt :: Constr
$cOnePassSignaturePkt :: Constr
$cSKESKPkt :: Constr
$cSignaturePkt :: Constr
$cPKESKPkt :: Constr
$tPkt :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Pkt -> m Pkt
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pkt -> m Pkt
gmapMp :: (forall d. Data d => d -> m d) -> Pkt -> m Pkt
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pkt -> m Pkt
gmapM :: (forall d. Data d => d -> m d) -> Pkt -> m Pkt
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pkt -> m Pkt
gmapQi :: Int -> (forall d. Data d => d -> u) -> Pkt -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pkt -> u
gmapQ :: (forall d. Data d => d -> u) -> Pkt -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pkt -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pkt -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pkt -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pkt -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pkt -> r
gmapT :: (forall b. Data b => b -> b) -> Pkt -> Pkt
$cgmapT :: (forall b. Data b => b -> b) -> Pkt -> Pkt
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pkt)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pkt)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Pkt)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pkt)
dataTypeOf :: Pkt -> DataType
$cdataTypeOf :: Pkt -> DataType
toConstr :: Pkt -> Constr
$ctoConstr :: Pkt -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pkt
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pkt
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pkt -> c Pkt
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pkt -> c Pkt
$cp1Data :: Typeable Pkt
Data, Pkt -> Pkt -> Bool
(Pkt -> Pkt -> Bool) -> (Pkt -> Pkt -> Bool) -> Eq Pkt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pkt -> Pkt -> Bool
$c/= :: Pkt -> Pkt -> Bool
== :: Pkt -> Pkt -> Bool
$c== :: Pkt -> Pkt -> Bool
Eq, (forall x. Pkt -> Rep Pkt x)
-> (forall x. Rep Pkt x -> Pkt) -> Generic Pkt
forall x. Rep Pkt x -> Pkt
forall x. Pkt -> Rep Pkt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pkt x -> Pkt
$cfrom :: forall x. Pkt -> Rep Pkt x
Generic, Int -> Pkt -> ShowS
[Pkt] -> ShowS
Pkt -> String
(Int -> Pkt -> ShowS)
-> (Pkt -> String) -> ([Pkt] -> ShowS) -> Show Pkt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pkt] -> ShowS
$cshowList :: [Pkt] -> ShowS
show :: Pkt -> String
$cshow :: Pkt -> String
showsPrec :: Int -> Pkt -> ShowS
$cshowsPrec :: Int -> Pkt -> ShowS
Show, Typeable) -- FIXME

instance Hashable Pkt

instance Ord Pkt where
  compare :: Pkt -> Pkt -> Ordering
compare = (Pkt -> Word8) -> Pkt -> Pkt -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Pkt -> Word8
pktTag (Pkt -> Pkt -> Ordering)
-> (Pkt -> Pkt -> Ordering) -> Pkt -> Pkt -> Ordering
forall a. Semigroup a => a -> a -> a
<> (Pkt -> Int) -> Pkt -> Pkt -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Pkt -> Int
forall a. Hashable a => a -> Int
hash -- FIXME: is there something saner?

instance Pretty Pkt where
  pretty :: Pkt -> Doc ann
pretty (PKESKPkt pv :: Word8
pv eoki :: EightOctetKeyId
eoki pka :: PubKeyAlgorithm
pka mpis :: NonEmpty MPI
mpis) =
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "PKESK v" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
pv Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ':' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    EightOctetKeyId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty EightOctetKeyId
eoki Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PubKeyAlgorithm -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PubKeyAlgorithm
pka Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ([MPI] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([MPI] -> Doc ann)
-> (NonEmpty MPI -> [MPI]) -> NonEmpty MPI -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty MPI -> [MPI]
forall a. NonEmpty a -> [a]
NE.toList) NonEmpty MPI
mpis
  pretty (SignaturePkt sp :: SignaturePayload
sp) = SignaturePayload -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty SignaturePayload
sp
  pretty (SKESKPkt pv :: Word8
pv sa :: SymmetricAlgorithm
sa s2k :: S2K
s2k mbs :: Maybe ByteString
mbs) =
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "SKESK v" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
pv Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ':' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    SymmetricAlgorithm -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty SymmetricAlgorithm
sa Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> S2K -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty S2K
s2k Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Maybe String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ((ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
bsToHexUpper Maybe ByteString
mbs)
  pretty (OnePassSignaturePkt pv :: Word8
pv st :: SigType
st ha :: HashAlgorithm
ha pka :: PubKeyAlgorithm
pka eoki :: EightOctetKeyId
eoki nestedflag :: Bool
nestedflag) =
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "one-pass signature v" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
pv Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ':' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    SigType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty SigType
st Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> HashAlgorithm -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty HashAlgorithm
ha Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PubKeyAlgorithm -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PubKeyAlgorithm
pka Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> EightOctetKeyId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty EightOctetKeyId
eoki Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Bool
nestedflag
  pretty (SecretKeyPkt pkp :: PKPayload
pkp ska :: SKAddendum
ska) =
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "secret key:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PKPayload -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PKPayload
pkp Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SKAddendum -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty SKAddendum
ska
  pretty (PublicKeyPkt pkp :: PKPayload
pkp) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "public key:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PKPayload -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PKPayload
pkp
  pretty (SecretSubkeyPkt pkp :: PKPayload
pkp ska :: SKAddendum
ska) =
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "secret subkey:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PKPayload -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PKPayload
pkp Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SKAddendum -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty SKAddendum
ska
  pretty (CompressedDataPkt ca :: CompressionAlgorithm
ca cdp :: ByteString
cdp) =
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "compressed-data:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> CompressionAlgorithm -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty CompressionAlgorithm
ca Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ByteString -> Doc ann
forall ann. ByteString -> Doc ann
prettyLBS ByteString
cdp
  pretty (SymEncDataPkt bs :: ByteString
bs) =
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "symmetrically-encrypted-data:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
bsToHexUpper ByteString
bs)
  pretty (MarkerPkt bs :: ByteString
bs) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "marker:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
bsToHexUpper ByteString
bs)
  pretty (LiteralDataPkt dt :: DataType
dt fn :: ByteString
fn ts :: ThirtyTwoBitTimeStamp
ts bs :: ByteString
bs) =
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "literal-data" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    DataType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty DataType
dt Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ByteString -> Doc ann
forall ann. ByteString -> Doc ann
prettyLBS ByteString
fn Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ThirtyTwoBitTimeStamp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ThirtyTwoBitTimeStamp
ts Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
bsToHexUpper ByteString
bs)
  pretty (TrustPkt bs :: ByteString
bs) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "trust:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Word8] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> [Word8]
BL.unpack ByteString
bs)
  pretty (UserIdPkt u :: Text
u) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "user-ID:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
u
  pretty (PublicSubkeyPkt pkp :: PKPayload
pkp) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "public subkey:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PKPayload -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PKPayload
pkp
  pretty (UserAttributePkt us :: [UserAttrSubPacket]
us) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "user-attribute:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [UserAttrSubPacket] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [UserAttrSubPacket]
us
  pretty (SymEncIntegrityProtectedDataPkt pv :: Word8
pv bs :: ByteString
bs) =
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "symmetrically-encrypted-integrity-protected-data v" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
pv Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
    Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ':' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
bsToHexUpper ByteString
bs)
  pretty (ModificationDetectionCodePkt bs :: ByteString
bs) =
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "MDC:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
bsToHexUpper ByteString
bs)
  pretty (OtherPacketPkt t :: Word8
t bs :: ByteString
bs) =
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "unknown packet type" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
t Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ':' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
bsToHexUpper ByteString
bs)
  pretty (BrokenPacketPkt s :: String
s t :: Word8
t bs :: ByteString
bs) =
    String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty "BROKEN packet (" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
s Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ')' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
t Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ':' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
bsToHexUpper ByteString
bs)

instance A.ToJSON Pkt where
  toJSON :: Pkt -> Value
toJSON (PKESKPkt pv :: Word8
pv eoki :: EightOctetKeyId
eoki pka :: PubKeyAlgorithm
pka mpis :: NonEmpty MPI
mpis) =
    [Pair] -> Value
object
      [ String -> Text
T.pack "pkesk" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
        [Pair] -> Value
object
          [ String -> Text
T.pack "version" Text -> Word8 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word8
pv
          , String -> Text
T.pack "keyid" Text -> EightOctetKeyId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= EightOctetKeyId
eoki
          , String -> Text
T.pack "pkalgo" Text -> PubKeyAlgorithm -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PubKeyAlgorithm
pka
          , String -> Text
T.pack "mpis" Text -> [MPI] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= NonEmpty MPI -> [MPI]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty MPI
mpis
          ]
      ]
  toJSON (SignaturePkt sp :: SignaturePayload
sp) = [Pair] -> Value
object [String -> Text
T.pack "signature" Text -> SignaturePayload -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SignaturePayload
sp]
  toJSON (SKESKPkt pv :: Word8
pv sa :: SymmetricAlgorithm
sa s2k :: S2K
s2k mbs :: Maybe ByteString
mbs) =
    [Pair] -> Value
object
      [ String -> Text
T.pack "skesk" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
        [Pair] -> Value
object
          [ String -> Text
T.pack "version" Text -> Word8 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word8
pv
          , String -> Text
T.pack "symalgo" Text -> SymmetricAlgorithm -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SymmetricAlgorithm
sa
          , String -> Text
T.pack "s2k" Text -> S2K -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= S2K
s2k
          , String -> Text
T.pack "data" Text -> [Word8] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Word8] -> (ByteString -> [Word8]) -> Maybe ByteString -> [Word8]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Word8]
forall a. Monoid a => a
mempty ByteString -> [Word8]
BL.unpack Maybe ByteString
mbs
          ]
      ]
  toJSON (OnePassSignaturePkt pv :: Word8
pv st :: SigType
st ha :: HashAlgorithm
ha pka :: PubKeyAlgorithm
pka eoki :: EightOctetKeyId
eoki nestedflag :: Bool
nestedflag) =
    [Pair] -> Value
object
      [ String -> Text
T.pack "onepasssignature" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
        [Pair] -> Value
object
          [ String -> Text
T.pack "version" Text -> Word8 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word8
pv
          , String -> Text
T.pack "sigtype" Text -> SigType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SigType
st
          , String -> Text
T.pack "hashalgo" Text -> HashAlgorithm -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= HashAlgorithm
ha
          , String -> Text
T.pack "pkalgo" Text -> PubKeyAlgorithm -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PubKeyAlgorithm
pka
          , String -> Text
T.pack "keyid" Text -> EightOctetKeyId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= EightOctetKeyId
eoki
          , String -> Text
T.pack "nested" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
nestedflag
          ]
      ]
  toJSON (SecretKeyPkt pkp :: PKPayload
pkp ska :: SKAddendum
ska) =
    [Pair] -> Value
object
      [ String -> Text
T.pack "secretkey" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
        [Pair] -> Value
object [String -> Text
T.pack "public" Text -> PKPayload -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PKPayload
pkp, String -> Text
T.pack "secret" Text -> SKAddendum -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SKAddendum
ska]
      ]
  toJSON (PublicKeyPkt pkp :: PKPayload
pkp) = [Pair] -> Value
object [String -> Text
T.pack "publickey" Text -> PKPayload -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PKPayload
pkp]
  toJSON (SecretSubkeyPkt pkp :: PKPayload
pkp ska :: SKAddendum
ska) =
    [Pair] -> Value
object
      [ String -> Text
T.pack "secretsubkey" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
        [Pair] -> Value
object [String -> Text
T.pack "public" Text -> PKPayload -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PKPayload
pkp, String -> Text
T.pack "secret" Text -> SKAddendum -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SKAddendum
ska]
      ]
  toJSON (CompressedDataPkt ca :: CompressionAlgorithm
ca cdp :: ByteString
cdp) =
    [Pair] -> Value
object
      [ String -> Text
T.pack "compresseddata" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
        [Pair] -> Value
object [String -> Text
T.pack "compressionalgo" Text -> CompressionAlgorithm -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CompressionAlgorithm
ca, String -> Text
T.pack "data" Text -> [Word8] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> [Word8]
BL.unpack ByteString
cdp]
      ]
  toJSON (SymEncDataPkt bs :: ByteString
bs) = [Pair] -> Value
object [String -> Text
T.pack "symencdata" Text -> [Word8] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> [Word8]
BL.unpack ByteString
bs]
  toJSON (MarkerPkt bs :: ByteString
bs) = [Pair] -> Value
object [String -> Text
T.pack "marker" Text -> [Word8] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> [Word8]
BL.unpack ByteString
bs]
  toJSON (LiteralDataPkt dt :: DataType
dt fn :: ByteString
fn ts :: ThirtyTwoBitTimeStamp
ts bs :: ByteString
bs) =
    [Pair] -> Value
object
      [ String -> Text
T.pack "literaldata" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
        [Pair] -> Value
object
          [ String -> Text
T.pack "dt" Text -> DataType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DataType
dt
          , String -> Text
T.pack "filename" Text -> [Word8] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> [Word8]
BL.unpack ByteString
fn
          , String -> Text
T.pack "ts" Text -> ThirtyTwoBitTimeStamp -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ThirtyTwoBitTimeStamp
ts
          , String -> Text
T.pack "data" Text -> [Word8] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> [Word8]
BL.unpack ByteString
bs
          ]
      ]
  toJSON (TrustPkt bs :: ByteString
bs) = [Pair] -> Value
object [String -> Text
T.pack "trust" Text -> [Word8] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> [Word8]
BL.unpack ByteString
bs]
  toJSON (UserIdPkt u :: Text
u) = [Pair] -> Value
object [String -> Text
T.pack "userid" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
u]
  toJSON (PublicSubkeyPkt pkp :: PKPayload
pkp) = [Pair] -> Value
object [String -> Text
T.pack "publicsubkkey" Text -> PKPayload -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PKPayload
pkp]
  toJSON (UserAttributePkt us :: [UserAttrSubPacket]
us) = [Pair] -> Value
object [String -> Text
T.pack "userattribute" Text -> [UserAttrSubPacket] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [UserAttrSubPacket]
us]
  toJSON (SymEncIntegrityProtectedDataPkt pv :: Word8
pv bs :: ByteString
bs) =
    [Pair] -> Value
object
      [ String -> Text
T.pack "symencipd" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
        [Pair] -> Value
object [String -> Text
T.pack "version" Text -> Word8 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word8
pv, String -> Text
T.pack "data" Text -> [Word8] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> [Word8]
BL.unpack ByteString
bs]
      ]
  toJSON (ModificationDetectionCodePkt bs :: ByteString
bs) =
    [Pair] -> Value
object [String -> Text
T.pack "mdc" Text -> [Word8] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> [Word8]
BL.unpack ByteString
bs]
  toJSON (OtherPacketPkt t :: Word8
t bs :: ByteString
bs) =
    [Pair] -> Value
object
      [ String -> Text
T.pack "otherpacket" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
        [Pair] -> Value
object [String -> Text
T.pack "tag" Text -> Word8 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word8
t, String -> Text
T.pack "data" Text -> [Word8] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> [Word8]
BL.unpack ByteString
bs]
      ]
  toJSON (BrokenPacketPkt s :: String
s t :: Word8
t bs :: ByteString
bs) =
    [Pair] -> Value
object
      [ String -> Text
T.pack "brokenpacket" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
        [Pair] -> Value
object
          [ String -> Text
T.pack "error" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
s
          , String -> Text
T.pack "tag" Text -> Word8 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word8
t
          , String -> Text
T.pack "data" Text -> [Word8] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> [Word8]
BL.unpack ByteString
bs
          ]
      ]

pktTag :: Pkt -> Word8
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 :: Word8
t _) = Word8
t
pktTag (BrokenPacketPkt _ t :: Word8
t _) = Word8
t -- is this the right thing to do?

data Verification =
  Verification
    { Verification -> PKPayload
_verificationSigner :: PKPayload
    , Verification -> SignaturePayload
_verificationSignature :: SignaturePayload
    }

$(makeLenses ''Verification)