{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}

module Cardano.Ledger.Keys.Internal (
  -- * DSIGN
  DSIGN,
  DSignable,
  VKey (..),
  signedDSIGN,
  verifySignedDSIGN,

  -- * Key roles
  KeyRole (..),
  HasKeyRole (..),
  asWitness,

  -- * Re-exports from cardano-crypto-class
  decodeSignedDSIGN,
  encodeSignedDSIGN,
)
where

import Cardano.Crypto.DSIGN hiding (
  decodeSignedDSIGN,
  encodeSignedDSIGN,
  signedDSIGN,
  verifySignedDSIGN,
 )
import qualified Cardano.Crypto.DSIGN as DSIGN
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
 )
import Cardano.Ledger.Binary.Crypto
import Cardano.Ledger.Orphans ()
import Control.DeepSeq (NFData)
import Data.Coerce (Coercible, coerce)
import Data.Kind (Type)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Quiet

-- | Cryptographic signing algorithm used on Cardano blockchain.
type DSIGN = DSIGN.Ed25519DSIGN

-- | The role of a key.
--
-- All key roles are __fixed__ and unique, except for the `Witness` role. In particular,
-- keys can be cast to a `Witness` role with the help of `asWitness`, because same witness
-- can be valid for many roles.
--
-- In fact, it is perfectly allowable for a key to be used in many roles by the end user;
-- there is nothing prohibiting somebody using the same underlying key or a script as
-- their payment and staking credential, as well as the key for their stake pool. However,
-- in the ledger code mixing up keys with different roles could be catastrophic, that is
-- why we have this separation.
data KeyRole
  = Genesis
  | GenesisDelegate
  | Payment
  | Staking
  | StakePool
  | BlockIssuer
  | Witness
  | DRepRole
  | HotCommitteeRole
  | ColdCommitteeRole
  deriving (Int -> KeyRole -> ShowS
[KeyRole] -> ShowS
KeyRole -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyRole] -> ShowS
$cshowList :: [KeyRole] -> ShowS
show :: KeyRole -> String
$cshow :: KeyRole -> String
showsPrec :: Int -> KeyRole -> ShowS
$cshowsPrec :: Int -> KeyRole -> ShowS
Show)

