    -- 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)