{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Cardano.Ledger.Shelley.Generator.Trace.TxCert (
  CERTS,
  genTxCerts,
) where

import Cardano.Ledger.BaseTypes (CertIx, Globals, ShelleyBase, SlotNo (..), TxIx)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Credential (SlotNo32 (..))
import Cardano.Ledger.Keys (HasKeyRole (coerceKeyRole), asWitness)
import Cardano.Ledger.Shelley.API (
  DelplEnv (..),
  Ptr (..),
  ShelleyDELPL,
 )
import Cardano.Ledger.Shelley.Rules (ShelleyDelplEvent, ShelleyDelplPredFailure)
import Cardano.Ledger.State
import Cardano.Protocol.Crypto (Crypto)
import Control.Monad.Trans.Reader (runReaderT)
import Control.State.Transition (
  BaseM,
  Embed,
  Environment,
  Event,
  PredicateFailure,
  STS (..),
  Signal,
  State,
  TRC (..),
  TransitionRule,
  initialRules,
  judgmentContext,
  trans,
  transitionRules,
  wrapEvent,
  wrapFailed,
 )
import Data.Functor.Identity (runIdentity)
import Data.List (partition)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, mapMaybe)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Lens.Micro ((^.))
import Test.Cardano.Ledger.Core.KeyPair (KeyPair)
import Test.Cardano.Ledger.Shelley.Constants (Constants (..))
import Test.Cardano.Ledger.Shelley.Generator.Core (GenEnv (..), KeySpace (..))
import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen (..))
import Test.Cardano.Ledger.Shelley.Generator.ScriptClass (scriptKeyCombination)
import Test.Cardano.Ledger.Shelley.Generator.TxCert (CertCred (..), genTxCert)
import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo, testGlobals)
import Test.Control.State.Transition.Trace (TraceOrder (OldestFirst), lastState, traceSignals)
import qualified Test.Control.State.Transition.Trace.Generator.QuickCheck as QC
import Test.QuickCheck (Gen)

-- | This is a non-spec STS used to generate a sequence of certificates with
-- witnesses.
data CERTS era

newtype CertsPredicateFailure era
  = CertsFailure (PredicateFailure (Core.EraRule "DELPL" era))
  deriving ((forall x.
 CertsPredicateFailure era -> Rep (CertsPredicateFailure era) x)
-> (forall x.
    Rep (CertsPredicateFailure era) x -> CertsPredicateFailure era)
-> Generic (CertsPredicateFailure era)
forall x.
Rep (CertsPredicateFailure era) x -> CertsPredicateFailure era
forall x.
CertsPredicateFailure era -> Rep (CertsPredicateFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (CertsPredicateFailure era) x -> CertsPredicateFailure era
forall era x.
CertsPredicateFailure era -> Rep (CertsPredicateFailure era) x
$cfrom :: forall era x.
CertsPredicateFailure era -> Rep (CertsPredicateFailure era) x
from :: forall x.
CertsPredicateFailure era -> Rep (CertsPredicateFailure era) x
$cto :: forall era x.
Rep (CertsPredicateFailure era) x -> CertsPredicateFailure era
to :: forall x.
Rep (CertsPredicateFailure era) x -> CertsPredicateFailure era
Generic)

newtype CertsEvent era
  = CertsEvent (Event (Core.EraRule "DELPL" era))

deriving stock instance
  Eq (PredicateFailure (Core.EraRule "DELPL" era)) =>
  Eq (CertsPredicateFailure era)

deriving stock instance
  Show (PredicateFailure (Core.EraRule "DELPL" era)) =>
  Show (CertsPredicateFailure era)

instance
  ( Era era
  , Embed (Core.EraRule "DELPL" era) (CERTS era)
  , Environment (Core.EraRule "DELPL" era) ~ DelplEnv era
  , State (Core.EraRule "DELPL" era) ~ CertState era
  , Signal (Core.EraRule "DELPL" era) ~ TxCert era
  ) =>
  STS (CERTS era)
  where
  type Environment (CERTS era) = (SlotNo, TxIx, Core.PParams era, ChainAccountState)
  type State (CERTS era) = (CertState era, CertIx)
  type Signal (CERTS era) = Maybe (TxCert era, CertCred era)
  type PredicateFailure (CERTS era) = CertsPredicateFailure era
  type Event (CERTS era) = CertsEvent era

  type BaseM (CERTS era) = ShelleyBase

  initialRules :: [InitialRule (CERTS era)]
initialRules = []
  transitionRules :: [TransitionRule (CERTS era)]
transitionRules = [TransitionRule (CERTS era)
forall era.
(Embed (EraRule "DELPL" era) (CERTS era),
 Environment (EraRule "DELPL" era) ~ DelplEnv era,
 State (EraRule "DELPL" era) ~ CertState era,
 Signal (EraRule "DELPL" era) ~ TxCert era) =>
TransitionRule (CERTS era)
certsTransition]

certsTransition ::
  forall era.
  ( Embed (Core.EraRule "DELPL" era) (CERTS era)
  , Environment (Core.EraRule "DELPL" era) ~ DelplEnv era
  , State (Core.EraRule "DELPL" era) ~ CertState era
  , Signal (Core.EraRule "DELPL" era) ~ TxCert era
  ) =>
  TransitionRule (CERTS era)
certsTransition :: forall era.
(Embed (EraRule "DELPL" era) (CERTS era),
 Environment (EraRule "DELPL" era) ~ DelplEnv era,
 State (EraRule "DELPL" era) ~ CertState era,
 Signal (EraRule "DELPL" era) ~ TxCert era) =>
TransitionRule (CERTS era)
certsTransition = do
  TRC
    ( (slot :: SlotNo
slot@(SlotNo Word64
slot64), TxIx
txIx, PParams era
pp, ChainAccountState
acnt)
      , (CertState era
dpState, CertIx
nextCertIx)
      , Signal (CERTS era)
c
      ) <-
    Rule (CERTS era) 'Transition (RuleContext 'Transition (CERTS era))
