{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Cardano.Ledger.Shelley.Delegation.Certificates
  ( DCert (..),
    DelegCert (..),
    PoolCert (..),
    GenesisDelegCert (..),
    MIRCert (..),
    StakeCreds (..),
    delegCWitness,
    poolCWitness,
    genesisCWitness,
    isRegKey,
    isDeRegKey,
    isDelegation,
    isGenesisDelegation,
    isRegPool,
    isRetirePool,
    isInstantaneousRewards,
    isReservesMIRCert,
    isTreasuryMIRCert,
    requiresVKeyWitness,
  )
where

import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import Cardano.Ledger.Shelley.TxBody
  ( DCert (..),
    DelegCert (..),
    Delegation (..),
    GenesisDelegCert (..),
    MIRCert (..),
    MIRPot (..),
    PoolCert (..),
    PoolParams (..),
    StakeCreds (..),
  )

-- | Determine the certificate author
delegCWitness :: DelegCert crypto -> Credential 'Staking crypto
delegCWitness :: DelegCert crypto -> Credential 'Staking crypto
delegCWitness (RegKey Credential 'Staking crypto
_) = [Char] -> Credential 'Staking crypto
forall a. HasCallStack => [Char] -> a
error [Char]
"no witness in key registration certificate"
delegCWitness (DeRegKey Credential 'Staking crypto
hk) = Credential 'Staking crypto
hk
delegCWitness (Delegate Delegation crypto
delegation) = Delegation crypto -> Credential 'Staking crypto
forall crypto. Delegation crypto -> StakeCredential crypto
_delegator Delegation crypto
delegation

poolCWitness :: PoolCert crypto -> Credential 'StakePool crypto
poolCWitness :: PoolCert crypto -> Credential 'StakePool crypto
poolCWitness (RegPool PoolParams crypto
pool) = KeyHash 'StakePool crypto -> Credential 'StakePool crypto
forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
KeyHashObj (KeyHash 'StakePool crypto -> Credential 'StakePool crypto)
-> KeyHash 'StakePool crypto -> Credential 'StakePool crypto
forall a b. (a -> b) -> a -> b
$ PoolParams crypto -> KeyHash 'StakePool crypto
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
_poolId PoolParams crypto
pool
poolCWitness (RetirePool KeyHash 'StakePool crypto
k EpochNo
_) = KeyHash 'StakePool crypto -> Credential 'StakePool crypto
forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
KeyHashObj KeyHash 'StakePool crypto
k

genesisCWitness :: GenesisDelegCert crypto -> KeyHash 'Genesis crypto
genesisCWitness :: GenesisDelegCert crypto -> KeyHash 'Genesis crypto
genesisCWitness (GenesisDelegCert KeyHash 'Genesis crypto
gk KeyHash 'GenesisDelegate crypto
_ Hash crypto (VerKeyVRF crypto)
_) = KeyHash 'Genesis crypto
gk

-- | Check for 'RegKey' constructor
isRegKey :: DCert crypto -> Bool
isRegKey :: DCert crypto -> Bool
isRegKey (DCertDeleg (RegKey StakeCredential crypto
_)) = Bool
True
isRegKey DCert crypto
_ = Bool
False

-- | Check for 'DeRegKey' constructor
isDeRegKey :: DCert crypto -> Bool
isDeRegKey :: DCert crypto -> Bool
isDeRegKey (DCertDeleg (DeRegKey StakeCredential crypto
_)) = Bool
True
isDeRegKey DCert crypto
_ = Bool
False

-- | Check for 'Delegation' constructor
isDelegation :: DCert crypto -> Bool
isDelegation :: DCert crypto -> Bool
isDelegation (DCertDeleg (Delegate Delegation crypto
_)) = Bool
True
isDelegation DCert crypto
_ = Bool
False

-- | Check for 'GenesisDelegate' constructor
isGenesisDelegation :: DCert crypto -> Bool
isGenesisDelegation :: DCert crypto -> Bool
isGenesisDelegation (DCertGenesis GenesisDelegCert {}) = Bool
True
isGenesisDelegation DCert crypto
_ = Bool
False

-- | Check for 'RegPool' constructor
isRegPool :: DCert crypto -> Bool
isRegPool :: DCert crypto -> Bool
isRegPool (DCertPool (RegPool PoolParams crypto
_)) = Bool
True
isRegPool DCert crypto
_ = Bool
False

-- | Check for 'RetirePool' constructor
isRetirePool :: DCert crypto -> Bool
isRetirePool :: DCert crypto -> Bool
isRetirePool (DCertPool (RetirePool KeyHash 'StakePool crypto
_ EpochNo
_)) = Bool
True
isRetirePool DCert crypto
_ = Bool
False

isInstantaneousRewards :: DCert crypto -> Bool
isInstantaneousRewards :: DCert crypto -> Bool
isInstantaneousRewards (DCertMir MIRCert crypto
_) = Bool
True
isInstantaneousRewards DCert crypto
_ = Bool
False

isReservesMIRCert :: DCert crypto -> Bool
isReservesMIRCert :: DCert crypto -> Bool
isReservesMIRCert (DCertMir (MIRCert MIRPot
ReservesMIR MIRTarget crypto
_)) = Bool
True
isReservesMIRCert DCert crypto
_ = Bool
False

isTreasuryMIRCert :: DCert crypto -> Bool
isTreasuryMIRCert :: DCert crypto -> Bool
isTreasuryMIRCert (DCertMir (MIRCert MIRPot
TreasuryMIR MIRTarget crypto
_)) = Bool
True
isTreasuryMIRCert DCert crypto
_ = Bool
False

-- | Returns True for delegation certificates that require at least
-- one witness, and False otherwise. It is mainly used to ensure
-- that calling a variant of 'cwitness' is safe.
requiresVKeyWitness :: DCert crypto -> Bool
requiresVKeyWitness :: DCert crypto -> Bool
requiresVKeyWitness (DCertMir (MIRCert MIRPot
_ MIRTarget crypto
_)) = Bool
False
requiresVKeyWitness (DCertDeleg (RegKey StakeCredential crypto
_)) = Bool
False
requiresVKeyWitness DCert crypto
_ = Bool
True