class HasKeyRole (a :: KeyRole -> Type) where
  -- | General coercion of key roles.
  --
  --   The presence of this function is mostly to help the user realise where they
  --   are converting key roles.
  coerceKeyRole ::
    a r ->
    a r'
  default coerceKeyRole ::
    Coercible (a r) (a r') =>
    a r ->
    a r'
  coerceKeyRole = coerce :: forall a b. Coercible a b => a -> b
coerce

-- | Use a key as a witness.
--
--   This is the most common coercion between key roles, because most keys can
--   be used as witnesses to some types of transaction. As such, we provide an
--   explicit coercion for it.
asWitness ::
  HasKeyRole a =>
  a r ->
  a 'Witness
asWitness :: forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness = forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole

--------------------------------------------------------------------------------
-- Verification keys
--------------------------------------------------------------------------------

type DSignable = DSIGN.Signable DSIGN

-- | Discriminated verification key
--
--   We wrap the basic `VerKeyDSIGN` in order to add the key role.
newtype VKey (kd :: KeyRole) = VKey {forall (kd :: KeyRole). VKey kd -> VerKeyDSIGN DSIGN
unVKey :: DSIGN.VerKeyDSIGN DSIGN}
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (kd :: KeyRole) x. Rep (VKey kd) x -> VKey kd
forall (kd :: KeyRole) x. VKey kd -> Rep (VKey kd) x
$cto :: forall (kd :: KeyRole) x. Rep (VKey kd) x -> VKey kd
$cfrom :: forall (kd :: KeyRole) x. VKey kd -> Rep (VKey kd) x
Generic, VKey kd -> VKey kd -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (kd :: KeyRole). VKey kd -> VKey kd -> Bool
/= :: VKey kd -> VKey kd -> Bool
$c/= :: forall (kd :: KeyRole). VKey kd -> VKey kd -> Bool
== :: VKey kd -> VKey kd -> Bool
$c== :: forall (kd :: KeyRole). VKey kd -> VKey kd -> Bool
Eq, VKey kd -> ()
forall a. (a -> ()) -> NFData a
forall (kd :: KeyRole). VKey kd -> ()
rnf :: VKey kd -> ()
$crnf :: forall (kd :: KeyRole). VKey kd -> ()
NFData, Context -> VKey kd -> IO (Maybe ThunkInfo)
Proxy (VKey kd) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (kd :: KeyRole). Context -> VKey kd -> IO (Maybe ThunkInfo)
forall (kd :: KeyRole). Proxy (VKey kd) -> String
showTypeOf :: Proxy (VKey kd) -> String
$cshowTypeOf :: forall (kd :: KeyRole). Proxy (VKey kd) -> String
wNoThunks :: Context -> VKey kd -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (kd :: KeyRole). Context -> VKey kd -> IO (Maybe ThunkInfo)
noThunks :: Context -> VKey kd -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (kd :: KeyRole). Context -> VKey kd -> IO (Maybe ThunkInfo)
NoThunks, Proxy (VKey kd) -> Text
forall s. Decoder s (VKey kd)
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (VKey kd) -> Decoder s ()
forall {kd :: KeyRole}. Typeable kd => Typeable (VKey kd)
forall (kd :: KeyRole). Typeable kd => Proxy (VKey kd) -> Text
forall (kd :: KeyRole) s. Typeable kd => Decoder s (VKey kd)
forall (kd :: KeyRole) s.
Typeable kd =>
Proxy (VKey kd) -> Decoder s ()
label :: Proxy (VKey kd) -> Text
$clabel :: forall (kd :: KeyRole). Typeable kd => Proxy (VKey kd) -> Text
dropCBOR :: forall s. Proxy (VKey kd) -> Decoder s ()
$cdropCBOR :: forall (kd :: KeyRole) s.
Typeable kd =>
Proxy (VKey kd) -> Decoder s ()
decCBOR :: forall s. Decoder s (VKey kd)
$cdecCBOR :: forall (kd :: KeyRole) s. Typeable kd => Decoder s (VKey kd)
DecCBOR, VKey kd -> Encoding
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy [VKey kd] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy (VKey kd) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
forall {kd :: KeyRole}. Typeable kd => Typeable (VKey kd)
forall (kd :: KeyRole). Typeable kd => VKey kd -> Encoding
forall (kd :: KeyRole).
Typeable kd =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy [VKey kd] -> Size
forall (kd :: KeyRole).
Typeable kd =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy (VKey kd) -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [VKey kd] -> Size
$cencodedListSizeExpr :: forall (kd :: KeyRole).
Typeable kd =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy [VKey kd] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy (VKey kd) -> Size
$cencodedSizeExpr :: forall (kd :: KeyRole).
Typeable kd =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy (VKey kd) -> Size
encCBOR :: VKey kd -> Encoding
$cencCBOR :: forall (kd :: KeyRole). Typeable kd => VKey kd -> Encoding
EncCBOR)

deriving via Quiet (VKey kd) instance Show (VKey kd)

instance HasKeyRole VKey

instance Typeable kd => FromCBOR (VKey kd) where
  fromCBOR :: forall s. Decoder s (VKey kd)
fromCBOR = forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
VKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v s. DSIGNAlgorithm v => Decoder s (VerKeyDSIGN v)
DSIGN.decodeVerKeyDSIGN
  {-# INLINE fromCBOR #-}

instance Typeable kd => ToCBOR (VKey kd) where
  toCBOR :: VKey kd -> Encoding
toCBOR = forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
DSIGN.encodeVerKeyDSIGN forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). VKey kd -> VerKeyDSIGN DSIGN
unVKey

-- | Produce a digital signature
signedDSIGN ::
  Signable DSIGN a =>
  SignKeyDSIGN DSIGN ->
  a ->
  SignedDSIGN DSIGN a
signedDSIGN :: forall a.
Signable DSIGN a =>
SignKeyDSIGN DSIGN -> a -> SignedDSIGN DSIGN a
signedDSIGN SignKeyDSIGN DSIGN
key a
a = forall v a.
(DSIGNAlgorithm v, Signable v a) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SignedDSIGN v a
DSIGN.signedDSIGN () a
a SignKeyDSIGN DSIGN
key

-- | Verify a digital signature
verifySignedDSIGN ::
  Signable DSIGN a =>
  VKey kd ->
  a ->
  SignedDSIGN DSIGN a ->
  Bool
verifySignedDSIGN :: forall a (kd :: KeyRole).
Signable DSIGN a =>
VKey kd -> a -> SignedDSIGN DSIGN a -> Bool
verifySignedDSIGN (VKey VerKeyDSIGN DSIGN
vk) a
vd SignedDSIGN DSIGN a
sigDSIGN =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
False) (forall a b. a -> b -> a
const Bool
True) forall a b. (a -> b) -> a -> b
$ forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SignedDSIGN v a -> Either String ()
DSIGN.verifySignedDSIGN () VerKeyDSIGN DSIGN
vk a
vd SignedDSIGN DSIGN a
sigDSIGN
{-# INLINE verifySignedDSIGN #-}