{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Rpc.Server.Internal.UtxoRpc.Eval
  ( evalTxMethod
  )
where

import Cardano.Api
import Cardano.Api.Experimental qualified as Exp
import Cardano.Api.Experimental.Era
import Cardano.Api.Ledger qualified as L
import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as U5c
import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as UtxoRpc
import Cardano.Rpc.Server.Internal.Error
import Cardano.Rpc.Server.Internal.Monad
import Cardano.Rpc.Server.Internal.Orphans ()
import Cardano.Rpc.Server.Internal.Tracing
import Cardano.Rpc.Server.Internal.UtxoRpc.Type

import Cardano.Ledger.Api qualified as L

import RIO hiding (toList)

import Data.ByteString qualified as BS
import Data.Default
import Data.Map.Strict qualified as Map
import Data.ProtoLens (defMessage)
import Data.Set qualified as Set
import GHC.IsList
import GHC.Stack
import Network.GRPC.Spec

import Proto.Utxorpc.V1beta.Cardano.Cardano_Fields qualified as Proto

-- | Evaluate a CBOR-serialised transaction against the current ledger state,
-- returning per-redeemer execution units, computed minimum fee, script traces,
-- balance check results, and evaluation errors, without submitting.
evalTxMethod
  :: MonadRpc e m
  => Proto UtxoRpc.EvalTxRequest
  -- ^ The evaluation request containing raw transaction CBOR
  -> m (Proto UtxoRpc.EvalTxResponse)
evalTxMethod :: forall e (m :: * -> *).
MonadRpc e m =>
Proto EvalTxRequest -> m (Proto EvalTxResponse)
evalTxMethod Proto EvalTxRequest
request = do
  nodeConnInfo <- m LocalNodeConnectInfo
forall field env (m :: * -> *).
(Has field env, MonadReader env m) =>
m field
grab
  AnyCardanoEra (era :: CardanoEra era) <- liftIO . throwExceptT $ determineEra nodeConnInfo
  (eon :: Era era) <- forEraInEon @Era era (error "Minimum Conway era required") pure

  let rawTx = Proto EvalTxRequest
request Proto EvalTxRequest
-> Getting ByteString (Proto EvalTxRequest) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. LensLike'
  (Const ByteString) (Proto EvalTxRequest) (Proto AnyChainTx)
forall (f :: * -> *) s a.
(Functor f, HasField s "tx" a) =>
LensLike' f s a
U5c.tx LensLike'
  (Const ByteString) (Proto EvalTxRequest) (Proto AnyChainTx)
-> ((ByteString -> Const ByteString ByteString)
    -> Proto AnyChainTx -> Const ByteString (Proto AnyChainTx))
-> Getting ByteString (Proto EvalTxRequest) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const ByteString ByteString)
-> Proto AnyChainTx -> Const ByteString (Proto AnyChainTx)
forall (f :: * -> *) s a.
(Functor f, HasField s "raw" a) =>
LensLike' f s a
U5c.raw

  -- A tx's inputs live inside its raw bytes, so this also bounds the input set the
  -- query batch below resolves. The exact protocol limit is enforced further down,
  -- once protocol parameters are available.
  when (BS.length rawTx > maxEvalTxSizeBytes) $
    throwGrpcErrorWithMessage GrpcInvalidArgument $
      "transaction size "
        <> tshow (BS.length rawTx)
        <> " exceeds the evaluation limit "
        <> tshow maxEvalTxSizeBytes

  (Exp.SignedTx ledgerTx :: Exp.SignedTx era) <-
    putTraceThrowEither
      . first TraceRpcEvalTxDecodingError
      . obtainCommonConstraints eon (deserialiseFromRawBytes asType)
      $ rawTx

  -- Each redeemer gets the full per-tx execution budget during evaluation, so an
  -- unbounded redeemer count lets an unauthenticated caller multiply evaluation cost.
  let redeemerCount =
        Era era -> (EraCommonConstraints era => Int) -> Int
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
eon ((EraCommonConstraints era => Int) -> Int)
-> (EraCommonConstraints era => Int) -> Int
forall a b. (a -> b) -> a -> b
$
          Map
  (PlutusPurpose AsIx (LedgerEra era))
  (Data (LedgerEra era), ExUnits)
