import Hydra.Prelude hiding (label)
import qualified Cardano.Api.UTxO as UTxO
+
import qualified Cardano.Ledger.Alonzo.Data as Ledger
import Cardano.Ledger.Alonzo.Language (Language (PlutusV1, PlutusV2))
+
import qualified Cardano.Ledger.Alonzo.PlutusScriptApi as Ledger
import Cardano.Ledger.Alonzo.Scripts (CostModels (CostModels), ExUnits (..), Prices (..), txscriptfee)
-
import Cardano.Ledger.Alonzo.TxInfo (slotToPOSIXTime)
+
import qualified Cardano.Ledger.Alonzo.Scripts as Ledger
+
import Cardano.Ledger.Alonzo.TxInfo (ExtendedUTxO (txInfo), slotToPOSIXTime)
+
import qualified Cardano.Ledger.Alonzo.TxInfo as Ledger
import Cardano.Ledger.Babbage.PParams (PParams' (..))
+
import qualified Cardano.Ledger.Babbage.Tx as Babbage
import Cardano.Ledger.BaseTypes (ProtVer (..), boundRational)
import Cardano.Ledger.Coin (Coin (Coin))
import Cardano.Ledger.Val (Val ((<+>)), (<×>))
EraInMode (BabbageEraInCardanoMode),
IsShelleyBasedEra (shelleyBasedEra),
ProtocolParameters (protocolParamMaxTxExUnits, protocolParamMaxTxSize),
ScriptExecutionError (ScriptErrorMissingScript),
import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod))
import Hydra.Data.ContestationPeriod (posixToUTCTime)
import Ouroboros.Consensus.Util.Counting (NonEmpty (NonEmptyOne))
+
import Plutus.ApiCommon (evaluateScriptCounting)
+
import qualified Plutus.ApiCommon as Plutus
import Test.Cardano.Ledger.Alonzo.PlutusScripts (testingCostModelV1, testingCostModelV2)
import Test.QuickCheck (choose)
import Test.QuickCheck.Gen (chooseWord64)
pp = toLedgerPParams (shelleyBasedEra @Era) pparams
allExunits = foldMap toLedgerExUnits . rights $ toList evaluationReport
+
-- | Like 'evaluateTx', but instead of actual evaluation, return the applied
+
-- scripts for each redeemer to be evaluated externally. This is required to use
+
-- profiling information.
+
-- NOTE: This assumes we use 'Babbage' and only 'PlutusV2' scripts are used.
+
Either String [ShortByteString]
+
prepareTxScripts tx utxo = do
+
-- NOTE: vendored from cardano-ledger
+
let info = txInfo pp PlutusV2 ei systemStart lutxo ltx
+
-- Either [CollectError (Crypto era)] [(ShortByteString, Language, [Data era], ExUnits, CostModel)]
+
case Ledger.collectTwoPhaseScriptInputs ei systemStart pp ltx lutxo of
+
Left e -> Left $ show e
+
res <- forM results $ \(script, _language, arguments, _exUnits, costModel) -> do
+
let ec = Ledger.getEvaluationContext costModel
+
pv = Ledger.transProtocolVersion (_protocolVersion pp)
+
pArgs = Ledger.getPlutusData <$> arguments
+
case evaluateScriptCounting Plutus.PlutusV2 pv Plutus.Verbose ec script pArgs of
+
(logs, Left e) -> Left $ show e <> "\n" <> show logs
+
(_, Right budget) -> Right budget
+
traceShow res $ pure []
+
pp = toLedgerPParams (shelleyBasedEra @Era) pparams
+
ltx = toLedgerTx tx :: Babbage.ValidatedTx LedgerEra
+
lutxo = toLedgerUTxO utxo
+
ei = toLedgerEpochInfo eraHistory
-- | Current mainchain protocol parameters.
