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

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

import           Prelude

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 :: AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType keyrole
keytype = do
    Seed
seed <- Word -> IO Seed
Crypto.readSeedFromSystemEntropy Word
seedSize
    SigningKey keyrole -> IO (SigningKey keyrole)
forall (m :: * -> *) a. Monad m => a -> m a
return (SigningKey keyrole -> IO (SigningKey keyrole))
-> SigningKey keyrole -> IO (SigningKey keyrole)
forall a b. (a -> b) -> a -> b
$! AsType keyrole -> Seed -> SigningKey keyrole
forall keyrole.
Key keyrole =>
AsType keyrole -> Seed -> SigningKey keyrole
deterministicSigningKey AsType keyrole
keytype Seed
seed
  where
    seedSize :: Word
seedSize = AsType keyrole -> Word
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 :: StdGen -> AsType keyrole -> IO (SigningKey keyrole, StdGen)
generateInsecureSigningKey StdGen
g AsType keyrole
keytype = do
  let (ByteString
bs, StdGen
g') = Int -> StdGen -> (ByteString, StdGen)
forall g. RandomGen g => Int -> g -> (ByteString, g)
Random.genByteString (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ AsType keyrole -> Word
forall keyrole. Key keyrole => AsType keyrole -> Word
deterministicSigningKeySeedSize AsType keyrole
keytype) StdGen
g
  case AsType (SigningKey keyrole)
-> ByteString -> Maybe (SigningKey keyrole)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes (AsType keyrole -> AsType (SigningKey keyrole)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType keyrole
keytype) ByteString
bs of
    Just SigningKey keyrole
key -> (SigningKey keyrole, StdGen) -> IO (SigningKey keyrole, StdGen)
forall (m :: * -> *) a. Monad m => a -> m a
return (SigningKey keyrole
key, StdGen
g')
    Maybe (SigningKey keyrole)
Nothing -> [Char] -> IO (SigningKey keyrole, StdGen)
forall a. HasCallStack => [Char] -> a
error [Char]
"generateInsecureSigningKey: Unable to generate insecure key"

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)
_ = AsType a -> AsType (VerificationKey a)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey (Proxy a -> AsType a
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall a. Proxy a
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)
_ = AsType a -> AsType (SigningKey a)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey (Proxy a -> AsType a
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall a. Proxy a
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