-> Int
forall k a. Map k a -> Int
Map.size (Map
   (PlutusPurpose AsIx (LedgerEra era))
   (Data (LedgerEra era), ExUnits)
 -> Int)
-> (Redeemers (LedgerEra era)
    -> Map
         (PlutusPurpose AsIx (LedgerEra era))
         (Data (LedgerEra era), ExUnits))
-> Redeemers (LedgerEra era)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redeemers (LedgerEra era)
-> Map
     (PlutusPurpose AsIx (LedgerEra era))
     (Data (LedgerEra era), ExUnits)
forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
L.unRedeemers (Redeemers (LedgerEra era) -> Int)
-> Redeemers (LedgerEra era) -> Int
forall a b. (a -> b) -> a -> b
$
            Tx TopTx (ShelleyLedgerEra era)
Tx TopTx (LedgerEra era)
ledgerTx Tx TopTx (LedgerEra era)
-> Getting
     (Redeemers (LedgerEra era))
     (Tx TopTx (LedgerEra era))
     (Redeemers (LedgerEra era))
-> Redeemers (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. (TxWits (LedgerEra era)
 -> Const (Redeemers (LedgerEra era)) (TxWits (LedgerEra era)))
-> Tx TopTx (LedgerEra era)
-> Const (Redeemers (LedgerEra era)) (Tx TopTx (LedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l (LedgerEra era)) (TxWits (LedgerEra era))
L.witsTxL ((TxWits (LedgerEra era)
  -> Const (Redeemers (LedgerEra era)) (TxWits (LedgerEra era)))
 -> Tx TopTx (LedgerEra era)
 -> Const (Redeemers (LedgerEra era)) (Tx TopTx (LedgerEra era)))
-> ((Redeemers (LedgerEra era)
     -> Const (Redeemers (LedgerEra era)) (Redeemers (LedgerEra era)))
    -> TxWits (LedgerEra era)
    -> Const (Redeemers (LedgerEra era)) (TxWits (LedgerEra era)))
-> Getting
     (Redeemers (LedgerEra era))
     (Tx TopTx (LedgerEra era))
     (Redeemers (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers (LedgerEra era)
 -> Const (Redeemers (LedgerEra era)) (Redeemers (LedgerEra era)))
-> TxWits (LedgerEra era)
-> Const (Redeemers (LedgerEra era)) (TxWits (LedgerEra era))
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits (LedgerEra era)) (Redeemers (LedgerEra era))
L.rdmrsTxWitsL
  when (redeemerCount > maxEvalRedeemers) $
    throwGrpcErrorWithMessage GrpcInvalidArgument $
      "too many redeemers: " <> tshow redeemerCount <> ", maximum " <> tshow maxEvalRedeemers

  let allInputs =
        Era era -> (EraCommonConstraints era => Set TxIn) -> Set TxIn
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
eon ((EraCommonConstraints era => Set TxIn) -> Set TxIn)
-> (EraCommonConstraints era => Set TxIn) -> Set TxIn
forall a b. (a -> b) -> a -> b
$
          (TxIn -> TxIn) -> Set TxIn -> Set TxIn
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TxIn -> TxIn
fromShelleyTxIn (Set TxIn -> Set TxIn) -> Set TxIn -> Set TxIn
forall a b. (a -> b) -> a -> b
$
            Tx TopTx (ShelleyLedgerEra era)
Tx TopTx (LedgerEra era)
ledgerTx Tx TopTx (LedgerEra era)
-> Getting (Set TxIn) (Tx TopTx (LedgerEra era)) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx (LedgerEra era)
 -> Const (Set TxIn) (TxBody TopTx (LedgerEra era)))
-> Tx TopTx (LedgerEra era)
-> Const (Set TxIn) (Tx TopTx (LedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l (LedgerEra era)) (TxBody l (LedgerEra era))
L.bodyTxL ((TxBody TopTx (LedgerEra era)
  -> Const (Set TxIn) (TxBody TopTx (LedgerEra era)))
 -> Tx TopTx (LedgerEra era)
 -> Const (Set TxIn) (Tx TopTx (LedgerEra era)))
-> ((Set TxIn -> Const (Set TxIn) (Set TxIn))
    -> TxBody TopTx (LedgerEra era)
    -> Const (Set TxIn) (TxBody TopTx (LedgerEra era)))
-> Getting (Set TxIn) (Tx TopTx (LedgerEra era)) (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Const (Set TxIn) (Set TxIn))
-> TxBody TopTx (LedgerEra era)
-> Const (Set TxIn) (TxBody TopTx (LedgerEra era))
forall era.
EraTxBody era =>
SimpleGetter (TxBody TopTx era) (Set TxIn)
SimpleGetter (TxBody TopTx (LedgerEra era)) (Set TxIn)
L.allInputsTxBodyF

  let (unregStakeCreds, _unregDRepCreds, regPoolIds) =
        extractBalanceCheckCreds eon $ ledgerTx ^. L.bodyTxL
      apiStakeCreds = (Credential Staking -> StakeCredential)
-> Set (Credential Staking) -> Set StakeCredential
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Credential Staking -> StakeCredential
fromShelleyStakeCredential Set (Credential Staking)
unregStakeCreds
      apiPoolIds = (KeyHash StakePool -> Hash StakePoolKey)
-> Set (KeyHash StakePool) -> Set (Hash StakePoolKey)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map KeyHash StakePool -> Hash StakePoolKey
StakePoolKeyHash Set (KeyHash StakePool)
regPoolIds

  let target = Target point
forall point. Target point
VolatileTip
  (protocolParams, utxo, systemStart, eraHistory, stakeDelegDeposits, registeredPools) <-
    liftIO . (throwEither =<<) $
      executeLocalStateQueryExpr nodeConnInfo target $ do
        protocolParams <- throwEither =<< throwEither =<< queryProtocolParameters (convert eon)
        utxo <- throwEither =<< throwEither =<< queryUtxo (convert eon) (QueryUTxOByTxIn allInputs)
        systemStart <- throwEither =<< querySystemStart
        eraHistory <- throwEither =<< queryEraHistory
        stakeDelegDeposits <-
          throwEither =<< throwEither =<< queryStakeDelegDeposits (convert eon) apiStakeCreds
        registeredPools <- throwEither =<< throwEither =<< queryStakePoolParameters (convert eon) apiPoolIds
        pure
          (protocolParams, utxo, systemStart, eraHistory, stakeDelegDeposits, registeredPools)

  -- A tx that only needs to decode, not be valid, could otherwise be submitted for
  -- evaluation regardless of size; bound it to what could plausibly be submitted.
  let maxTxSize = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ PParams (ShelleyLedgerEra era)
protocolParams PParams (ShelleyLedgerEra era)
-> Getting Word32 (PParams (ShelleyLedgerEra era)) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams (ShelleyLedgerEra era)) Word32
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams (ShelleyLedgerEra era)) Word32
L.ppMaxTxSizeL
  when (BS.length rawTx > maxTxSize) $
    throwGrpcErrorWithMessage GrpcInvalidArgument $
      "transaction size "
        <> tshow (BS.length rawTx)
        <> " exceeds the protocol maximum "
        <> tshow maxTxSize

  obtainCommonConstraints eon $ do
    let ledgerUtxo = ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
