-- 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 qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
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