{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Test.Cardano.Ledger.Shelley.Generator.TxCert (
  genTxCert,
  CertCred (..),
)
where

import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.Coin (DeltaCoin (..), toDeltaCoin)
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Keys (
  coerceKeyRole,
  hashKey,
  hashVerKeyVRF,
 )
import Cardano.Ledger.Shelley.API (
  AccountState (..),
  CertState (..),
  Coin (..),
  Credential (..),
  DState (..),
  GenDelegPair (..),
  GenDelegs (..),
  KeyHash,
  KeyRole (..),
  Network (..),
  PState (..),
  PoolParams (..),
  StrictMaybe (..),
  VKey,
 )
import Cardano.Ledger.Shelley.Core
import qualified Cardano.Ledger.Shelley.HardForks as HardForks
import Cardano.Ledger.Shelley.LedgerState (availableAfterMIR, rewards)
import Cardano.Ledger.Slot (EpochNo (EpochNo), SlotNo)
import qualified Cardano.Ledger.UMap as UM
import Control.Monad (replicateM)
import Control.SetAlgebra (dom, domain, eval, (∈))
import Data.Foldable (fold)
import qualified Data.List as List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map (elems, fromList, lookup)
import Data.Maybe (fromMaybe)
import Data.Ratio ((%))
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set ((\\))
import qualified Data.Set as Set
import Lens.Micro ((^.))
import Numeric.Natural (Natural)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair, KeyPairs, vKey)
import Test.Cardano.Ledger.Shelley.Constants (Constants (..))
import Test.Cardano.Ledger.Shelley.Generator.Core (
  AllIssuerKeys (..),
  KeySpace (..),
  genInteger,
  genWord64,
  mkCred,
  tooLateInEpoch,
 )
import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen)
import Test.Cardano.Ledger.Shelley.Utils
import Test.Cardano.Protocol.TPraos.Create (VRFKeyPair (..))
import Test.QuickCheck (Gen)
import qualified Test.QuickCheck as QC

-- ======================================================