toLedgerUTxO (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
eon) UTxO era
utxo
        epochInfo = EraHistory -> LedgerEpochInfo
toLedgerEpochInfo EraHistory
eraHistory
        poolIdSet = Map (Hash StakePoolKey) StakePoolParameters
-> Set (Hash StakePoolKey)
forall k a. Map k a -> Set k
Map.keysSet Map (Hash StakePoolKey) StakePoolParameters
registeredPools
        Exp.TxEvaluationResult fee evalUnits balance =
          Exp.evaluateTransaction
            systemStart
            epochInfo
            protocolParams
            poolIdSet
            stakeDelegDeposits
            ledgerUtxo
            ledgerTx
        redeemerData =
          [(ScriptWitnessIndex, (ScriptData, ByteString))]
-> Map ScriptWitnessIndex (ScriptData, ByteString)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ ( AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
forall era.
AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
toScriptIndex (Era era -> AlonzoEraOnwards era
forall era. Era era -> AlonzoEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
eon) PlutusPurpose AsIx (ShelleyLedgerEra era)
PlutusPurpose AsIx (LedgerEra era)
purpose
              ,
                ( Data -> ScriptData
fromPlutusData (Data -> ScriptData) -> Data -> ScriptData
forall a b. (a -> b) -> a -> b
$ Data (LedgerEra era) -> Data
forall era. Data era -> Data
L.getPlutusData Data (LedgerEra era)
datum
                , Version -> Data (LedgerEra era) -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
L.serialize' (Era era -> Version
forall era. Era era -> Version
Exp.eraProtVerHigh Era era
eon) Data (LedgerEra era)
datum
                )
              )
            | (PlutusPurpose AsIx (LedgerEra era)
purpose, (Data (LedgerEra era)
datum, ExUnits
_exUnits)) <-
                Map
  (PlutusPurpose AsIx (LedgerEra era))
  (Data (LedgerEra era), ExUnits)
