{-# 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 slot64), txIx, pp, acnt)
      , (dpState, nextCertIx)
      , 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 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
      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)

      pure (dpState', succ 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
  , AtMostEra "Babbage" era
  , 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, AtMostEra "Babbage" era, 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

    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 = [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
        (lastState_, _) = lastState certsTrace
        (certs, creds) = unzip certsCreds
        (scriptCreds, keyCreds) = partition isScript creds
        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 =
          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.
EraAccounts 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 = 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) StakePoolState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` PState era -> Map (KeyHash StakePool) StakePoolState
forall era. PState era -> Map (KeyHash StakePool) StakePoolState
psStakePools PState era
certPState) [TxCert era]
certs

        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 = 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
    pure
      ( certs
      , deposits
      , refunds
      , lastState_
      , certWits
      , 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