F (Clause (CERTS era) 'Transition) (TRC (CERTS era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext

  case Signal (CERTS era)
c of
    Just (TxCert era
cert, CertCred era
_wits) -> do
      let ptr :: Ptr
ptr = SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slot64)) TxIx
txIx CertIx
nextCertIx
      let epoch :: EpochNo
epoch = SlotNo -> EpochNo
epochFromSlotNo SlotNo
slot
      CertState era
dpState' <-
        forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(Core.EraRule "DELPL" era) (RuleContext 'Transition (EraRule "DELPL" era)
 -> Rule (CERTS era) 'Transition (State (EraRule "DELPL" era)))
-> RuleContext 'Transition (EraRule "DELPL" era)
-> Rule (CERTS era) 'Transition (State (EraRule "DELPL" era))
forall a b. (a -> b) -> a -> b
$
          (Environment (EraRule "DELPL" era), State (EraRule "DELPL" era),
 Signal (EraRule "DELPL" era))
-> TRC (EraRule "DELPL" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (SlotNo
-> EpochNo
-> Ptr
-> PParams era
-> ChainAccountState
-> DelplEnv era
forall era.
SlotNo
-> EpochNo
-> Ptr
-> PParams era
-> ChainAccountState
-> DelplEnv era
DelplEnv SlotNo
slot EpochNo
epoch Ptr
ptr PParams era
pp ChainAccountState
acnt, CertState era
State (EraRule "DELPL" era)
dpState, TxCert era
Signal (EraRule "DELPL" era)
cert)

      (CertState era, CertIx)
-> F (Clause (CERTS era) 'Transition) (CertState era, CertIx)
forall a. a -> F (Clause (CERTS era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
dpState', CertIx -> CertIx
forall a. Enum a => a -> a
succ CertIx
nextCertIx)
    Maybe (TxCert era, CertCred era)
Signal (CERTS era)
Nothing ->
      (CertState era, CertIx)
-> F (Clause (CERTS era) 'Transition) (CertState era, CertIx)
forall a. a -> F (Clause (CERTS era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
dpState, CertIx
nextCertIx)

instance
  ( Era era
  , STS (ShelleyDELPL era)
  , PredicateFailure (Core.EraRule "DELPL" era) ~ ShelleyDelplPredFailure era
  , Event (Core.EraRule "DELPL" era) ~ ShelleyDelplEvent era
  ) =>
  Embed (ShelleyDELPL era) (CERTS era)
  where
  wrapFailed :: PredicateFailure (ShelleyDELPL era) -> PredicateFailure (CERTS era)
wrapFailed = PredicateFailure (EraRule "DELPL" era) -> CertsPredicateFailure era
PredicateFailure (ShelleyDELPL era) -> PredicateFailure (CERTS era)
forall era.
PredicateFailure (EraRule "DELPL" era) -> CertsPredicateFailure era
CertsFailure
  wrapEvent :: Event (ShelleyDELPL era) -> Event (CERTS era)
wrapEvent = Event (EraRule "DELPL" era) -> CertsEvent era
Event (ShelleyDELPL era) -> Event (CERTS era)
forall era. Event (EraRule "DELPL" era) -> CertsEvent era
CertsEvent

instance
  ( EraGen era
  , Embed (Core.EraRule "DELPL" era) (CERTS era)
  , Environment (Core.EraRule "DELPL" era) ~ DelplEnv era
  , State (Core.EraRule "DELPL" era) ~ CertState era
  , Signal (Core.EraRule "DELPL" era) ~ TxCert era
  , ProtVerAtMost era 8
  , EraCertState era
  , Crypto c
  ) =>
  QC.HasTrace (CERTS era) (GenEnv c era)
  where
  envGen :: HasCallStack => GenEnv c era -> Gen (Environment (CERTS era))
envGen GenEnv c era
_ = String -> Gen (SlotNo, TxIx, PParams era, ChainAccountState)
forall a. HasCallStack => String -> a
error String
"HasTrace CERTS - envGen not required"

  sigGen :: HasCallStack =>
GenEnv c era
-> Environment (CERTS era)
-> State (CERTS era)
-> Gen (Signal (CERTS era))
sigGen
    ( GenEnv
        KeySpace c era
ks
        ScriptSpace era
_scriptspace
        Constants
constants
      )
    (SlotNo
slot, TxIx
_txIx, PParams era
pparams, ChainAccountState
accountState)
    (CertState era
dpState, CertIx
_certIx) =
      Constants
-> KeySpace c era
-> PParams era
-> ChainAccountState
-> CertState era
-> SlotNo
-> Gen (Maybe (TxCert era, CertCred era))
forall era c.
(EraGen era, ProtVerAtMost era 8, EraCertState era, Crypto c) =>
Constants
-> KeySpace c era
-> PParams era
-> ChainAccountState
-> CertState era
-> SlotNo
-> Gen (Maybe (TxCert era, CertCred era))
genTxCert
        Constants
constants
        KeySpace c era
ks
        PParams era
pparams
        ChainAccountState
accountState
        CertState era
dpState
        SlotNo
slot

  shrinkSignal :: HasCallStack => Signal (CERTS era) -> [Signal (CERTS era)]
shrinkSignal = [Maybe (TxCert era, CertCred era)]
-> Maybe (TxCert era, CertCred era)
-> [Maybe (TxCert era, CertCred era)]
forall a b. a -> b -> a
const []

  type BaseEnv (CERTS era) = Globals
  interpretSTS :: forall a.
HasCallStack =>
BaseEnv (CERTS era) -> BaseM (CERTS era) a -> a
interpretSTS BaseEnv (CERTS era)
globals BaseM (CERTS era) a
act = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ ReaderT Globals Identity a -> Globals -> Identity a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Globals Identity a
BaseM (CERTS era) a
act Globals
BaseEnv (CERTS era)
globals

-- | Generate certificates and also return the associated witnesses and
-- deposits and refunds required.
genTxCerts ::
  forall era c.
  ( EraGen era
  , Embed (Core.EraRule "DELPL" era) (CERTS era)
  , Environment (Core.EraRule "DELPL" era) ~ DelplEnv era
  , State (Core.EraRule "DELPL" era) ~ CertState era
  , Signal (Core.EraRule "DELPL" era) ~ TxCert era
  , Crypto c
  ) =>
  GenEnv c era ->
  Core.PParams era ->
  CertState era ->
  SlotNo ->
  TxIx ->
  ChainAccountState ->
  Gen
    ( [TxCert era]
    , Coin
    , Coin
    , CertState era
    , [KeyPair 'Witness]
    , [(Core.Script era, Core.Script era)]
    )
genTxCerts :: forall era c.
(EraGen era, Embed (EraRule "DELPL" era) (CERTS era),
 Environment (EraRule "DELPL" era) ~ DelplEnv era,
 State (EraRule "DELPL" era) ~ CertState era,
 Signal (EraRule "DELPL" era) ~ TxCert era, Crypto c) =>
GenEnv c era
-> PParams era
-> CertState era
-> SlotNo
-> TxIx
-> ChainAccountState
-> Gen
     ([TxCert era], Coin, Coin, CertState era, [KeyPair 'Witness],
      [(Script era, Script era)])
genTxCerts
  ge :: GenEnv c era
ge@( GenEnv
         KeySpace_ {Map (KeyHash 'Staking) (KeyPair 'Staking)
ksIndexedStakingKeys :: Map (KeyHash 'Staking) (KeyPair 'Staking)
ksIndexedStakingKeys :: forall c era.
KeySpace c era -> Map (KeyHash 'Staking) (KeyPair 'Staking)
ksIndexedStakingKeys}
         ScriptSpace era
_scriptspace
         Constants {Word64
maxCertsPerTx :: Word64
maxCertsPerTx :: Constants -> Word64
maxCertsPerTx}
       )
  PParams era
pp
  CertState era
certState
  SlotNo
slot
  TxIx
txIx
  ChainAccountState
acnt = do
    let env :: (SlotNo, TxIx, PParams era, ChainAccountState)
env = (SlotNo
slot, TxIx
txIx, PParams era
pp, ChainAccountState
acnt)
        st0 :: (CertState era, CertIx)
st0 = (CertState era
certState, CertIx
forall a. Bounded a => a
minBound)
        certDState :: DState era
certDState = CertState era
certState CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL
        certPState :: PState era
certPState = CertState era
certState CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL

    Trace (CERTS era)
certsTrace <-
      forall sts traceGenEnv.
HasTrace sts traceGenEnv =>
BaseEnv sts
-> Word64
-> traceGenEnv
-> Environment sts
-> State sts
-> Gen (Trace sts)
QC.traceFrom @(CERTS era) Globals
BaseEnv (CERTS era)
testGlobals Word64
maxCertsPerTx GenEnv c era
ge (SlotNo, TxIx, PParams era, ChainAccountState)
Environment (CERTS era)
env (CertState era, CertIx)
State (CERTS era)
st0

    let certsCreds :: [(TxCert era, CertCred era)]
certsCreds = [Maybe (TxCert era, CertCred era)] -> [(TxCert era, CertCred era)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (TxCert era, CertCred era)]
 -> [(TxCert era, CertCred era)])
-> (Trace (CERTS era) -> [Maybe (TxCert era, CertCred era)])
-> Trace (CERTS era)
-> [(TxCert era, CertCred era)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceOrder -> Trace (CERTS era) -> [Signal (CERTS era)]
forall s. TraceOrder -> Trace s -> [Signal s]
traceSignals TraceOrder
OldestFirst (Trace (CERTS era) -> [(TxCert era, CertCred era)])
-> Trace (CERTS era) -> [(TxCert era, CertCred era)]
forall a b. (a -> b) -> a -> b
$ Trace (CERTS era)
certsTrace
        (CertState era
lastState_, CertIx
_) = Trace (CERTS era) -> State (CERTS era)
forall s. Trace s -> State s
lastState Trace (CERTS era)
certsTrace
        ([TxCert era]
certs, [CertCred era]
creds) = [(TxCert era, CertCred era)] -> ([TxCert era], [CertCred era])
forall a b. [(a, b)] -> ([a], [b])
unzip [(TxCert era, CertCred era)]
certsCreds
        ([CertCred era]
scriptCreds, [CertCred era]
keyCreds) = (CertCred era -> Bool)
-> [CertCred era] -> ([CertCred era], [CertCred era])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition CertCred era -> Bool
forall {era}. CertCred era -> Bool
isScript [CertCred era]
creds
        keyCreds' :: [CertCred era]
keyCreds' = [[CertCred era]] -> [CertCred era]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([CertCred era]
keyCreds [CertCred era] -> [[CertCred era]] -> [[CertCred era]]
forall a. a -> [a] -> [a]
: (CertCred era -> [CertCred era])
-> [CertCred era] -> [[CertCred era]]
forall a b. (a -> b) -> [a] -> [b]
map CertCred era -> [CertCred era]
scriptWitnesses [CertCred era]
scriptCreds)

        refunds :: Coin
refunds =
          PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> [TxCert era]
-> Coin
forall era (f :: * -> *).
(EraTxCert era, Foldable f) =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert era)
-> Coin
forall (f :: * -> *).
Foldable f =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert era)
-> Coin
getTotalRefundsTxCerts
            PParams era
pp
            (DState era -> Credential 'Staking -> Maybe Coin
forall era. DState era -> Credential 'Staking -> Maybe Coin
lookupDepositDState DState era
certDState)
            (Maybe Coin -> Credential 'DRepRole -> Maybe Coin
forall a b. a -> b -> a
const Maybe Coin
forall a. Maybe a
Nothing)
            [TxCert era]
certs

        deposits :: Coin
deposits = PParams era -> (KeyHash 'StakePool -> Bool) -> [TxCert era] -> Coin
forall era (f :: * -> *).
(EraTxCert era, Foldable f) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
forall (f :: * -> *).
Foldable f =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
getTotalDepositsTxCerts PParams era
pp (KeyHash 'StakePool -> Map (KeyHash 'StakePool) PoolParams -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` PState era -> Map (KeyHash 'StakePool) PoolParams
forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psStakePoolParams PState era
certPState) [TxCert era]
certs

        certWits :: [KeyPair 'Witness]
certWits = [[KeyPair 'Witness]] -> [KeyPair 'Witness]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (CertCred era -> [KeyPair 'Witness]
forall era.
(HasCallStack, Era era, Show (Script era)) =>
CertCred era -> [KeyPair 'Witness]
keyCredAsWitness (CertCred era -> [KeyPair 'Witness])
-> [CertCred era] -> [[KeyPair 'Witness]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CertCred era]
keyCreds')
        certScripts :: [(Script era, Script era)]
certScripts = CertCred era -> (Script era, Script era)
forall era.
(HasCallStack, Era era, Show (Script era)) =>
CertCred era -> (Script era, Script era)
extractScriptCred (CertCred era -> (Script era, Script era))
-> [CertCred era] -> [(Script era, Script era)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CertCred era]
scriptCreds
    ([TxCert era], Coin, Coin, CertState era, [KeyPair 'Witness],
 [(Script era, Script era)])
-> Gen
     ([TxCert era], Coin, Coin, CertState era, [KeyPair 'Witness],
      [(Script era, Script era)])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( [TxCert era]
certs
      , Coin
deposits
      , Coin
refunds
      , CertState era
lastState_
      , [KeyPair 'Witness]
certWits
      , [(Script era, Script era)]
certScripts
      )
    where
      isScript :: CertCred era -> Bool
isScript (ScriptCred (Script era, Script era)
_) = Bool
True
      isScript CertCred era
_ = Bool
False

      scriptWitnesses :: CertCred era -> [CertCred era]
      scriptWitnesses :: CertCred era -> [CertCred era]
scriptWitnesses (ScriptCred (Script era
_, Script era
stakeScript)) =
        KeyPair 'Staking -> CertCred era
forall era. KeyPair 'Staking -> CertCred era
StakeCred (KeyPair 'Staking -> CertCred era)
-> [KeyPair 'Staking] -> [CertCred era]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyPair 'Staking]
witnessHashes''
        where
          witnessHashes :: [KeyHash 'Staking]
witnessHashes = KeyHash 'Witness -> KeyHash 'Staking
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyHash 'Witness -> KeyHash 'Staking)
-> [KeyHash 'Witness] -> [KeyHash 'Staking]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy era -> Script era -> [KeyHash 'Witness]
forall era.
ScriptClass era =>
Proxy era -> Script era -> [KeyHash 'Witness]
scriptKeyCombination (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @era) Script era
stakeScript
          witnessHashes'' :: [KeyPair 'Staking]
witnessHashes'' = KeyPair 'Staking -> KeyPair 'Staking
forall (r :: KeyRole) (r' :: KeyRole). KeyPair r -> KeyPair r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyPair 'Staking -> KeyPair 'Staking)
-> [KeyPair 'Staking] -> [KeyPair 'Staking]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyHash 'Staking -> Maybe (KeyPair 'Staking))
-> [KeyHash 'Staking] -> [KeyPair 'Staking]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe KeyHash 'Staking -> Maybe (KeyPair 'Staking)
lookupWit [KeyHash 'Staking]
witnessHashes
      scriptWitnesses CertCred era
_ = []

      lookupWit :: KeyHash 'Staking -> Maybe (KeyPair 'Staking)
lookupWit = (KeyHash 'Staking
 -> Map (KeyHash 'Staking) (KeyPair 'Staking)
 -> Maybe (KeyPair 'Staking))
-> Map (KeyHash 'Staking) (KeyPair 'Staking)
-> KeyHash 'Staking
-> Maybe (KeyPair 'Staking)
forall a b c. (a -> b -> c) -> b -> a -> c
flip KeyHash 'Staking
-> Map (KeyHash 'Staking) (KeyPair 'Staking)
-> Maybe (KeyPair 'Staking)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map (KeyHash 'Staking) (KeyPair 'Staking)
ksIndexedStakingKeys

extractScriptCred ::
  (HasCallStack, Era era, Show (Core.Script era)) =>
  CertCred era ->
  (Core.Script era, Core.Script era)
extractScriptCred :: forall era.
(HasCallStack, Era era, Show (Script era)) =>
CertCred era -> (Script era, Script era)
extractScriptCred (ScriptCred (Script era, Script era)
c) = (Script era, Script era)
c
extractScriptCred CertCred era
x =
  String -> (Script era, Script era)
forall a. HasCallStack => String -> a
error (String -> (Script era, Script era))
-> String -> (Script era, Script era)
forall a b. (a -> b) -> a -> b
$
    String
"extractScriptCred: use only for Script Credentials - "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CertCred era -> String
forall a. Show a => a -> String
show CertCred era
x

keyCredAsWitness ::
  (HasCallStack, Era era, Show (Core.Script era)) =>
  CertCred era ->
  [KeyPair 'Witness]
keyCredAsWitness :: forall era.
(HasCallStack, Era era, Show (Script era)) =>
CertCred era -> [KeyPair 'Witness]
keyCredAsWitness (DelegateCred [KeyPair 'GenesisDelegate]
c) = KeyPair 'GenesisDelegate -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (KeyPair 'GenesisDelegate -> KeyPair 'Witness)
-> [KeyPair 'GenesisDelegate] -> [KeyPair 'Witness]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyPair 'GenesisDelegate]
c
keyCredAsWitness (CoreKeyCred [GenesisKeyPair MockCrypto]
c) = GenesisKeyPair MockCrypto -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (GenesisKeyPair MockCrypto -> KeyPair 'Witness)
-> [GenesisKeyPair MockCrypto] -> [KeyPair 'Witness]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenesisKeyPair MockCrypto]
c
keyCredAsWitness (StakeCred KeyPair 'Staking
c) = [KeyPair 'Staking -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Staking
c]
keyCredAsWitness (PoolCred KeyPair 'StakePool
c) = [KeyPair 'StakePool -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'StakePool
c]
keyCredAsWitness CertCred era
NoCred = []
keyCredAsWitness CertCred era
x =
  String -> [KeyPair 'Witness]
forall a. HasCallStack => String -> a
error (String -> [KeyPair 'Witness]) -> String -> [KeyPair 'Witness]
forall a b. (a -> b) -> a -> b
$
    String
"keyCredAsWitness: use only for Script Credentials - "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CertCred era -> String
forall a. Show a => a -> String
show CertCred era
x