-- Pkt.hs: OpenPGP (RFC4880) Pkt data types
-- Copyright © 2012-2016  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE CPP #-}
{-# 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 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
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mempty)
#endif
import Data.Monoid ((<>))
import Data.Ord (comparing)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (Typeable)
import Data.Word (Word8)
import Text.PrettyPrint.Free (Pretty(..), (<+>), char, text)

-- 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) = text "PKESK v" <> pretty pv <> char ':' <+> pretty eoki <+> pretty pka <+> (pretty . NE.toList) mpis
    pretty (SignaturePkt sp) = pretty sp
    pretty (SKESKPkt pv sa s2k mbs) = text "SKESK v" <> pretty pv <> char ':' <+> pretty sa <+> pretty s2k <+> pretty (fmap bsToHexUpper mbs)
    pretty (OnePassSignaturePkt pv st ha pka eoki nestedflag) = text "one-pass signature v" <> pretty pv <> char ':' <+> pretty st <+> pretty ha <+> pretty pka <+> pretty eoki <+> pretty nestedflag
    pretty (SecretKeyPkt pkp ska) = text "secret key:" <+> pretty pkp <+> pretty ska
    pretty (PublicKeyPkt pkp) = text "public key:" <+> pretty pkp
    pretty (SecretSubkeyPkt pkp ska) = text "secret subkey:" <+> pretty pkp <+> pretty ska
    pretty (CompressedDataPkt ca cdp) = text "compressed-data:" <+> pretty ca <+> pretty cdp
    pretty (SymEncDataPkt bs) = text "symmetrically-encrypted-data:" <+> pretty (bsToHexUpper bs)
    pretty (MarkerPkt bs) = text "marker:" <+> pretty (bsToHexUpper bs)
    pretty (LiteralDataPkt dt fn ts bs) = text "literal-data" <+> pretty dt <+> pretty fn <+> pretty ts <+> pretty (bsToHexUpper bs)
    pretty (TrustPkt bs) = text "trust:" <+> pretty (BL.unpack bs)
    pretty (UserIdPkt u) = text "user-ID:" <+> pretty u
    pretty (PublicSubkeyPkt pkp) = text "public subkey:" <+> pretty pkp
    pretty (UserAttributePkt us) = text "user-attribute:" <+> pretty us
    pretty (SymEncIntegrityProtectedDataPkt pv bs) = text "symmetrically-encrypted-integrity-protected-data v" <> pretty pv <> char ':' <+> pretty (bsToHexUpper bs)
    pretty (ModificationDetectionCodePkt bs) = text "MDC:" <+> pretty (bsToHexUpper bs)
    pretty (OtherPacketPkt t bs) = text "unknown packet type" <+> pretty t <> char ':' <+> pretty (bsToHexUpper bs)
    pretty (BrokenPacketPkt s t bs) = text "BROKEN packet (" <> pretty s <> char ')' <+> pretty t <> char ':' <+> 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)