    -- 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