{-# 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
(Int -> KeyRole -> ShowS)
-> (KeyRole -> String) -> ([KeyRole] -> ShowS) -> Show KeyRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyRole -> ShowS
showsPrec :: Int -> KeyRole -> ShowS
$cshow :: KeyRole -> String
show :: KeyRole -> String
$cshowList :: [KeyRole] -> ShowS
showList :: [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 = a r -> a r'
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 = a r -> a 'Witness
forall (r :: KeyRole) (r' :: KeyRole). a r -> a r'
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 x. VKey kd -> Rep (VKey kd) x)
-> (forall x. Rep (VKey kd) x -> VKey kd) -> Generic (VKey kd)
forall x. Rep (VKey kd) x -> VKey kd
forall x. VKey kd -> Rep (VKey kd) x
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
$cfrom :: forall (kd :: KeyRole) x. VKey kd -> Rep (VKey kd) x
from :: forall x. VKey kd -> Rep (VKey kd) x
$cto :: forall (kd :: KeyRole) x. Rep (VKey kd) x -> VKey kd
to :: forall x. Rep (VKey kd) x -> VKey kd
Generic, VKey kd -> VKey kd -> Bool
(VKey kd -> VKey kd -> Bool)
-> (VKey kd -> VKey kd -> Bool) -> Eq (VKey kd)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (kd :: KeyRole). 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
/= :: VKey kd -> VKey kd -> Bool
Eq, VKey kd -> ()
(VKey kd -> ()) -> NFData (VKey kd)
forall a. (a -> ()) -> NFData a
forall (kd :: KeyRole). VKey kd -> ()
$crnf :: forall (kd :: KeyRole). VKey kd -> ()
rnf :: VKey kd -> ()
NFData, Context -> VKey kd -> IO (Maybe ThunkInfo)
Proxy (VKey kd) -> String
(Context -> VKey kd -> IO (Maybe ThunkInfo))
-> (Context -> VKey kd -> IO (Maybe ThunkInfo))
-> (Proxy (VKey kd) -> String)
-> NoThunks (VKey kd)
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
$cnoThunks :: forall (kd :: KeyRole). Context -> VKey kd -> IO (Maybe ThunkInfo)
noThunks :: Context -> VKey kd -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (kd :: KeyRole). Context -> VKey kd -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> VKey kd -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (kd :: KeyRole). Proxy (VKey kd) -> String
showTypeOf :: Proxy (VKey kd) -> String
NoThunks, Typeable (VKey kd)
Typeable (VKey kd) =>
(forall s. Decoder s (VKey kd))
-> (forall s. Proxy (VKey kd) -> Decoder s ())
-> (Proxy (VKey kd) -> Text)
-> DecCBOR (VKey kd)
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 ()
$cdecCBOR :: forall (kd :: KeyRole) s. Typeable kd => Decoder s (VKey kd)
decCBOR :: forall s. Decoder s (VKey kd)
$cdropCBOR :: forall (kd :: KeyRole) s.
Typeable kd =>
Proxy (VKey kd) -> Decoder s ()
dropCBOR :: forall s. Proxy (VKey kd) -> Decoder s ()
$clabel :: forall (kd :: KeyRole). Typeable kd => Proxy (VKey kd) -> Text
label :: Proxy (VKey kd) -> Text
DecCBOR, Typeable (VKey kd)
Typeable (VKey kd) =>
(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)
-> EncCBOR (VKey kd)
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
$cencCBOR :: forall (kd :: KeyRole). Typeable kd => VKey kd -> Encoding
encCBOR :: VKey kd -> Encoding
$cencodedSizeExpr :: 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
$cencodedListSizeExpr :: 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
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 = VerKeyDSIGN DSIGN -> VKey kd
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
VKey (VerKeyDSIGN DSIGN -> VKey kd)
-> Decoder s (VerKeyDSIGN DSIGN) -> Decoder s (VKey kd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (VerKeyDSIGN DSIGN)
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 = VerKeyDSIGN DSIGN -> Encoding
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
DSIGN.encodeVerKeyDSIGN (VerKeyDSIGN DSIGN -> Encoding)
-> (VKey kd -> VerKeyDSIGN DSIGN) -> VKey kd -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey kd -> VerKeyDSIGN DSIGN
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 = ContextDSIGN DSIGN
-> a -> SignKeyDSIGN DSIGN -> SignedDSIGN DSIGN 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 =
  (String -> Bool) -> (() -> Bool) -> Either String () -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
True) (Either String () -> Bool) -> Either String () -> Bool
forall a b. (a -> b) -> a -> b
$ ContextDSIGN DSIGN
-> VerKeyDSIGN DSIGN
-> a
-> SignedDSIGN DSIGN a
-> Either String ()
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 #-}