data CertCred era
  = CoreKeyCred [GenesisKeyPair (EraCrypto era)]
  | StakeCred (KeyPair 'Staking (EraCrypto era))
  | PoolCred (KeyPair 'StakePool (EraCrypto era))
  | ScriptCred (Script era, Script era)
  | DelegateCred [KeyPair 'GenesisDelegate (EraCrypto era)]
  | NoCred

deriving instance (Era era, Show (Script era)) => Show (CertCred era)

-- | Occasionally generate a valid certificate
--
-- Returning `Nothing` indicates a failure to generate a value, usually due to lack of
-- available values from the pre-populated (e.g. key) spaces.
-- A `Just` represents a successfully generated value.
--
-- Different generators return witnesses that are either genesis or regular keys.
--
-- Note: we register keys and pools more often than deregistering/retiring them,
-- and we generate more delegations than registrations of keys/pools.
genTxCert ::
  forall era.
  (EraGen era, ProtVerAtMost era 8) =>
  Constants ->
  KeySpace era ->
  PParams era ->
  AccountState ->
  CertState era ->
  SlotNo ->
  Gen (Maybe (TxCert era, CertCred era))
genTxCert :: forall era.
(EraGen era, ProtVerAtMost era 8) =>
Constants
-> KeySpace era
-> PParams era
-> AccountState
-> CertState era
-> SlotNo
-> Gen (Maybe (TxCert era, CertCred era))
genTxCert
  c :: Constants
c@( Constants
        { Int
frequencyRegCert :: Constants -> Int
frequencyRegCert :: Int
frequencyRegCert
        , Int
frequencyRegPoolCert :: Constants -> Int
frequencyRegPoolCert :: Int
frequencyRegPoolCert
        , Int
frequencyDelegCert :: Constants -> Int
frequencyDelegCert :: Int
frequencyDelegCert
        , Int
frequencyGenesisDelegationCert :: Constants -> Int
frequencyGenesisDelegationCert :: Int
frequencyGenesisDelegationCert
        , Int
frequencyDeRegKeyCert :: Constants -> Int
frequencyDeRegKeyCert :: Int
frequencyDeRegKeyCert
        , Int
frequencyRetirePoolCert :: Constants -> Int
frequencyRetirePoolCert :: Int
frequencyRetirePoolCert
        , Int
frequencyMIRCert :: Constants -> Int
frequencyMIRCert :: Int
frequencyMIRCert
        }
      )
  KeySpace_
    { [(GenesisKeyPair (EraCrypto era),
  AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
ksCoreNodes :: forall era.
KeySpace era
-> [(GenesisKeyPair (EraCrypto era),
     AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
ksCoreNodes :: [(GenesisKeyPair (EraCrypto era),
  AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
ksCoreNodes
    , KeyPairs (EraCrypto era)
ksKeyPairs :: forall era. KeySpace era -> KeyPairs (EraCrypto era)
ksKeyPairs :: KeyPairs (EraCrypto era)
ksKeyPairs
    , [(Script era, Script era)]
ksMSigScripts :: forall era. KeySpace era -> [(Script era, Script era)]
ksMSigScripts :: [(Script era, Script era)]
ksMSigScripts
    , [AllIssuerKeys (EraCrypto era) 'StakePool]
ksStakePools :: forall era.
KeySpace era -> [AllIssuerKeys (EraCrypto era) 'StakePool]
ksStakePools :: [AllIssuerKeys (EraCrypto era) 'StakePool]
ksStakePools
    , [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
ksGenesisDelegates :: forall era.
KeySpace era -> [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
ksGenesisDelegates :: [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
ksGenesisDelegates
    , Map
  (KeyHash 'GenesisDelegate (EraCrypto era))
  (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
ksIndexedGenDelegates :: forall era.
KeySpace era
-> Map
     (KeyHash 'GenesisDelegate (EraCrypto era))
     (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
ksIndexedGenDelegates :: Map
  (KeyHash 'GenesisDelegate (EraCrypto era))
  (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
ksIndexedGenDelegates
    }
  PParams era
pparams
  AccountState
accountState
  CertState era
dpState
  SlotNo
slot =
    forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency
      [ (Int
frequencyRegCert, forall era.
(EraScript era, ShelleyEraTxCert era) =>
Constants
-> KeyPairs (EraCrypto era)
-> [(Script era, Script era)]
-> DState era
-> Gen (Maybe (TxCert era, CertCred era))
genRegKeyCert Constants
c KeyPairs (EraCrypto era)
ksKeyPairs [(Script era, Script era)]
ksMSigScripts DState era
dState)
      , (Int
frequencyRegPoolCert, forall era.
(Era era, EraTxCert era) =>
[AllIssuerKeys (EraCrypto era) 'StakePool]
-> KeyPairs (EraCrypto era)
-> Coin
-> Gen (Maybe (TxCert era, CertCred era))
genRegPool [AllIssuerKeys (EraCrypto era) 'StakePool]
ksStakePools KeyPairs (EraCrypto era)
ksKeyPairs (PParams era
pparams forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinPoolCostL))
      , (Int
frequencyDelegCert, forall era.
(EraScript era, ShelleyEraTxCert era) =>
Constants
-> KeyPairs (EraCrypto era)
-> [(Script era, Script era)]
-> CertState era
-> Gen (Maybe (TxCert era, CertCred era))
genDelegation Constants
c KeyPairs (EraCrypto era)
ksKeyPairs [(Script era, Script era)]
ksMSigScripts CertState era
dpState)
      ,
        ( Int
frequencyGenesisDelegationCert
        , forall era.
(Era era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
[(GenesisKeyPair (EraCrypto era),
  AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
-> [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
-> CertState era
-> Gen (Maybe (TxCert era, CertCred era))
genGenesisDelegation [(GenesisKeyPair (EraCrypto era),
  AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
ksCoreNodes [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
ksGenesisDelegates CertState era
dpState
        )
      , (Int
frequencyDeRegKeyCert, forall era.
(EraScript era, ShelleyEraTxCert era) =>
Constants
-> KeyPairs (EraCrypto era)
-> [(Script era, Script era)]
-> DState era
-> Gen (Maybe (TxCert era, CertCred era))
genDeRegKeyCert Constants
c KeyPairs (EraCrypto era)
ksKeyPairs [(Script era, Script era)]
ksMSigScripts DState era
dState)
      , (Int
frequencyRetirePoolCert, forall era.
(EraPParams era, EraTxCert era) =>
PParams era
-> [AllIssuerKeys (EraCrypto era) 'StakePool]
-> PState era
-> SlotNo
-> Gen (Maybe (TxCert era, CertCred era))
genRetirePool PParams era
pparams [AllIssuerKeys (EraCrypto era) 'StakePool]
ksStakePools PState era
pState SlotNo
slot)
      ,
        ( Int
frequencyMIRCert
        , forall era.
(EraPParams era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
SlotNo
-> Map
     (KeyHash 'GenesisDelegate (EraCrypto era))
     (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
-> PParams era
-> AccountState
-> DState era
-> Gen (Maybe (TxCert era, CertCred era))
genInstantaneousRewards
            SlotNo
slot
            Map
  (KeyHash 'GenesisDelegate (EraCrypto era))
  (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
ksIndexedGenDelegates
            PParams era
pparams
            AccountState
accountState
            DState era
dState
        )
      ]
    where
      dState :: DState era
dState = forall era. CertState era -> DState era
certDState CertState era
dpState
      pState :: PState era
pState = forall era. CertState era -> PState era
certPState CertState era
dpState

-- | Generate a RegKey certificate
genRegKeyCert ::
  forall era.
  (EraScript era, ShelleyEraTxCert era) =>
  Constants ->
  KeyPairs (EraCrypto era) ->
  [(Script era, Script era)] ->
  DState era ->
  Gen (Maybe (TxCert era, CertCred era))
genRegKeyCert :: forall era.
(EraScript era, ShelleyEraTxCert era) =>
Constants
-> KeyPairs (EraCrypto era)
-> [(Script era, Script era)]
-> DState era
-> Gen (Maybe (TxCert era, CertCred era))
genRegKeyCert
  Constants {Int
frequencyKeyCredReg :: Constants -> Int
frequencyKeyCredReg :: Int
frequencyKeyCredReg, Int
frequencyScriptCredReg :: Constants -> Int
frequencyScriptCredReg :: Int
frequencyScriptCredReg}
  KeyPairs (EraCrypto era)
keys
  [(Script era, Script era)]
scripts
  DState era
delegSt =
    forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency
      [
        ( Int
frequencyKeyCredReg
        , case KeyPairs (EraCrypto era)
availableKeys of
            [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
            KeyPairs (EraCrypto era)
_ -> do
              (KeyPair 'Payment (EraCrypto era)
_payKey, KeyPair 'Staking (EraCrypto era)
stakeKey) <- forall a. HasCallStack => [a] -> Gen a
QC.elements KeyPairs (EraCrypto era)
availableKeys
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
                forall a. a -> Maybe a
Just
                  ( forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
RegTxCert (forall c (kr :: KeyRole).
Crypto c =>
KeyPair kr c -> Credential kr c
mkCred KeyPair 'Staking (EraCrypto era)
stakeKey)
                  , forall era. CertCred era
NoCred
                  )
        )
      ,
        ( Int
frequencyScriptCredReg
        , case [(Script era, Script era)]
availableScripts of
            [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
            [(Script era, Script era)]
_ -> do
              (Script era
_, Script era
stakeScript) <- forall a. HasCallStack => [a] -> Gen a
QC.elements [(Script era, Script era)]
availableScripts
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
                forall a. a -> Maybe a
Just
                  ( forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
RegTxCert (Script era -> Credential 'Staking (EraCrypto era)
scriptToCred' Script era
stakeScript)
                  , forall era. CertCred era
NoCred
                  )
        )
      ]
    where
      scriptToCred' :: Script era -> Credential 'Staking (EraCrypto era)
scriptToCred' = forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era
      notRegistered :: Credential 'Staking (EraCrypto era) -> Bool
notRegistered Credential 'Staking (EraCrypto era)
k = forall k c v. k -> UView c k v -> Bool
UM.notMember Credential 'Staking (EraCrypto era)
k (forall era.
DState era
-> UView
     (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
delegSt)
      availableKeys :: KeyPairs (EraCrypto era)
availableKeys = forall a. (a -> Bool) -> [a] -> [a]
filter (Credential 'Staking (EraCrypto era) -> Bool
notRegistered forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kr :: KeyRole).
Crypto c =>
KeyPair kr c -> Credential kr c
mkCred forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) KeyPairs (EraCrypto era)
keys
      availableScripts :: [(Script era, Script era)]
availableScripts = forall a. (a -> Bool) -> [a] -> [a]
filter (Credential 'Staking (EraCrypto era) -> Bool
notRegistered forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script era -> Credential 'Staking (EraCrypto era)
scriptToCred' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Script era, Script era)]
scripts

-- | Generate a DeRegKey certificate along with the staking credential, which is
-- needed to witness the certificate.
genDeRegKeyCert ::
  forall era.
  (EraScript era, ShelleyEraTxCert era) =>
  Constants ->
  KeyPairs (EraCrypto era) ->
  [(Script era, Script era)] ->
  DState era ->
  Gen (Maybe (TxCert era, CertCred era))
genDeRegKeyCert :: forall era.
(EraScript era, ShelleyEraTxCert era) =>
Constants
-> KeyPairs (EraCrypto era)
-> [(Script era, Script era)]
-> DState era
-> Gen (Maybe (TxCert era, CertCred era))
genDeRegKeyCert Constants {Int
frequencyKeyCredDeReg :: Constants -> Int
frequencyKeyCredDeReg :: Int
frequencyKeyCredDeReg, Int
frequencyScriptCredDeReg :: Constants -> Int
frequencyScriptCredDeReg :: Int
frequencyScriptCredDeReg} KeyPairs (EraCrypto era)
keys [(Script era, Script era)]
scripts DState era
dState =
  forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency
    [
      ( Int
frequencyKeyCredDeReg
      , case KeyPairs (EraCrypto era)
availableKeys of
          [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
          KeyPairs (EraCrypto era)
_ -> do
            (KeyPair 'Payment (EraCrypto era)
_payKey, KeyPair 'Staking (EraCrypto era)
stakeKey) <- forall a. HasCallStack => [a] -> Gen a
QC.elements KeyPairs (EraCrypto era)
availableKeys
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert (forall c (kr :: KeyRole).
Crypto c =>
KeyPair kr c -> Credential kr c
mkCred KeyPair 'Staking (EraCrypto era)
stakeKey), forall era. KeyPair 'Staking (EraCrypto era) -> CertCred era
StakeCred KeyPair 'Staking (EraCrypto era)
stakeKey)
      )
    ,
      ( Int
frequencyScriptCredDeReg
      , case [(Script era, Script era)]
availableScripts of
          [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
          [(Script era, Script era)]
_ -> do
            scriptPair :: (Script era, Script era)
scriptPair@(Script era
_, Script era
stakeScript) <- forall a. HasCallStack => [a] -> Gen a
QC.elements [(Script era, Script era)]
availableScripts
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
              forall a. a -> Maybe a
Just
                ( forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert (Script era -> Credential 'Staking (EraCrypto era)
scriptToCred' Script era
stakeScript)
                , forall era. (Script era, Script era) -> CertCred era
ScriptCred (Script era, Script era)
scriptPair
                )
      )
    ]
  where
    scriptToCred' :: Script era -> Credential 'Staking (EraCrypto era)
scriptToCred' = forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era
    registered :: Credential 'Staking (EraCrypto era) -> Bool
registered Credential 'Staking (EraCrypto era)
k = forall k c v. k -> UView c k v -> Bool
UM.member Credential 'Staking (EraCrypto era)
k (forall era.
DState era
-> UView
     (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
dState)
    availableKeys :: KeyPairs (EraCrypto era)
availableKeys =
      forall a. (a -> Bool) -> [a] -> [a]
filter
        ( \(KeyPair 'Payment (EraCrypto era)
_, KeyPair 'Staking (EraCrypto era)
k) ->
            let cred :: Credential 'Staking (EraCrypto era)
cred = forall c (kr :: KeyRole).
Crypto c =>
KeyPair kr c -> Credential kr c
mkCred KeyPair 'Staking (EraCrypto era)
k
             in (Bool -> Bool -> Bool
(&&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential 'Staking (EraCrypto era) -> Bool
registered forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Credential 'Staking (EraCrypto era) -> Bool
zeroRewards) Credential 'Staking (EraCrypto era)
cred
        )
        KeyPairs (EraCrypto era)
keys
    availableScripts :: [(Script era, Script era)]
availableScripts =
      forall a. (a -> Bool) -> [a] -> [a]
filter
        ( \(Script era
_, Script era
s) ->
            let cred :: Credential 'Staking (EraCrypto era)
cred = Script era -> Credential 'Staking (EraCrypto era)
scriptToCred' Script era
s
             in (Bool -> Bool -> Bool
(&&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential 'Staking (EraCrypto era) -> Bool
registered forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Credential 'Staking (EraCrypto era) -> Bool
zeroRewards) Credential 'Staking (EraCrypto era)
cred
        )
        [(Script era, Script era)]
scripts
    zeroRewards :: Credential 'Staking (EraCrypto era) -> Bool
zeroRewards Credential 'Staking (EraCrypto era)
k = case forall k c v. k -> UView c k v -> Maybe v
UM.lookup (forall c. RewardAccount c -> Credential 'Staking c
raCredential forall a b. (a -> b) -> a -> b
$ forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet Credential 'Staking (EraCrypto era)
k) (forall era.
DState era
-> UView
     (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
dState) of
      Maybe RDPair
Nothing -> Bool
False
      Just (UM.RDPair CompactForm Coin
ccoin CompactForm Coin
_) -> CompactForm Coin
ccoin forall a. Eq a => a -> a -> Bool
== Word64 -> CompactForm Coin
UM.CompactCoin Word64
0

-- | Generate a new delegation certificate by picking a registered staking
-- credential and pool. The delegation is witnessed by the delegator's
-- credential which we return along with the certificate.
--
-- Returns nothing if there are no registered staking credentials or no
-- registered pools.
genDelegation ::
  forall era.
  (EraScript era, ShelleyEraTxCert era) =>
  Constants ->
  KeyPairs (EraCrypto era) ->
  [(Script era, Script era)] ->
  CertState era ->
  Gen (Maybe (TxCert era, CertCred era))
genDelegation :: forall era.
(EraScript era, ShelleyEraTxCert era) =>
Constants
-> KeyPairs (EraCrypto era)
-> [(Script era, Script era)]
-> CertState era
-> Gen (Maybe (TxCert era, CertCred era))
genDelegation
  Constants {Int
frequencyKeyCredDelegation :: Constants -> Int
frequencyKeyCredDelegation :: Int
frequencyKeyCredDelegation, Int
frequencyScriptCredDelegation :: Constants -> Int
frequencyScriptCredDelegation :: Int
frequencyScriptCredDelegation}
  KeyPairs (EraCrypto era)
keys
  [(Script era, Script era)]
scripts
  CertState era
dpState =
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [KeyHash 'StakePool (EraCrypto era)]
availablePools
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      else
        forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency
          [
            ( Int
frequencyKeyCredDelegation
            , if forall (t :: * -> *) a. Foldable t => t a -> Bool
null KeyPairs (EraCrypto era)
availableDelegates
                then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
                else
                  forall {era} {era} {a}.
(EraCrypto era ~ EraCrypto era, ShelleyEraTxCert era) =>
(a, KeyPair 'Staking (EraCrypto era))
-> KeyHash 'StakePool (EraCrypto era)
-> Maybe (TxCert era, CertCred era)
mkCert
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [a] -> Gen a
QC.elements KeyPairs (EraCrypto era)
availableDelegates
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. HasCallStack => [a] -> Gen a
QC.elements [KeyHash 'StakePool (EraCrypto era)]
availablePools
            )
          ,
            ( Int
frequencyScriptCredDelegation
            , if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Script era, Script era)]
availableDelegatesScripts
                then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
                else
                  (Script era, Script era)
-> KeyHash 'StakePool (EraCrypto era)
-> Maybe (TxCert era, CertCred era)
mkCertFromScript
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [a] -> Gen a
QC.elements [(Script era, Script era)]
availableDelegatesScripts
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. HasCallStack => [a] -> Gen a
QC.elements [KeyHash 'StakePool (EraCrypto era)]
availablePools
            )
          ]
    where
      scriptToCred' :: Script era -> Credential 'Staking (EraCrypto era)
scriptToCred' = forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era
      mkCert :: (a, KeyPair 'Staking (EraCrypto era))
-> KeyHash 'StakePool (EraCrypto era)
-> Maybe (TxCert era, CertCred era)
mkCert (a
_, KeyPair 'Staking (EraCrypto era)
delegatorKey) KeyHash 'StakePool (EraCrypto era)
poolKey = forall a. a -> Maybe a
Just (TxCert era
cert, forall era. KeyPair 'Staking (EraCrypto era) -> CertCred era
StakeCred KeyPair 'Staking (EraCrypto era)
delegatorKey)
        where
          cert :: TxCert era
cert = forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era) -> TxCert era
DelegStakeTxCert (forall c (kr :: KeyRole).
Crypto c =>
KeyPair kr c -> Credential kr c
mkCred KeyPair 'Staking (EraCrypto era)
delegatorKey) KeyHash 'StakePool (EraCrypto era)
poolKey
      mkCertFromScript :: (Script era, Script era)
-> KeyHash 'StakePool (EraCrypto era)
-> Maybe (TxCert era, CertCred era)
mkCertFromScript (Script era
s, Script era
delegatorScript) KeyHash 'StakePool (EraCrypto era)
poolKey =
        forall a. a -> Maybe a
Just (TxCert era
scriptCert, forall era. (Script era, Script era) -> CertCred era
ScriptCred (Script era
s, Script era
delegatorScript))
        where
          scriptCert :: TxCert era
scriptCert =
            forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era) -> TxCert era
DelegStakeTxCert (Script era -> Credential 'Staking (EraCrypto era)
scriptToCred' Script era
delegatorScript) KeyHash 'StakePool (EraCrypto era)
poolKey
      registeredDelegate :: Credential 'Staking (EraCrypto era) -> Bool
registeredDelegate Credential 'Staking (EraCrypto era)
k = forall k c v. k -> UView c k v -> Bool
UM.member Credential 'Staking (EraCrypto era)
k (forall era.
DState era
-> UView
     (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards (forall era. CertState era -> DState era
certDState CertState era
dpState))
      availableDelegates :: KeyPairs (EraCrypto era)
availableDelegates = forall a. (a -> Bool) -> [a] -> [a]
filter (Credential 'Staking (EraCrypto era) -> Bool
registeredDelegate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kr :: KeyRole).
Crypto c =>
KeyPair kr c -> Credential kr c
mkCred forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) KeyPairs (EraCrypto era)
keys
      availableDelegatesScripts :: [(Script era, Script era)]
availableDelegatesScripts =
        forall a. (a -> Bool) -> [a] -> [a]
filter (Credential 'Staking (EraCrypto era) -> Bool
registeredDelegate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script era -> Credential 'Staking (EraCrypto era)
scriptToCred' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Script era, Script era)]
scripts
      registeredPools :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
registeredPools = forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams (forall era. CertState era -> PState era
certPState CertState era
dpState)
      availablePools :: [KeyHash 'StakePool (EraCrypto era)]
availablePools = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> * -> *) k v. (Basic f, Ord k) => f k v -> Set k
domain Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
registeredPools

genGenesisDelegation ::
  (Era era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
  -- | Core nodes
  [(GenesisKeyPair (EraCrypto era), AllIssuerKeys (EraCrypto era) 'GenesisDelegate)] ->
  -- | All potential genesis delegate keys
  [AllIssuerKeys (EraCrypto era) 'GenesisDelegate] ->
  CertState era ->
  Gen (Maybe (TxCert era, CertCred era))
genGenesisDelegation :: forall era.
(Era era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
[(GenesisKeyPair (EraCrypto era),
  AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
-> [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
-> CertState era
-> Gen (Maybe (TxCert era, CertCred era))
genGenesisDelegation [(GenesisKeyPair (EraCrypto era),
  AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
coreNodes [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
delegateKeys CertState era
dpState =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenesisKeyPair (EraCrypto era)]
genesisDelegators Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
availableDelegatees
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    else do
      GenesisKeyPair (EraCrypto era)
gk <- forall a. HasCallStack => [a] -> Gen a
QC.elements [GenesisKeyPair (EraCrypto era)]
genesisDelegators
      AllIssuerKeys {KeyPair 'GenesisDelegate (EraCrypto era)
aikCold :: forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold :: KeyPair 'GenesisDelegate (EraCrypto era)
aikCold, VRFKeyPair (EraCrypto era)
aikVrf :: forall v (r :: KeyRole). AllIssuerKeys v r -> VRFKeyPair v
aikVrf :: VRFKeyPair (EraCrypto era)
aikVrf} <- forall a. HasCallStack => [a] -> Gen a
QC.elements [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
availableDelegatees
      case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall {kd :: KeyRole}.
KeyPair kd (EraCrypto era) -> KeyHash kd (EraCrypto era)
hashVKey GenesisKeyPair (EraCrypto era)
gk) Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs_ of
        Maybe (GenDelegPair (EraCrypto era))
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        Just GenDelegPair (EraCrypto era)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ GenesisKeyPair (EraCrypto era)
-> KeyPair 'GenesisDelegate (EraCrypto era)
-> VerKeyVRF (VRF (EraCrypto era))
-> Maybe (TxCert era, CertCred era)
mkCert GenesisKeyPair (EraCrypto era)
gk KeyPair 'GenesisDelegate (EraCrypto era)
aikCold (forall c. VRFKeyPair c -> VerKeyVRF c
vrfVerKey VRFKeyPair (EraCrypto era)
aikVrf)
  where
    allDelegateKeys :: [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
allDelegateKeys = (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(GenesisKeyPair (EraCrypto era),
  AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
coreNodes) forall a. Semigroup a => a -> a -> a
<> [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
delegateKeys
    hashVKey :: KeyPair kd (EraCrypto era) -> KeyHash kd (EraCrypto era)
hashVKey = forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey
    mkCert :: GenesisKeyPair (EraCrypto era)
-> KeyPair 'GenesisDelegate (EraCrypto era)
-> VerKeyVRF (VRF (EraCrypto era))
-> Maybe (TxCert era, CertCred era)
mkCert GenesisKeyPair (EraCrypto era)
gkey KeyPair 'GenesisDelegate (EraCrypto era)
key VerKeyVRF (VRF (EraCrypto era))
vrf =
      forall a. a -> Maybe a
Just
        ( forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
KeyHash 'Genesis (EraCrypto era)
-> KeyHash 'GenesisDelegate (EraCrypto era)
-> Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
-> TxCert era
GenesisDelegTxCert
            (forall {kd :: KeyRole}.
KeyPair kd (EraCrypto era) -> KeyHash kd (EraCrypto era)
hashVKey GenesisKeyPair (EraCrypto era)
gkey)
            (forall {kd :: KeyRole}.
KeyPair kd (EraCrypto era) -> KeyHash kd (EraCrypto era)
hashVKey KeyPair 'GenesisDelegate (EraCrypto era)
key)
            (forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
hashVerKeyVRF VerKeyVRF (VRF (EraCrypto era))
vrf)
        , forall era. [GenesisKeyPair (EraCrypto era)] -> CertCred era
CoreKeyCred [GenesisKeyPair (EraCrypto era)
gkey]
        )
    GenDelegs Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs_ = forall era. DState era -> GenDelegs (EraCrypto era)
dsGenDelegs forall a b. (a -> b) -> a -> b
$ forall era. CertState era -> DState era
certDState CertState era
dpState
    genesisDelegator :: KeyHash 'Genesis (EraCrypto era) -> Bool
genesisDelegator KeyHash 'Genesis (EraCrypto era)
k = forall s t. Embed s t => Exp t -> s
eval (KeyHash 'Genesis (EraCrypto era)
k forall k (g :: * -> * -> *) s.
(Show k, Ord k, Iter g, HasExp s (g k ())) =>
k -> s -> Exp Bool
∈ forall k s (f :: * -> * -> *) v.
(Ord k, HasExp s (f k v)) =>
s -> Exp (Sett k ())
dom Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs_)
    genesisDelegators :: [GenesisKeyPair (EraCrypto era)]
genesisDelegators = forall a. (a -> Bool) -> [a] -> [a]
filter (KeyHash 'Genesis (EraCrypto era) -> Bool
genesisDelegator forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {kd :: KeyRole}.
KeyPair kd (EraCrypto era) -> KeyHash kd (EraCrypto era)
hashVKey) (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(GenesisKeyPair (EraCrypto era),
  AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
coreNodes)
    activeGenDelegsKeyHashSet :: Set (KeyHash 'GenesisDelegate (EraCrypto era))
activeGenDelegsKeyHashSet =
      forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall c. GenDelegPair c -> KeyHash 'GenesisDelegate c
genDelegKeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs_
    futureGenDelegsKeyHashSet :: Set (KeyHash 'GenesisDelegate (EraCrypto era))
futureGenDelegsKeyHashSet =
      forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall c. GenDelegPair c -> KeyHash 'GenesisDelegate c
genDelegKeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems (forall era.
DState era
-> Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
dsFutureGenDelegs forall a b. (a -> b) -> a -> b
$ forall era. CertState era -> DState era
certDState CertState era
dpState)
    notActiveDelegatee :: KeyHash 'GenesisDelegate (EraCrypto era) -> Bool
notActiveDelegatee KeyHash 'GenesisDelegate (EraCrypto era)
k = forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole KeyHash 'GenesisDelegate (EraCrypto era)
k forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set (KeyHash 'GenesisDelegate (EraCrypto era))
activeGenDelegsKeyHashSet
    notFutureDelegatee :: KeyHash 'GenesisDelegate (EraCrypto era) -> Bool
notFutureDelegatee KeyHash 'GenesisDelegate (EraCrypto era)
k = forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole KeyHash 'GenesisDelegate (EraCrypto era)
k forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set (KeyHash 'GenesisDelegate (EraCrypto era))
futureGenDelegsKeyHashSet
    notDelegatee :: KeyHash 'GenesisDelegate (EraCrypto era) -> Bool
notDelegatee KeyHash 'GenesisDelegate (EraCrypto era)
k = KeyHash 'GenesisDelegate (EraCrypto era) -> Bool
notActiveDelegatee KeyHash 'GenesisDelegate (EraCrypto era)
k Bool -> Bool -> Bool
&& KeyHash 'GenesisDelegate (EraCrypto era) -> Bool
notFutureDelegatee KeyHash 'GenesisDelegate (EraCrypto era)
k
    availableDelegatees :: [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
availableDelegatees = forall a. (a -> Bool) -> [a] -> [a]
filter (KeyHash 'GenesisDelegate (EraCrypto era) -> Bool
notDelegatee forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {kd :: KeyRole}.
KeyPair kd (EraCrypto era) -> KeyHash kd (EraCrypto era)
hashVKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold) [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
allDelegateKeys

-- | Generate PoolParams and the key witness.
genStakePool ::
  forall c.
  Crypto c =>
  -- | Available keys for stake pool registration
  [AllIssuerKeys c 'StakePool] ->
  -- | KeyPairs containing staking keys to act as owners/reward account
  KeyPairs c ->
  -- | Minimum pool cost Protocol Param
  Coin ->
  Gen (PoolParams c, KeyPair 'StakePool c)
genStakePool :: forall c.
Crypto c =>
[AllIssuerKeys c 'StakePool]
-> KeyPairs c -> Coin -> Gen (PoolParams c, KeyPair 'StakePool c)
genStakePool [AllIssuerKeys c 'StakePool]
poolKeys KeyPairs c
skeys (Coin Integer
minPoolCost) =
  forall {a} {v}.
(Integral a, Crypto v) =>
AllIssuerKeys v 'StakePool
-> Coin
-> Coin
-> a
-> VKey 'Staking v
-> (PoolParams v, KeyPair 'StakePool v)
mkPoolParams
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [a] -> Gen a
QC.elements [AllIssuerKeys c 'StakePool]
poolKeys
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Integer -> Coin
Coin -- pledge
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency
              [ (Int
1, Integer -> Integer -> Gen Integer
genInteger Integer
1 Integer
100)
              , (Int
5, forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
              ]
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> Coin
Coin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Gen Integer
genInteger Integer
minPoolCost (Integer
minPoolCost forall a. Num a => a -> a -> a
+ Integer
50)) -- cost
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
QC.choose (Integer
0, Integer
100) :: Gen Natural)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyPairs c -> Gen (VKey 'Staking c)
getAnyStakeKey KeyPairs c
skeys
  where
    getAnyStakeKey :: KeyPairs c -> Gen (VKey 'Staking c)
    getAnyStakeKey :: KeyPairs c -> Gen (VKey 'Staking c)
getAnyStakeKey KeyPairs c
keys = forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [a] -> Gen a
QC.elements KeyPairs c
keys
    mkPoolParams :: AllIssuerKeys v 'StakePool
-> Coin
-> Coin
-> a
-> VKey 'Staking v
-> (PoolParams v, KeyPair 'StakePool v)
mkPoolParams AllIssuerKeys v 'StakePool
allPoolKeys Coin
pledge Coin
cost a
marginPercent VKey 'Staking v
acntKey =
      let interval :: UnitInterval
interval = forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
marginPercent forall a. Integral a => a -> a -> Ratio a
% Integer
100
          pps :: PoolParams v
pps =
            forall c.
KeyHash 'StakePool c
-> Hash c (VerKeyVRF c)
-> Coin
-> Coin
-> UnitInterval
-> RewardAccount c
-> Set (KeyHash 'Staking c)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams c
PoolParams
              (forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold AllIssuerKeys v 'StakePool
allPoolKeys)
              (forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
hashVerKeyVRF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. VRFKeyPair c -> VerKeyVRF c
vrfVerKey forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> VRFKeyPair v
aikVrf AllIssuerKeys v 'StakePool
allPoolKeys)
              Coin
pledge
              Coin
cost
              UnitInterval
interval
              (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall a b. (a -> b) -> a -> b
$ forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey VKey 'Staking v
acntKey)
              forall a. Set a
Set.empty
              forall a. StrictSeq a
StrictSeq.empty
              forall a. StrictMaybe a
SNothing
       in (PoolParams v
pps, forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold AllIssuerKeys v 'StakePool
allPoolKeys)

-- | Generate `RegPool` and the key witness.
genRegPool ::
  (Era era, EraTxCert era) =>
  [AllIssuerKeys (EraCrypto era) 'StakePool] ->
  KeyPairs (EraCrypto era) ->
  Coin ->
  Gen (Maybe (TxCert era, CertCred era))
genRegPool :: forall era.
(Era era, EraTxCert era) =>
[AllIssuerKeys (EraCrypto era) 'StakePool]
-> KeyPairs (EraCrypto era)
-> Coin
-> Gen (Maybe (TxCert era, CertCred era))
genRegPool [AllIssuerKeys (EraCrypto era) 'StakePool]
poolKeys KeyPairs (EraCrypto era)
keyPairs Coin
minPoolCost = do
  (PoolParams (EraCrypto era)
pps, KeyPair 'StakePool (EraCrypto era)
poolKey) <- forall c.
Crypto c =>
[AllIssuerKeys c 'StakePool]
-> KeyPairs c -> Coin -> Gen (PoolParams c, KeyPair 'StakePool c)
genStakePool [AllIssuerKeys (EraCrypto era) 'StakePool]
poolKeys KeyPairs (EraCrypto era)
keyPairs Coin
minPoolCost
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall era.
EraTxCert era =>
PoolParams (EraCrypto era) -> TxCert era
RegPoolTxCert PoolParams (EraCrypto era)
pps, forall era. KeyPair 'StakePool (EraCrypto era) -> CertCred era
PoolCred KeyPair 'StakePool (EraCrypto era)
poolKey)

-- | Generate a RetirePool along with the keypair which registered it.
--
-- Choose a `KeyHash` to retire, by pulling from the set of registered
-- `KeyHash`s in the `stakePools` mapping. Generate a random epoch within an
-- acceptable range of the current epoch. In addition to the `RetirePool`
-- constructed value, return the keypair which corresponds to the selected
-- `KeyHash`, by doing a lookup in the set of `availableKeys`.
genRetirePool ::
  (EraPParams era, EraTxCert era) =>
  PParams era ->
  [AllIssuerKeys (EraCrypto era) 'StakePool] ->
  PState era ->
  SlotNo ->
  Gen (Maybe (TxCert era, CertCred era))
genRetirePool :: forall era.
(EraPParams era, EraTxCert era) =>
PParams era
-> [AllIssuerKeys (EraCrypto era) 'StakePool]
-> PState era
-> SlotNo
-> Gen (Maybe (TxCert era, CertCred era))
genRetirePool PParams era
_pp [AllIssuerKeys (EraCrypto era) 'StakePool]
poolKeys PState era
pState SlotNo
slot =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [KeyHash 'StakePool (EraCrypto era)]
retireable
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    else
      ( \KeyHash 'StakePool (EraCrypto era)
keyHash EpochNo
epoch ->
          forall a. a -> Maybe a
Just
            ( forall era.
EraTxCert era =>
KeyHash 'StakePool (EraCrypto era) -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool (EraCrypto era)
keyHash EpochNo
epoch
            , forall era. KeyPair 'StakePool (EraCrypto era) -> CertCred era
PoolCred (forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool (EraCrypto era)
-> AllIssuerKeys (EraCrypto era) 'StakePool
lookupHash KeyHash 'StakePool (EraCrypto era)
keyHash)
            )
      )
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [a] -> Gen a
QC.elements [KeyHash 'StakePool (EraCrypto era)]
retireable
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> EpochNo
EpochNo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> Word64 -> Gen Word64
genWord64 Word64
epochLow Word64
epochHigh)
  where
    stakePools :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
stakePools = forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams PState era
pState
    registered_ :: Set (KeyHash 'StakePool (EraCrypto era))
registered_ = forall s t. Embed s t => Exp t -> s
eval (forall k s (f :: * -> * -> *) v.
(Ord k, HasExp s (f k v)) =>
s -> Exp (Sett k ())
dom Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
stakePools)
    retiring_ :: Set (KeyHash 'StakePool (EraCrypto era))
retiring_ = forall (f :: * -> * -> *) k v. (Basic f, Ord k) => f k v -> Set k
domain (forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
psRetiring PState era
pState)
    retireable :: [KeyHash 'StakePool (EraCrypto era)]
retireable = forall a. Set a -> [a]
Set.toList (Set (KeyHash 'StakePool (EraCrypto era))
registered_ forall a. Ord a => Set a -> Set a -> Set a
\\ Set (KeyHash 'StakePool (EraCrypto era))
retiring_)
    lookupHash :: KeyHash 'StakePool (EraCrypto era)
-> AllIssuerKeys (EraCrypto era) 'StakePool
lookupHash KeyHash 'StakePool (EraCrypto era)
hk' =
      forall a. a -> Maybe a -> a
fromMaybe
        (forall a. HasCallStack => String -> a
error String
"genRetirePool: could not find keyHash")
        (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\AllIssuerKeys (EraCrypto era) 'StakePool
x -> forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash AllIssuerKeys (EraCrypto era) 'StakePool
x forall a. Eq a => a -> a -> Bool
== KeyHash 'StakePool (EraCrypto era)
hk') [AllIssuerKeys (EraCrypto era) 'StakePool]
poolKeys)
    EpochNo Word64
cepoch = SlotNo -> EpochNo
epochFromSlotNo SlotNo
slot
    epochLow :: Word64
epochLow = Word64
cepoch forall a. Num a => a -> a -> a
+ Word64
1
    -- if epochHigh is more than a few epochs above epochLow, then
    -- because our traces are at most, maybe 6 or so traces long,
    -- we will never reap any pools. Choosing a delta between 1 and 10
    -- should give good mix of sometimes reaping, but mostly not.
    epochHigh :: Word64
epochHigh = Word64
cepoch forall a. Num a => a -> a -> a
+ Word64
10

-- | Generate an InstantaneousRewards Transfer certificate
genInstantaneousRewardsAccounts ::
  (EraPParams era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
  SlotNo ->
  -- | Index over the cold key hashes of all possible Genesis Delegates
  Map (KeyHash 'GenesisDelegate (EraCrypto era)) (AllIssuerKeys (EraCrypto era) 'GenesisDelegate) ->
  PParams era ->
  AccountState ->
  DState era ->
  Gen (Maybe (TxCert era, CertCred era))
genInstantaneousRewardsAccounts :: forall era.
(EraPParams era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
SlotNo
-> Map
     (KeyHash 'GenesisDelegate (EraCrypto era))
     (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
-> PParams era
-> AccountState
-> DState era
-> Gen (Maybe (TxCert era, CertCred era))
genInstantaneousRewardsAccounts SlotNo
s Map
  (KeyHash 'GenesisDelegate (EraCrypto era))
  (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
genesisDelegatesByHash PParams era
pparams AccountState
accountState DState era
delegSt = do
  let (GenDelegs Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs_) = forall era. DState era -> GenDelegs (EraCrypto era)
dsGenDelegs DState era
delegSt
      lookupGenDelegate' :: KeyHash 'GenesisDelegate (EraCrypto era)
-> AllIssuerKeys (EraCrypto era) 'GenesisDelegate
lookupGenDelegate' KeyHash 'GenesisDelegate (EraCrypto era)
gk =
        forall a. a -> Maybe a -> a
fromMaybe
          (forall a. HasCallStack => String -> a
error String
"genInstantaneousRewardsAccounts: lookupGenDelegate failed")
          (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'GenesisDelegate (EraCrypto era)
gk Map
  (KeyHash 'GenesisDelegate (EraCrypto era))
  (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
genesisDelegatesByHash)
      credentials :: UView (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
credentials = forall era.
DState era
-> UView
     (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
delegSt
  [Credential 'Staking (EraCrypto era)]
winnerCreds <-
    forall a. Int -> [a] -> [a]
take
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [a] -> Gen a
QC.elements [Int
0 .. (forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall c k v. UView c k v -> Int
UM.size UView (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
credentials forall a. Num a => a -> a -> a
- Int
1)]
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> Gen [a]
QC.shuffle (forall a. Set a -> [a]
Set.toList (forall c k v. UView c k v -> Set k
UM.domain UView (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
credentials))
  [Integer]
coins <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'Staking (EraCrypto era)]
winnerCreds) forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Gen Integer
genInteger Integer
1 Integer
1000
  let credCoinMap :: Map (Credential 'Staking (EraCrypto era)) DeltaCoin
credCoinMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Credential 'Staking (EraCrypto era)]
winnerCreds (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> DeltaCoin
DeltaCoin [Integer]
coins)

  [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
coreSigners <-
    forall a. Int -> [a] -> [a]
take
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [a] -> Gen a
QC.elements [Int
5 .. (forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs_ forall a. Num a => a -> a -> a
- Int
1)]
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> Gen [a]
QC.shuffle (KeyHash 'GenesisDelegate (EraCrypto era)
-> AllIssuerKeys (EraCrypto era) 'GenesisDelegate
lookupGenDelegate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. GenDelegPair c -> KeyHash 'GenesisDelegate c
genDelegKeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs_)

  MIRPot
pot <- forall a. HasCallStack => [a] -> Gen a
QC.elements [MIRPot
ReservesMIR, MIRPot
TreasuryMIR]
  let available :: Coin
available = forall c. MIRPot -> AccountState -> InstantaneousRewards c -> Coin
availableAfterMIR MIRPot
pot AccountState
accountState (forall era. DState era -> InstantaneousRewards (EraCrypto era)
dsIRewards DState era
delegSt)
  let rewardAmount :: DeltaCoin
rewardAmount = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems Map (Credential 'Staking (EraCrypto era)) DeltaCoin
credCoinMap
      insufficientFunds :: Bool
insufficientFunds = Coin -> DeltaCoin
toDeltaCoin Coin
available forall a. Ord a => a -> a -> Bool
< DeltaCoin
rewardAmount
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    if -- Discard this generator (by returning Nothing) if:
    -- we are in full decentralisation mode (d=0) when IR certs are not allowed
    PParams era
pparams forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
SimpleGetter (PParams era) UnitInterval
ppDG forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound
      -- or when we don't have keys available for generating an IR cert
      Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map (Credential 'Staking (EraCrypto era)) DeltaCoin
credCoinMap
      -- or it's too late in the epoch for IR certs
      Bool -> Bool -> Bool
|| SlotNo -> Bool
tooLateInEpoch SlotNo
s
      -- or the rewards exceed the pot amount
      Bool -> Bool -> Bool
|| Bool
insufficientFunds
      then forall a. Maybe a
Nothing
      else
        forall a. a -> Maybe a
Just
          ( forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
MIRCert (EraCrypto era) -> TxCert era
MirTxCert (forall c. MIRPot -> MIRTarget c -> MIRCert c
MIRCert MIRPot
pot (forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR Map (Credential 'Staking (EraCrypto era)) DeltaCoin
credCoinMap))
          , forall era.
[KeyPair 'GenesisDelegate (EraCrypto era)] -> CertCred era
DelegateCred (forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
coreSigners)
          )

-- | Generate an InstantaneousRewards Transfer
genInstantaneousRewardsTransfer ::
  (EraPParams era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
  SlotNo ->
  -- | Index over the cold key hashes of all possible Genesis Delegates
  Map (KeyHash 'GenesisDelegate (EraCrypto era)) (AllIssuerKeys (EraCrypto era) 'GenesisDelegate) ->
  PParams era ->
  AccountState ->
  DState era ->
  Gen (Maybe (TxCert era, CertCred era))
genInstantaneousRewardsTransfer :: forall era.
(EraPParams era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
SlotNo
-> Map
     (KeyHash 'GenesisDelegate (EraCrypto era))
     (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
-> PParams era
-> AccountState
-> DState era
-> Gen (Maybe (TxCert era, CertCred era))
genInstantaneousRewardsTransfer SlotNo
s Map
  (KeyHash 'GenesisDelegate (EraCrypto era))
  (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
genesisDelegatesByHash PParams era
pparams AccountState
accountState DState era
delegSt = do
  let (GenDelegs Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs_) = forall era. DState era -> GenDelegs (EraCrypto era)
dsGenDelegs DState era
delegSt
      lookupGenDelegate' :: KeyHash 'GenesisDelegate (EraCrypto era)
-> AllIssuerKeys (EraCrypto era) 'GenesisDelegate
lookupGenDelegate' KeyHash 'GenesisDelegate (EraCrypto era)
gk =
        forall a. a -> Maybe a -> a
fromMaybe
          (forall a. HasCallStack => String -> a
error String
"genInstantaneousRewardsTransfer: lookupGenDelegate failed")
          (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'GenesisDelegate (EraCrypto era)
gk Map
  (KeyHash 'GenesisDelegate (EraCrypto era))
  (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
genesisDelegatesByHash)

  [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
coreSigners <-
    forall a. Int -> [a] -> [a]
take
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [a] -> Gen a
QC.elements [Int
5 .. (forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs_ forall a. Num a => a -> a -> a
- Int
1)]
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> Gen [a]
QC.shuffle (KeyHash 'GenesisDelegate (EraCrypto era)
-> AllIssuerKeys (EraCrypto era) 'GenesisDelegate
lookupGenDelegate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. GenDelegPair c -> KeyHash 'GenesisDelegate c
genDelegKeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs_)

  MIRPot
pot <- forall a. HasCallStack => [a] -> Gen a
QC.elements [MIRPot
ReservesMIR, MIRPot
TreasuryMIR]
  let Coin Integer
available = forall c. MIRPot -> AccountState -> InstantaneousRewards c -> Coin
availableAfterMIR MIRPot
pot AccountState
accountState (forall era. DState era -> InstantaneousRewards (EraCrypto era)
dsIRewards DState era
delegSt)
  Integer
amount <- if Integer
available forall a. Ord a => a -> a -> Bool
> Integer
0 then forall a. Random a => (a, a) -> Gen a
QC.choose (Integer
0, Integer
available) else forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    if -- Discard this generator (by returning Nothing) if:
    -- we are in full decentralisation mode (d=0) when IR certs are not allowed
    PParams era
pparams forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
SimpleGetter (PParams era) UnitInterval
ppDG forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound
      -- or it's too late in the epoch for IR certs
      Bool -> Bool -> Bool
|| SlotNo -> Bool
tooLateInEpoch SlotNo
s
      then forall a. Maybe a
Nothing
      else
        forall a. a -> Maybe a
Just
          ( forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
MIRCert (EraCrypto era) -> TxCert era
MirTxCert (forall c. MIRPot -> MIRTarget c -> MIRCert c
MIRCert MIRPot
pot (forall c. Coin -> MIRTarget c
SendToOppositePotMIR forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
amount))
          , forall era.
[KeyPair 'GenesisDelegate (EraCrypto era)] -> CertCred era
DelegateCred (forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
coreSigners)
          )

genInstantaneousRewards ::
  (EraPParams era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
  SlotNo ->
  -- | Index over the cold key hashes of all possible Genesis Delegates
  Map (KeyHash 'GenesisDelegate (EraCrypto era)) (AllIssuerKeys (EraCrypto era) 'GenesisDelegate) ->
  PParams era ->
  AccountState ->
  DState era ->
  Gen (Maybe (TxCert era, CertCred era))
genInstantaneousRewards :: forall era.
(EraPParams era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
SlotNo
-> Map
     (KeyHash 'GenesisDelegate (EraCrypto era))
     (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
-> PParams era
-> AccountState
-> DState era
-> Gen (Maybe (TxCert era, CertCred era))
genInstantaneousRewards SlotNo
slot Map
  (KeyHash 'GenesisDelegate (EraCrypto era))
  (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
genesisDelegatesByHash PParams era
pparams AccountState
accountState DState era
delegSt =
  if ProtVer -> Bool
HardForks.allowMIRTransfer (PParams era
pparams forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL)
    then
      forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof
        [ forall era.
(EraPParams era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
SlotNo
-> Map
     (KeyHash 'GenesisDelegate (EraCrypto era))
     (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
-> PParams era
-> AccountState
-> DState era
-> Gen (Maybe (TxCert era, CertCred era))
genInstantaneousRewardsAccounts
            SlotNo
slot
            Map
  (KeyHash 'GenesisDelegate (EraCrypto era))
  (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
genesisDelegatesByHash
            PParams era
pparams
            AccountState
accountState
            DState era
delegSt
        , forall era.
(EraPParams era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
SlotNo
-> Map
     (KeyHash 'GenesisDelegate (EraCrypto era))
     (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
-> PParams era
-> AccountState
-> DState era
-> Gen (Maybe (TxCert era, CertCred era))
genInstantaneousRewardsTransfer
            SlotNo
slot
            Map
  (KeyHash 'GenesisDelegate (EraCrypto era))
  (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
genesisDelegatesByHash
            PParams era
pparams
            AccountState
accountState
            DState era
delegSt
        ]
    else
      forall era.
(EraPParams era, ShelleyEraTxCert era, ProtVerAtMost era 8) =>
SlotNo
-> Map
     (KeyHash 'GenesisDelegate (EraCrypto era))
     (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
-> PParams era
-> AccountState
-> DState era
-> Gen (Maybe (TxCert era, CertCred era))
genInstantaneousRewardsAccounts
        SlotNo
slot
        Map
  (KeyHash 'GenesisDelegate (EraCrypto era))
  (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
genesisDelegatesByHash
        PParams era
pparams
        AccountState
accountState
        DState era
delegSt