-> [(PlutusPurpose AsIx (LedgerEra era),
     (Data (LedgerEra era), ExUnits))]
Map
  (PlutusPurpose AsIx (LedgerEra era))
  (Data (LedgerEra era), ExUnits)
-> [Item
      (Map
         (PlutusPurpose AsIx (LedgerEra era))
         (Data (LedgerEra era), ExUnits))]
forall l. IsList l => l -> [Item l]
toList (Map
   (PlutusPurpose AsIx (LedgerEra era))
   (Data (LedgerEra era), ExUnits)
 -> [(PlutusPurpose AsIx (LedgerEra era),
      (Data (LedgerEra era), ExUnits))])
-> (Redeemers (LedgerEra era)
    -> Map
         (PlutusPurpose AsIx (LedgerEra era))
         (Data (LedgerEra era), ExUnits))
-> Redeemers (LedgerEra era)
-> [(PlutusPurpose AsIx (LedgerEra era),
     (Data (LedgerEra era), ExUnits))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redeemers (LedgerEra era)
-> Map
     (PlutusPurpose AsIx (LedgerEra era))
     (Data (LedgerEra era), ExUnits)
forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
L.unRedeemers (Redeemers (LedgerEra era)
 -> [(PlutusPurpose AsIx (LedgerEra era),
      (Data (LedgerEra era), ExUnits))])
-> Redeemers (LedgerEra era)
-> [(PlutusPurpose AsIx (LedgerEra era),
     (Data (LedgerEra era), ExUnits))]
forall a b. (a -> b) -> a -> b
$ Tx TopTx (ShelleyLedgerEra era)
Tx TopTx (LedgerEra era)
ledgerTx Tx TopTx (LedgerEra era)
-> Getting
     (Redeemers (LedgerEra era))
     (Tx TopTx (LedgerEra era))
     (Redeemers (LedgerEra era))
-> Redeemers (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. (TxWits (LedgerEra era)
 -> Const (Redeemers (LedgerEra era)) (TxWits (LedgerEra era)))
-> Tx TopTx (LedgerEra era)
-> Const (Redeemers (LedgerEra era)) (Tx TopTx (LedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l (LedgerEra era)) (TxWits (LedgerEra era))
L.witsTxL ((TxWits (LedgerEra era)
  -> Const (Redeemers (LedgerEra era)) (TxWits (LedgerEra era)))
 -> Tx TopTx (LedgerEra era)
 -> Const (Redeemers (LedgerEra era)) (Tx TopTx (LedgerEra era)))
-> ((Redeemers (LedgerEra era)
     -> Const (Redeemers (LedgerEra era)) (Redeemers (LedgerEra era)))
    -> TxWits (LedgerEra era)
    -> Const (Redeemers (LedgerEra era)) (TxWits (LedgerEra era)))
-> Getting
     (Redeemers (LedgerEra era))
     (Tx TopTx (LedgerEra era))
     (Redeemers (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers (LedgerEra era)
 -> Const (Redeemers (LedgerEra era)) (Redeemers (LedgerEra era)))
-> TxWits (LedgerEra era)
-> Const (Redeemers (LedgerEra era)) (TxWits (LedgerEra era))
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits (LedgerEra era)) (Redeemers (LedgerEra era))
L.rdmrsTxWitsL
            ]
        txEval = Coin
-> Map
     ScriptWitnessIndex
     (Either ScriptExecutionError ([Text], ExecutionUnits))
-> Map ScriptWitnessIndex (ScriptData, ByteString)
-> Proto TxEval
mkProtoTxEval Coin
fee Map
  ScriptWitnessIndex
  (Either ScriptExecutionError ([Text], ExecutionUnits))
evalUnits Map ScriptWitnessIndex (ScriptData, ByteString)
redeemerData
        balanceErrors
          | MaryValue
balance MaryValue -> MaryValue -> Bool
forall a. Eq a => a -> a -> Bool
== MaryValue
forall a. Monoid a => a
mempty = []
          | Bool
otherwise =
              [ Proto EvalReport
forall msg. Message msg => msg
defMessage
                  Proto EvalReport
-> (Proto EvalReport -> Proto EvalReport) -> Proto EvalReport
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto EvalReport) Text
forall (f :: * -> *) s a.
(Functor f, HasField s "msg" a) =>
LensLike' f s a
Proto.msg
                    LensLike' Identity (Proto EvalReport) Text
-> Text -> Proto EvalReport -> Proto EvalReport
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"Transaction is not balanced. Remaining balance (consumed - produced): "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MaryValue -> Text
forall a. Show a => a -> Text
tshow MaryValue
balance
              ]
        finalTxEval = Proto TxEval
txEval Proto TxEval -> (Proto TxEval -> Proto TxEval) -> Proto TxEval
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto TxEval) [Proto EvalReport]
forall (f :: * -> *) s a.
(Functor f, HasField s "errors" a) =>
LensLike' f s a
Proto.errors LensLike' Identity (Proto TxEval) [Proto EvalReport]
-> ([Proto EvalReport] -> [Proto EvalReport])
-> Proto TxEval
-> Proto TxEval
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Proto EvalReport] -> [Proto EvalReport] -> [Proto EvalReport]
forall a. Semigroup a => a -> a -> a
<> [Proto EvalReport]
balanceErrors)

    pure $ def & U5c.report . U5c.cardano .~ finalTxEval
 where
  putTraceThrowEither :: Either e b -> m b
