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

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

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

import GHC.Generics (Generic)

import Control.Monad (mzero)
import qualified Crypto.PubKey.RSA as RSA
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 Data.Aeson as A
import Data.Data (Data)
import Data.Hashable (Hashable(..))
import Data.Typeable (Typeable)
import Text.PrettyPrint.Free (Pretty(..), (<+>), tupled)

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