    -- PKITypes.hs: OpenPGP (RFC4880) data types for public/secret keys
    -- Copyright © 2012-2019  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 qualified Data.ByteString as B
    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.Text.Prettyprint.Doc (Pretty(..), (<+>))
    import Data.Typeable (Typeable)
    import Data.Word (Word16)

    data EdSigningCurve =
      Ed25519
      deriving (Data, Eq, Generic, Ord, Show, Typeable)

    instance Hashable EdSigningCurve

    instance Pretty EdSigningCurve where
      pretty Ed25519 = pretty "Ed25519"

    instance A.FromJSON EdSigningCurve

    instance A.ToJSON EdSigningCurve

    newtype EPoint =
      EPoint
        { unEPoint :: Integer
        }
      deriving (Data, Eq, Generic, Ord, Pretty, Show, Typeable)

    instance Hashable EPoint

    instance A.FromJSON EPoint

    instance A.ToJSON EPoint

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

    instance Hashable PKey

    instance Pretty PKey where
      pretty (RSAPubKey p) = pretty "RSA" <+> pretty p
      pretty (DSAPubKey p) = pretty "DSA" <+> pretty p
      pretty (ElGamalPubKey p g y) =
        pretty "Elgamal" <+> pretty p <+> pretty g <+> pretty y
      pretty (ECDHPubKey p ha sa) =
        pretty "ECDH" <+> pretty p <+> pretty ha <+> pretty sa
      pretty (ECDSAPubKey p) = pretty "ECDSA" <+> pretty p
      pretty (EdDSAPubKey c ep) = pretty c <+> pretty ep
      pretty (UnknownPKey bs) = pretty "<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 (EdDSAPubKey c ep) = A.toJSON (c, ep)
      toJSON (UnknownPKey bs) = A.toJSON (BL.unpack bs)

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

    instance Hashable SKey

    instance Pretty SKey where
      pretty (RSAPrivateKey p) = pretty "RSA" <+> pretty p
      pretty (DSAPrivateKey p) = pretty "DSA" <+> pretty p
      pretty (ElGamalPrivateKey p) = pretty "Elgamal" <+> pretty p
      pretty (ECDHPrivateKey p) = pretty "ECDH" <+> pretty p
      pretty (ECDSAPrivateKey p) = pretty "ECDSA" <+> pretty p
      pretty (EdDSAPrivateKey c bs) =
        pretty c <+> pretty (bsToHexUpper (BL.fromStrict bs))
      pretty (UnknownSKey bs) = pretty "<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 (EdDSAPrivateKey c bs) = A.toJSON (c, B.unpack bs)
      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) =
        pretty "SUS16bit" <+>
        pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)
      pretty (SUSSHA1 sa s2k iv bs) =
        pretty "SUSSHA1" <+>
        pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)
      pretty (SUSym sa iv bs) =
        pretty "SUSym" <+> pretty sa <+> pretty iv <+> pretty (bsToHexUpper bs)
      pretty (SUUnencrypted s ck) =
        pretty "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)