putTraceThrowEither Either e b
value = (HasCallStack => m b) -> m b
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m b) -> m b) -> (HasCallStack => m b) -> m b
forall a b. (a -> b) -> a -> b
$ do
    (e -> m ()) -> (b -> m ()) -> Either e b -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m ()
forall t' t e (m :: * -> *).
(t ~ TraceRpc, Inject t' t, Has (Tracer m t) e, MonadReader e m) =>
t' -> m ()
putTrace (m () -> b -> m ()
forall a b. a -> b -> a
const (m () -> b -> m ()) -> m () -> b -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Either e b
value
    Either e b -> m b
forall e (m :: * -> *) a.
(Error e, HasCallStack, MonadIO m, Show e, Typeable e) =>
Either e a -> m a
throwEither Either e b
value

-- | Coarse pre-decode bound (~4x the current mainnet maxTxSize): caps decode and
-- UTxO-query work for oversized requests. The exact protocol limit is enforced
-- after protocol parameters are fetched.
maxEvalTxSizeBytes :: Int
maxEvalTxSizeBytes :: Int
maxEvalTxSizeBytes = Int
65536

-- | Bounds attacker-controlled script evaluations per request: each redeemer may
-- consume the full per-tx execution budget.
maxEvalRedeemers :: Int
maxEvalRedeemers :: Int
maxEvalRedeemers = Int
100

-- | Extract the credentials and pool IDs needed for balance check queries from
-- the transaction body certificates.
extractBalanceCheckCreds
  :: Era era
  -> L.TxBody l (ShelleyLedgerEra era)
  -> ( Set.Set (L.Credential L.Staking)
     , Set.Set (L.Credential L.DRepRole)
     , Set.Set (L.KeyHash L.StakePool)
     )
extractBalanceCheckCreds :: forall era (l :: TxLevel).
Era era
-> TxBody l (ShelleyLedgerEra era)
-> (Set (Credential Staking), Set (Credential DRepRole),
    Set (KeyHash StakePool))
extractBalanceCheckCreds Era era
eon TxBody l (ShelleyLedgerEra era)
txBody =
  Era era
-> (EraCommonConstraints era =>
    (Set (Credential Staking), Set (Credential DRepRole),
     Set (KeyHash StakePool)))
-> (Set (Credential Staking), Set (Credential DRepRole),
    Set (KeyHash StakePool))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
eon ((EraCommonConstraints era =>
  (Set (Credential Staking), Set (Credential DRepRole),
   Set (KeyHash StakePool)))
 -> (Set (Credential Staking), Set (Credential DRepRole),
     Set (KeyHash StakePool)))
-> (EraCommonConstraints era =>
    (Set (Credential Staking), Set (Credential DRepRole),
     Set (KeyHash StakePool)))
-> (Set (Credential Staking), Set (Credential DRepRole),
    Set (KeyHash StakePool))
forall a b. (a -> b) -> a -> b
$ do
    let certs :: [Item (StrictSeq (TxCert (LedgerEra era)))]
certs = StrictSeq (TxCert (LedgerEra era))
-> [Item (StrictSeq (TxCert (LedgerEra era)))]
forall l. IsList l => l -> [Item l]
toList (StrictSeq (TxCert (LedgerEra era))
 -> [Item (StrictSeq (TxCert (LedgerEra era)))])
-> StrictSeq (TxCert (LedgerEra era))
-> [Item (StrictSeq (TxCert (LedgerEra era)))]
forall a b. (a -> b) -> a -> b
$ TxBody l (ShelleyLedgerEra era)
TxBody l (LedgerEra era)
txBody TxBody l (LedgerEra era)
-> Getting
     (StrictSeq (TxCert (LedgerEra era)))
     (TxBody l (LedgerEra era))
     (StrictSeq (TxCert (LedgerEra era)))
-> StrictSeq (TxCert (LedgerEra era))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert (LedgerEra era)))
  (TxBody l (LedgerEra era))
  (StrictSeq (TxCert (LedgerEra era)))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens'
  (TxBody l (LedgerEra era)) (StrictSeq (TxCert (LedgerEra era)))
