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