-- Pkt.hs: OpenPGP (RFC4880) Pkt data types
-- Copyright © 2012-2022  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.Ord (comparing)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (Typeable)
import Data.Word (Word8)
import Prettyprinter (Pretty(..), (<+>))

-- 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
      [ key "pkesk" .=
        object
          [ key "version" .= pv
          , key "keyid" .= eoki
          , key "pkalgo" .= pka
          , key "mpis" .= NE.toList mpis
          ]
      ]
  toJSON (SignaturePkt sp) = object [key "signature" .= sp]
  toJSON (SKESKPkt pv sa s2k mbs) =
    object
      [ key "skesk" .=
        object
          [ key "version" .= pv
          , key "symalgo" .= sa
          , key "s2k" .= s2k
          , key "data" .= maybe mempty BL.unpack mbs
          ]
      ]
  toJSON (OnePassSignaturePkt pv st ha pka eoki nestedflag) =
    object
      [ key "onepasssignature" .=
        object
          [ key "version" .= pv
          , key "sigtype" .= st
          , key "hashalgo" .= ha
          , key "pkalgo" .= pka
          , key "keyid" .= eoki
          , key "nested" .= nestedflag
          ]
      ]
  toJSON (SecretKeyPkt pkp ska) =
    object
      [ key "secretkey" .=
        object [key "public" .= pkp, key "secret" .= ska]
      ]
  toJSON (PublicKeyPkt pkp) = object [key "publickey" .= pkp]
  toJSON (SecretSubkeyPkt pkp ska) =
    object
      [ key "secretsubkey" .=
        object [key "public" .= pkp, key "secret" .= ska]
      ]
  toJSON (CompressedDataPkt ca cdp) =
    object
      [ key "compresseddata" .=
        object [key "compressionalgo" .= ca, key "data" .= BL.unpack cdp]
      ]
  toJSON (SymEncDataPkt bs) = object [key "symencdata" .= BL.unpack bs]
  toJSON (MarkerPkt bs) = object [key "marker" .= BL.unpack bs]
  toJSON (LiteralDataPkt dt fn ts bs) =
    object
      [ key "literaldata" .=
        object
          [ key "dt" .= dt
          , key "filename" .= BL.unpack fn
          , key "ts" .= ts
          , key "data" .= BL.unpack bs
          ]
      ]
  toJSON (TrustPkt bs) = object [key "trust" .= BL.unpack bs]
  toJSON (UserIdPkt u) = object [key "userid" .= u]
  toJSON (PublicSubkeyPkt pkp) = object [key "publicsubkkey" .= pkp]
  toJSON (UserAttributePkt us) = object [key "userattribute" .= us]
  toJSON (SymEncIntegrityProtectedDataPkt pv bs) =
    object
      [ key "symencipd" .=
        object [key "version" .= pv, key "data" .= BL.unpack bs]
      ]
  toJSON (ModificationDetectionCodePkt bs) =
    object [key "mdc" .= BL.unpack bs]
  toJSON (OtherPacketPkt t bs) =
    object
      [ key "otherpacket" .=
        object [key "tag" .= t, key "data" .= BL.unpack bs]
      ]
  toJSON (BrokenPacketPkt s t bs) =
    object
      [ key "brokenpacket" .=
        object
          [ key "error" .= s
          , key "tag" .= t
          , key "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)