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

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}

module Codec.Encryption.OpenPGP.Types.Internal.PKITypes where

import GHC.Generics (Generic)

import Codec.Encryption.OpenPGP.Types.Internal.Base
import Codec.Encryption.OpenPGP.Types.Internal.CryptoniteNewtypes

import qualified Data.Aeson as A
import qualified Data.Aeson.TH as ATH
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Data (Data)
import Data.Hashable (Hashable(..))
import Data.Monoid ((<>))
import Data.Ord (comparing)
import Data.Typeable (Typeable)
import Data.Word (Word16)
import Text.PrettyPrint.Free (Pretty(..), (<+>), text)

data PKey = RSAPubKey RSA_PublicKey
          | DSAPubKey DSA_PublicKey
          | ElGamalPubKey Integer Integer Integer
          | ECDHPubKey ECDSA_PublicKey HashAlgorithm SymmetricAlgorithm
          | ECDSAPubKey ECDSA_PublicKey
          | UnknownPKey ByteString
    deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Hashable PKey

instance Pretty PKey where
    pretty (RSAPubKey p) = text "RSA" <+> pretty p
    pretty (DSAPubKey p) = text "DSA" <+> pretty p
    pretty (ElGamalPubKey p g y) = text "Elgamal" <+> pretty p <+> pretty g <+> pretty y
    pretty (ECDHPubKey p ha sa) = text "ECDH" <+> pretty p <+> pretty ha <+> pretty sa
    pretty (ECDSAPubKey p) = text "ECDSA" <+> pretty p
    pretty (UnknownPKey bs) = text "<unknown>" <+> pretty (bsToHexUpper bs)

instance A.ToJSON PKey where
    toJSON (RSAPubKey p) = A.toJSON p
    toJSON (DSAPubKey p) = A.toJSON p
    toJSON (ElGamalPubKey p g y) = A.toJSON (p, g, y)
    toJSON (ECDHPubKey p ha sa) = A.toJSON (p, ha, sa)
    toJSON (ECDSAPubKey p) = A.toJSON p
    toJSON (UnknownPKey bs) = A.toJSON (BL.unpack bs)

data SKey = RSAPrivateKey RSA_PrivateKey
          | DSAPrivateKey DSA_PrivateKey
          | ElGamalPrivateKey Integer
          | ECDHPrivateKey ECDSA_PrivateKey
          | ECDSAPrivateKey ECDSA_PrivateKey
          | UnknownSKey ByteString
    deriving (Data, Eq, Generic, Show, Typeable)

instance Hashable SKey

instance Pretty SKey where
    pretty (RSAPrivateKey p) = text "RSA" <+> pretty p
    pretty (DSAPrivateKey p) = text "DSA" <+> pretty p
    pretty (ElGamalPrivateKey p) = text "Elgamal" <+> pretty p
    pretty (ECDHPrivateKey p) = text "ECDH" <+> pretty p
    pretty (ECDSAPrivateKey p) = text "ECDSA" <+> pretty p
    pretty (UnknownSKey bs) = text "<unknown>" <+> pretty (bsToHexUpper bs)

instance A.ToJSON SKey where
    toJSON (RSAPrivateKey k) = A.toJSON k
    toJSON (DSAPrivateKey k) = A.toJSON k
    toJSON (ElGamalPrivateKey k) = A.toJSON k
    toJSON (ECDHPrivateKey k) = A.toJSON k
    toJSON (ECDSAPrivateKey k) = A.toJSON k
    toJSON (UnknownSKey bs) = A.toJSON (BL.unpack bs)

data PKPayload = PKPayload {
      _keyVersion :: KeyVersion
    , _timestamp :: ThirtyTwoBitTimeStamp
    , _v3exp :: V3Expiration
    , _pkalgo :: PubKeyAlgorithm
    , _pubkey :: PKey
    } deriving (Data, Eq, Generic, Show, Typeable)

instance Ord PKPayload where
    compare = comparing _keyVersion <> comparing _timestamp <> comparing _v3exp <> comparing _pkalgo <> comparing _pubkey

instance Hashable PKPayload

instance Pretty PKPayload where
    pretty (PKPayload kv ts v3e pka p) = pretty kv <+> pretty ts <+> pretty v3e <+> pretty pka <+> pretty p

$(ATH.deriveToJSON ATH.defaultOptions ''PKPayload)

data SKAddendum = SUS16bit SymmetricAlgorithm S2K IV ByteString
                | SUSSHA1 SymmetricAlgorithm S2K IV ByteString
                | SUSym SymmetricAlgorithm IV ByteString
                | SUUnencrypted SKey Word16
    deriving (Data, Eq, Generic, Show, Typeable)

instance Ord SKAddendum where
    compare a b = show a `compare` show b -- FIXME: this is ridiculous

instance Hashable SKAddendum

instance Pretty SKAddendum where
    pretty (SUS16bit sa s2k iv bs) = text "SUS16bit" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)
    pretty (SUSSHA1 sa s2k iv bs) = text "SUSSHA1" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)
    pretty (SUSym sa iv bs) = text "SUSym" <+> pretty sa <+> pretty iv <+> pretty (bsToHexUpper bs)
    pretty (SUUnencrypted s ck) = text "SUUnencrypted" <+> pretty s <+> pretty ck

instance A.ToJSON SKAddendum where
    toJSON (SUS16bit sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs)
    toJSON (SUSSHA1 sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs)
    toJSON (SUSym sa iv bs) = A.toJSON (sa, iv, BL.unpack bs)
    toJSON (SUUnencrypted s ck) = A.toJSON (s, ck)