{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Api.Keys.Class
  ( Key(..)
  , generateSigningKey
  , generateInsecureSigningKey
  , CastVerificationKeyRole(..)
  , CastSigningKeyRole(..)
  , AsType(AsVerificationKey, AsSigningKey)
  ) where

import           Data.Kind (Type)

import qualified Cardano.Crypto.DSIGN.Class as Crypto
import qualified Cardano.Crypto.Seed as Crypto

import           Cardano.Api.Hash
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseTextEnvelope
import           System.Random (StdGen)

import qualified System.Random as Random

-- | An interface for cryptographic keys used for signatures with a 'SigningKey'
-- and a 'VerificationKey' key.
--
-- This interface does not provide actual signing or verifying functions since
-- this API is concerned with the management of keys: generating and
-- serialising.
--
class (Eq (VerificationKey keyrole),
       Show (VerificationKey keyrole),
       SerialiseAsRawBytes (Hash keyrole),
       HasTextEnvelope (VerificationKey keyrole),
       HasTextEnvelope (SigningKey keyrole))
    => Key keyrole where

    -- | The type of cryptographic verification key, for each key role.
    data VerificationKey keyrole :: Type

    -- | The type of cryptographic signing key, for each key role.
    data SigningKey keyrole :: Type

    -- | Get the corresponding verification key from a signing key.
    getVerificationKey :: SigningKey keyrole -> VerificationKey keyrole

    -- | Generate a 'SigningKey' deterministically, given a 'Crypto.Seed'. The
    -- required size of the seed is given by 'deterministicSigningKeySeedSize'.
    --
    deterministicSigningKey :: AsType keyrole -> Crypto.Seed -> SigningKey keyrole
    deterministicSigningKeySeedSize :: AsType keyrole -> Word

    verificationKeyHash :: VerificationKey keyrole -> Hash keyrole


-- TODO: We should move this into the Key type class, with the existing impl as the default impl.
-- For KES we can then override it to keep the seed and key in mlocked memory at all times.
-- | Generate a 'SigningKey' using a seed from operating system entropy.
--
generateSigningKey :: Key keyrole => AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey :: forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType keyrole
keytype = do
    Seed
seed <- Word -> IO Seed
Crypto.readSeedFromSystemEntropy Word
seedSize
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall keyrole.
Key keyrole =>
AsType keyrole -> Seed -> SigningKey keyrole
deterministicSigningKey AsType keyrole
keytype Seed
seed
  where
    seedSize :: Word
seedSize = forall keyrole. Key keyrole => AsType keyrole -> Word
deterministicSigningKeySeedSize AsType keyrole
keytype


generateInsecureSigningKey
  :: (Key keyrole, SerialiseAsRawBytes (SigningKey keyrole))
  => StdGen
  -> AsType keyrole
  -> IO (SigningKey keyrole, StdGen)
generateInsecureSigningKey :: forall keyrole.
(Key keyrole, SerialiseAsRawBytes (SigningKey keyrole)) =>
StdGen -> AsType keyrole -> IO (SigningKey keyrole, StdGen)
generateInsecureSigningKey StdGen
g AsType keyrole
keytype = do
  let (ByteString
bs, StdGen
g') = forall g. RandomGen g => Int -> g -> (ByteString, g)
Random.genByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall keyrole. Key keyrole => AsType keyrole -> Word
deterministicSigningKeySeedSize AsType keyrole
keytype) StdGen
g
  case forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType keyrole
keytype) ByteString
bs of
    Right SigningKey keyrole
key -> forall (m :: * -> *) a. Monad m => a -> m a
return (SigningKey keyrole
key, StdGen
g')
    Left (SerialiseAsRawBytesError [Char]
msg) -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"generateInsecureSigningKey: Unable to generate insecure key: " forall a. Semigroup a => a -> a -> a
<> [Char]
msg

instance HasTypeProxy a => HasTypeProxy (VerificationKey a) where
    data AsType (VerificationKey a) = AsVerificationKey (AsType a)
    proxyToAsType :: Proxy (VerificationKey a) -> AsType (VerificationKey a)
proxyToAsType Proxy (VerificationKey a)
_ = forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey (forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

instance HasTypeProxy a => HasTypeProxy (SigningKey a) where
    data AsType (SigningKey a) = AsSigningKey (AsType a)
    proxyToAsType :: Proxy (SigningKey a) -> AsType (SigningKey a)
proxyToAsType Proxy (SigningKey a)
_ = forall a. AsType a -> AsType (SigningKey a)
AsSigningKey (forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))


-- | Some key roles share the same representation and it is sometimes
-- legitimate to change the role of a key.
--
class CastVerificationKeyRole keyroleA keyroleB where

    -- | Change the role of a 'VerificationKey', if the representation permits.
    castVerificationKey :: VerificationKey keyroleA -> VerificationKey keyroleB

class CastSigningKeyRole keyroleA keyroleB where

    -- | Change the role of a 'SigningKey', if the representation permits.
    castSigningKey :: SigningKey keyroleA -> SigningKey keyroleB