-- CryptoniteNewtypes.hs: OpenPGP (RFC4880) newtype wrappers for some cryptonite types
-- Copyright © 2012-2018  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

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

import GHC.Generics (Generic)

import Control.Monad (mzero)
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Types as ECCT
import qualified Crypto.PubKey.RSA as RSA
import qualified Data.Aeson as A
import Data.Data (Data)
import Data.Hashable (Hashable(..))
import Data.Text.Prettyprint.Doc (Pretty(..), (<+>), tupled)
import Data.Typeable (Typeable)

newtype DSA_PublicKey =
  DSA_PublicKey
    { unDSA_PublicKey :: DSA.PublicKey
    }
  deriving (Data, Eq, Generic, Show, Typeable)

instance Ord DSA_PublicKey

instance A.ToJSON DSA_PublicKey where
  toJSON (DSA_PublicKey (DSA.PublicKey p y)) = A.toJSON (DSA_Params p, y)

instance Pretty DSA_PublicKey where
  pretty (DSA_PublicKey (DSA.PublicKey p y)) =
    pretty (DSA_Params p) <+> pretty y

newtype RSA_PublicKey =
  RSA_PublicKey
    { unRSA_PublicKey :: RSA.PublicKey
    }
  deriving (Data, Eq, Generic, Show, Typeable)

instance Ord RSA_PublicKey

instance A.ToJSON RSA_PublicKey where
  toJSON (RSA_PublicKey (RSA.PublicKey size n e)) = A.toJSON (size, n, e)

instance Pretty RSA_PublicKey where
  pretty (RSA_PublicKey (RSA.PublicKey size n e)) =
    pretty size <+> pretty n <+> pretty e

newtype ECDSA_PublicKey =
  ECDSA_PublicKey
    { unECDSA_PublicKey :: ECDSA.PublicKey
    }
  deriving (Data, Eq, Generic, Show, Typeable)

instance Ord ECDSA_PublicKey

instance A.ToJSON ECDSA_PublicKey where
  toJSON (ECDSA_PublicKey (ECDSA.PublicKey curve q)) =
    A.toJSON (show curve, show q)

instance Pretty ECDSA_PublicKey where
  pretty (ECDSA_PublicKey (ECDSA.PublicKey curve q)) =
    pretty (show curve, show q)

newtype DSA_PrivateKey =
  DSA_PrivateKey
    { unDSA_PrivateKey :: DSA.PrivateKey
    }
  deriving (Data, Eq, Generic, Show, Typeable)

instance Ord DSA_PrivateKey

instance A.ToJSON DSA_PrivateKey where
  toJSON (DSA_PrivateKey (DSA.PrivateKey p x)) = A.toJSON (DSA_Params p, x)

instance Pretty DSA_PrivateKey where
  pretty (DSA_PrivateKey (DSA.PrivateKey p x)) = pretty (DSA_Params p, x)

newtype RSA_PrivateKey =
  RSA_PrivateKey
    { unRSA_PrivateKey :: RSA.PrivateKey
    }
  deriving (Data, Eq, Generic, Show, Typeable)

instance Ord RSA_PrivateKey

instance A.ToJSON RSA_PrivateKey where
  toJSON (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) =
    A.toJSON (RSA_PublicKey pub, d, p, q, dP, dQ, qinv)

instance Pretty RSA_PrivateKey where
  pretty (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) =
    pretty (RSA_PublicKey pub) <+> tupled (map pretty [d, p, q, dP, dQ, qinv])

newtype ECDSA_PrivateKey =
  ECDSA_PrivateKey
    { unECDSA_PrivateKey :: ECDSA.PrivateKey
    }
  deriving (Data, Eq, Generic, Show, Typeable)

instance Ord ECDSA_PrivateKey

instance A.ToJSON ECDSA_PrivateKey where
  toJSON (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) =
    A.toJSON (show curve, show d)

instance Pretty ECDSA_PrivateKey where
  pretty (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) =
    pretty (show curve, show d)

newtype DSA_Params =
  DSA_Params
    { unDSA_Params :: DSA.Params
    }
  deriving (Data, Eq, Generic, Show, Typeable)

instance A.ToJSON DSA_Params where
  toJSON (DSA_Params (DSA.Params p g q)) = A.toJSON (p, g, q)

instance Pretty DSA_Params where
  pretty (DSA_Params (DSA.Params p g q)) = pretty (p, g, q)

instance Hashable DSA_Params where
  hashWithSalt s (DSA_Params (DSA.Params p g q)) =
    s `hashWithSalt` p `hashWithSalt` g `hashWithSalt` q

instance Hashable DSA_PublicKey where
  hashWithSalt s (DSA_PublicKey (DSA.PublicKey p y)) =
    s `hashWithSalt` DSA_Params p `hashWithSalt` y

instance Hashable DSA_PrivateKey where
  hashWithSalt s (DSA_PrivateKey (DSA.PrivateKey p x)) =
    s `hashWithSalt` DSA_Params p `hashWithSalt` x

instance Hashable RSA_PublicKey where
  hashWithSalt s (RSA_PublicKey (RSA.PublicKey size n e)) =
    s `hashWithSalt` size `hashWithSalt` n `hashWithSalt` e

instance Hashable RSA_PrivateKey where
  hashWithSalt s (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) =
    s `hashWithSalt` RSA_PublicKey pub `hashWithSalt` d `hashWithSalt` p `hashWithSalt`
    q `hashWithSalt`
    dP `hashWithSalt`
    dQ `hashWithSalt`
    qinv

instance Hashable ECDSA_PublicKey where
  hashWithSalt s (ECDSA_PublicKey (ECDSA.PublicKey curve q)) =
    s `hashWithSalt` show curve `hashWithSalt` show q -- FIXME: don't use show

instance Hashable ECDSA_PrivateKey where
  hashWithSalt s (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) =
    s `hashWithSalt` show curve `hashWithSalt` show d -- FIXME: don't use show

newtype ECurvePoint =
  ECurvePoint
    { unECurvepoint :: ECCT.Point
    }
  deriving (Data, Eq, Generic, Show, Typeable)

instance A.ToJSON ECurvePoint where
  toJSON (ECurvePoint (ECCT.Point x y)) = A.toJSON (x, y)
  toJSON (ECurvePoint ECCT.PointO) = A.toJSON "point at infinity"

instance A.FromJSON ECurvePoint where
  parseJSON (A.Object v) = error "FIXME: whatsit"
  parseJSON _ = mzero