L.certsTxBodyL
        unregStakeCreds :: Set (Credential Staking)
unregStakeCreds =
          [Item (Set (Credential Staking))] -> Set (Credential Staking)
forall l. IsList l => [Item l] -> l
fromList ([Item (Set (Credential Staking))] -> Set (Credential Staking))
-> [Item (Set (Credential Staking))] -> Set (Credential Staking)
forall a b. (a -> b) -> a -> b
$ (TxCert (LedgerEra era) -> Maybe (Item (Set (Credential Staking))))
-> [TxCert (LedgerEra era)] -> [Item (Set (Credential Staking))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxCert (LedgerEra era) -> Maybe (Item (Set (Credential Staking)))
TxCert (LedgerEra era) -> Maybe (Credential Staking)
forall era.
EraTxCert era =>
TxCert era -> Maybe (Credential Staking)
L.lookupUnRegStakeTxCert [Item (StrictSeq (TxCert (LedgerEra era)))]
[TxCert (LedgerEra era)]
certs
        unregDRepCreds :: Set (Credential DRepRole)
unregDRepCreds =
          [Item (Set (Credential DRepRole))] -> Set (Credential DRepRole)
forall l. IsList l => [Item l] -> l
fromList ([Item (Set (Credential DRepRole))] -> Set (Credential DRepRole))
-> [Item (Set (Credential DRepRole))] -> Set (Credential DRepRole)
forall a b. (a -> b) -> a -> b
$ ((Credential DRepRole, Coin) -> Item (Set (Credential DRepRole)))
-> [(Credential DRepRole, Coin)]
-> [Item (Set (Credential DRepRole))]
forall a b. (a -> b) -> [a] -> [b]
map (Credential DRepRole, Coin) -> Item (Set (Credential DRepRole))
(Credential DRepRole, Coin) -> Credential DRepRole
forall a b. (a, b) -> a
fst ([(Credential DRepRole, Coin)]
 -> [Item (Set (Credential DRepRole))])
-> [(Credential DRepRole, Coin)]
-> [Item (Set (Credential DRepRole))]
forall a b. (a -> b) -> a -> b
$ (TxCert (LedgerEra era) -> Maybe (Credential DRepRole, Coin))
-> [TxCert (LedgerEra era)] -> [(Credential DRepRole, Coin)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxCert (LedgerEra era) -> Maybe (Credential DRepRole, Coin)
forall era.
ConwayEraTxCert era =>
TxCert era -> Maybe (Credential DRepRole, Coin)
L.getUnRegDRepTxCert [Item (StrictSeq (TxCert (LedgerEra era)))]
[TxCert (LedgerEra era)]
certs
        regPoolIds :: Set (KeyHash StakePool)
regPoolIds =
          [Item (Set (KeyHash StakePool))] -> Set (KeyHash StakePool)
forall l. IsList l => [Item l] -> l
fromList ([Item (Set (KeyHash StakePool))] -> Set (KeyHash StakePool))
-> [Item (Set (KeyHash StakePool))] -> Set (KeyHash StakePool)
forall a b. (a -> b) -> a -> b
$ (StakePoolParams -> Item (Set (KeyHash StakePool)))
-> [StakePoolParams] -> [Item (Set (KeyHash StakePool))]
forall a b. (a -> b) -> [a] -> [b]
map StakePoolParams -> Item (Set (KeyHash StakePool))
StakePoolParams -> KeyHash StakePool
L.sppId ([StakePoolParams] -> [Item (Set (KeyHash StakePool))])
-> [StakePoolParams] -> [Item (Set (KeyHash StakePool))]
forall a b. (a -> b) -> a -> b
$ (TxCert (LedgerEra era) -> Maybe StakePoolParams)
-> [TxCert (LedgerEra era)] -> [StakePoolParams]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxCert (LedgerEra era) -> Maybe StakePoolParams
forall era. EraTxCert era => TxCert era -> Maybe StakePoolParams
L.getRegPoolTxCert [Item (StrictSeq (TxCert (LedgerEra era)))]
[TxCert (LedgerEra era)]
certs
    (Set (Credential Staking)
unregStakeCreds, Set (Credential DRepRole)
unregDRepCreds, Set (KeyHash StakePool)
regPoolIds)