[temp ] -crazy logs

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/Evaluate.hs

@@ -63,6 +63,7 @@ import Data.MapExtras (fromElems)
 import Data.Maybe (mapMaybe)
 import qualified Data.Set as Set
 import Data.Text (Text)
+import Debug.Trace
 import qualified Debug.Trace as Debug
 import GHC.Generics
 import Lens.Micro
@@ -369,7 +370,8 @@ evalTxExUnitsWithLogs ::
 evalTxExUnitsWithLogs pp tx utxo epochInfo systemStart = Map.mapWithKey findAndCount rdmrs
   where
     keyedByPurpose (plutusPurpose, _) = hoistPlutusPurpose toAsIx plutusPurpose
-    purposeToScriptHash = fromElems keyedByPurpose scriptsNeeded
+    purposeToScriptHash = fromElems keyedByPurpose $ trace ("Scripts needed:" <> show scriptsNeeded) scriptsNeeded
+    msg = "\n!!!!!!!!!!!!!!!!!!!!!!!!! PURPOSE TO SCRIPT HASH:" <> (show purposeToScriptHash)
     ledgerTxInfo =
       LedgerTxInfo
         { ltiProtVer = protVer
@@ -389,7 +391,7 @@ evalTxExUnitsWithLogs pp tx utxo epochInfo systemStart = Map.mapWithKey findAndC
     findAndCount pointer (redeemerData, exUnits) = do
       (plutusPurpose, plutusScriptHash) <-
         note (RedeemerPointsToUnknownScriptHash pointer) $
-          Map.lookup pointer purposeToScriptHash
+          Map.lookup pointer (trace msg purposeToScriptHash)
       let ptrToPlutusScriptNoContext =
             Map.map
               ( \(sp, sh) ->
@@ -414,7 +416,18 @@ evalTxExUnitsWithLogs pp tx utxo epochInfo systemStart = Map.mapWithKey findAndC
             ledgerTxInfo
             (redeemerData, maxBudget)
             costModel
-      case evaluatePlutusWithContext P.Verbose pwc of
+      let !_ = trace ("\n PLUTUS CONTEXT:" <> (show pwc) <> "\n") True
+      let res = evaluatePlutusWithContext P.Verbose pwc
+      let !_ =
+            trace
+              ( "\n CALLING evaluatePlutusWithContext, with costmodel: "
+                  <> show costModel
+                  <> "\nand with result: "
+                  <> (show res)
+                  <> "\n"
+              )
+              True
+      case res of
         (logs, Left err) -> Left $ ValidationFailure exUnits err logs pwc
         (logs, Right exBudget) ->
           note (IncompatibleBudget exBudget) $

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp.hs

@@ -8,11 +8,13 @@
 module Test.Cardano.Ledger.Alonzo.Imp where
 
 import Cardano.Ledger.Alonzo.Core
+import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo)
 import Cardano.Ledger.Alonzo.Rules (
   AlonzoUtxoPredFailure,
   AlonzoUtxosPredFailure,
   AlonzoUtxowPredFailure,
  )
+import Cardano.Ledger.Plutus.Language (Language (..))
 import Cardano.Ledger.Shelley.Rules (ShelleyUtxoPredFailure, ShelleyUtxowPredFailure)
 import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxoSpec as Utxo
 import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxosSpec as Utxos
@@ -25,6 +27,7 @@ spec ::
   forall era.
   ( Arbitrary (TxAuxData era)
   , AlonzoEraImp era
+  , EraPlutusTxInfo 'PlutusV1 era
   , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
   , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
   , InjectRuleFailure "LEDGER" AlonzoUtxoPredFailure era

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxoSpec.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -9,28 +10,46 @@
 module Test.Cardano.Ledger.Alonzo.Imp.UtxoSpec (spec) where
 
 import Cardano.Ledger.Alonzo.Core
+
+-- (eraLanguages)
+
+-- (Globals (..), Mismatch (..), Network (..), StrictMaybe (..))
+
+-- (Data (..), ExUnits (..), hashPlutusScript, withSLanguage)
+
+import Cardano.Ledger.Alonzo.Plutus.Context
+import Cardano.Ledger.Alonzo.Plutus.Evaluate
 import Cardano.Ledger.Alonzo.Rules (AlonzoUtxoPredFailure (..))
-import Cardano.Ledger.Alonzo.Scripts (eraLanguages)
+import Cardano.Ledger.Alonzo.Scripts
 import Cardano.Ledger.Alonzo.TxAuxData (mkAlonzoTxAuxData)
 import Cardano.Ledger.Alonzo.TxWits (Redeemers (..))
-import Cardano.Ledger.BaseTypes (Mismatch (..), Network (..), StrictMaybe (..))
+import Cardano.Ledger.Alonzo.UTxO (AlonzoEraUTxO (..))
+import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Coin (Coin (..), toDeltaCoin)
 import qualified Cardano.Ledger.Metadata as M
 import Cardano.Ledger.Plutus
 import Cardano.Ledger.Shelley.LedgerState (curPParamsEpochStateL, nesEsL)
 import Control.Monad (forM)
+import Data.Either (fromRight)
+import Data.Map ((!))
 import qualified Data.Map.Strict as Map
+import Data.Proxy
 import Data.Ratio ((%))
 import Debug.Trace
 import Lens.Micro (to, (&), (.~), (<>~), (^.))
+import Lens.Micro.Mtl (use)
 import qualified PlutusLedgerApi.Common as P
+import qualified PlutusLedgerApi.V1 as PV1
 import Test.Cardano.Ledger.Alonzo.ImpTest
 import Test.Cardano.Ledger.Imp.Common
+import Test.Cardano.Ledger.Plutus
 import Test.Cardano.Ledger.Plutus.Examples (alwaysSucceedsWithDatum)
 
 spec ::
   forall era.
   ( AlonzoEraImp era
+  , AlonzoEraUTxO era
+  , EraPlutusTxInfo 'PlutusV1 era
   , InjectRuleFailure "LEDGER" AlonzoUtxoPredFailure era
   ) =>
   SpecWith (ImpInit (LedgerSpec era))
@@ -53,6 +72,238 @@ spec = describe "UTXO" $ do
             (True)
     withNoFixup $ submitTx_ tx
 
+  let fixupPreRedeemers =
+        addNativeScriptTxWits
+          >=> fixupAuxDataHash
+          >=> addCollateralInput
+          >=> addRootTxIn
+          >=> fixupScriptWits
+          >=> fixupOutputDatums
+          >=> fixupDatums
+          >=> fixupRedeemerIndices
+  let fixupPostRedeemers =
+        fixupPPHash
+          >=> fixupTxOuts
+          >=> fixupFees
+          >=> updateAddrTxWits
+
+  it "calculateBudget" $ do
+    let calcBudget
+          pv
+          epochInfo
+          systemStart
+          utxo
+          ec
+          plRunnable
+          tx
+          (prpIdxIt, scriptHash, ScriptTestContext plutus (PlutusArgs dat mbSpendingDat)) =
+            let proxy = Proxy @PlutusV1
+                prpIx = hoistPlutusPurpose @era toAsIx prpIdxIt
+                prpIt = hoistPlutusPurpose @era toAsItem prpIdxIt
+                maybeSpendingDatum = getSpendingDatum utxo tx prpIt
+                lti = LedgerTxInfo pv epochInfo systemStart utxo tx
+
+                Right budget = do
+                  txInfo <- toPlutusTxInfo proxy lti
+                  plutusArgs <- toPlutusArgs proxy pv txInfo prpIdxIt maybeSpendingDatum (Data dat)
+                  pure $ evaluatePlutusRunnableBudget @PlutusV1 (pvMajor pv) P.Verbose ec plRunnable plutusArgs
+             in budget
+    Globals {systemStart, epochInfo} <- use impGlobalsL
+    pp <- getsNES $ nesEsL . curPParamsEpochStateL
+    let pv = pp ^. ppProtocolVersionL
+    let ec = getEvaluationContext $ costModelsValid (pp ^. ppCostModelsL) ! PlutusV1
+
+    let pl = alwaysSucceedsWithDatum SPlutusV1
+    let (Right plRunnable) = decodePlutusRunnable @PlutusV1 (pvMajor pv) pl
+    tx <- do
+      txIn <- produceScript . hashPlutusScript $ pl
+      pure $ mkBasicTx mkBasicTxBody & bodyTxL . inputsTxBodyL .~ [txIn]
+    utxo <- getUTxO
+    contexts <- impGetPlutusContexts tx
+
+    let budget = calcBudget pv epochInfo systemStart utxo ec plRunnable tx <$> contexts
+    let !_ = trace ("\n BUDGET:" <> (show budget) <> "\n") (True)
+    pure ()
+
+  it "aaa" $ do
+    Globals {systemStart, epochInfo} <- use impGlobalsL
+    pp <- getsNES $ nesEsL . curPParamsEpochStateL
+    let pv = pp ^. ppProtocolVersionL
+    let cm = pp ^. ppCostModelsL
+    let cmV1 = (costModelsValid cm) ! PlutusV1
+    let ec = getEvaluationContext cmV1
+
+    let pl = alwaysSucceedsWithDatum SPlutusV1
+    let (Right plRunnable) = decodePlutusRunnable @PlutusV1 (pvMajor pv) pl
+
+    txIn <- produceScript . hashPlutusScript $ pl
+    let tx0 = mkBasicTx mkBasicTxBody & bodyTxL . inputsTxBodyL .~ [txIn]
+    tx1 <- (fixupPreRedeemers >=> txWithMaxRedeemers) tx0
+    -- tx1 <- fixupPreRedeemers tx0
+    let !_ = trace ("\n Max Redeemers::" <> (show (tx1 ^. witsTxL . rdmrsTxWitsL)) <> "\n") (True)
+    utxo <- getUTxO
+
+    contexts <- impGetPlutusContexts tx1
+
+    let f tx (prpIdxIt, scriptHash, ScriptTestContext plutus (PlutusArgs dat mbSpendingDat)) =
+          let proxy = Proxy @PlutusV1
+              prpIx = hoistPlutusPurpose @era toAsIx prpIdxIt
+              prpIt = hoistPlutusPurpose @era toAsItem prpIdxIt
+              maybeSpendingDatum = getSpendingDatum utxo tx prpIt
+              lti = LedgerTxInfo pv epochInfo systemStart utxo tx
+
+              res = do
+                txInfo <- toPlutusTxInfo proxy lti
+                plutusArgs <- toPlutusArgs proxy pv txInfo prpIdxIt maybeSpendingDatum (Data dat)
+                pure $ evaluatePlutusRunnableBudget @PlutusV1 (pvMajor pv) P.Verbose ec plRunnable plutusArgs
+           in res
+
+    let x = f tx1 <$> contexts
+
+    let !_ = trace ("\n XXXXXXX" <> (show x) <> "\n") (True)
+    -- let reports = evalTxExUnitsWithLogs pp tx1 utxo epochInfo systemStart
+    -- let !_ = trace ("\n ====================REPORTS:" <> (show reports) <> "\n") True
+
+    tx2 <- fixupPostRedeemers tx1
+
+    let y = f tx2 <$> contexts
+    let !_ = trace ("\n YYYYYY" <> (show y) <> "\n") (True)
+
+    pure ()
+
+  it "bbb" $ do
+    let pl = alwaysSucceedsWithDatum SPlutusV1
+    txIn <- produceScript . hashPlutusScript $ pl
+    let tx0 = mkBasicTx mkBasicTxBody & bodyTxL . inputsTxBodyL .~ [txIn]
+    tx <- (fixupPreRedeemers >=> txWithMaxRedeemers >=> fixupPostRedeemers >=> fixupRedeemers) tx0
+
+    let !_ =
+          trace
+            ( "\n ------------------------------------ REDEEEMERS:"
+                <> (show (tx ^. witsTxL . rdmrsTxWitsL))
+                <> "\n"
+            )
+            (True)
+    withNoFixup $ submitTx_ tx
+
+  it "ccc" $ do
+    let pl = alwaysSucceedsWithDatum SPlutusV1
+    txIn <- produceScript . hashPlutusScript $ pl
+    let tx0 = mkBasicTx mkBasicTxBody & bodyTxL . inputsTxBodyL .~ [txIn]
+    txWithMax <-
+      (fixupPreRedeemers >=> txWithMaxRedeemers >=> fixupPostRedeemers >=> fixupRedeemers) tx0
+    let !_ =
+          trace
+            ( "\n ------------------------------------ REDEEEMERS:"
+                <> (show (txWithMax ^. witsTxL . rdmrsTxWitsL))
+                <> "\n"
+            )
+            (True)
+    let !_ =
+          trace
+            ( "\n ------------------------------------ FEES:"
+                <> (show (txWithMax ^. bodyTxL . feeTxBodyL))
+                <> "\n"
+            )
+            (True)
+
+    txWithNormal <- fixupTx tx0
+    let !_ =
+          trace
+            ( "\n ------------------------------------ REDEEEMERS:"
+                <> (show (txWithNormal ^. witsTxL . rdmrsTxWitsL))
+                <> "\n"
+            )
+            (True)
+    let !_ =
+          trace
+            ( "\n ------------------------------------ FEES:"
+                <> (show (txWithNormal ^. bodyTxL . feeTxBodyL))
+                <> "\n"
+            )
+            (True)
+
+    pure ()
+
+  it "yyy" $ do
+    let version = natVersion @5
+    Globals {systemStart, epochInfo} <- use impGlobalsL
+    pp <- getsNES $ nesEsL . curPParamsEpochStateL
+
+    let cm = pp ^. ppCostModelsL
+    let cmV1 = (costModelsValid cm) ! PlutusV1
+    let ec = getEvaluationContext cmV1
+
+    let plutus = alwaysSucceedsWithDatum SPlutusV1
+    let plHash = hashPlutusScript @(EraCrypto era) plutus
+
+    let (PlutusBinary sbs) = plutusBinary plutus
+    let (Right (PlutusRunnable rs)) = decodePlutusRunnable version plutus
+
+    let maxSteps = 10000000000
+    let maxMem = 10000000
+    let x =
+          PV1.evaluateScriptRestricting
+            (P.MajorProtocolVersion 5)
+            P.Verbose
+            ec
+            (PV1.ExBudget (PV1.ExCPU (fromIntegral maxSteps)) (PV1.ExMemory (fromIntegral maxMem)))
+            rs
+
+    let !_ = trace ("\n cmV1" <> (show cmV1) <> "\n") True
+    pure ()
+
+  it "zzz" $ do
+    utxo <- getUTxO
+    Globals {systemStart, epochInfo} <- use impGlobalsL
+    pp <- getsNES $ nesEsL . curPParamsEpochStateL
+    txIn <- produceScript . hashPlutusScript $ alwaysSucceedsWithDatum SPlutusV1
+    printUTxO
+    let tx0 = mkBasicTx mkBasicTxBody & bodyTxL . inputsTxBodyL .~ [txIn]
+
+    tx1 <- fixupTx tx0
+
+    let reports = evalTxExUnitsWithLogs pp tx1 utxo epochInfo systemStart
+
+    let !_ =
+          trace
+            ( "\n --------------------------------------------------- ULTIMATE REPORTS----------------------------------------"
+                <> (show reports)
+                <> "\n"
+            )
+            True
+
+    pure ()
+  it "xxx" $ do
+    forM_ (eraLanguages @era) $ \lang ->
+      withSLanguage lang $ \slang -> do
+        -- maxExUnits <- getsNES $ nesEsL . curPParamsEpochStateL . ppMaxTxExUnitsL
+        txIn <- produceScript . hashPlutusScript $ alwaysSucceedsWithDatum slang
+        let tx0 = mkBasicTx mkBasicTxBody & bodyTxL . inputsTxBodyL .~ [txIn]
+        tx1 <-
+          ( addNativeScriptTxWits
+              >=> fixupAuxDataHash
+              >=> addCollateralInput
+              >=> addRootTxIn
+              >=> fixupScriptWits
+              >=> fixupOutputDatums
+              >=> fixupDatums
+              >=> fixupRedeemerIndices
+          )
+            tx0
+        tx2 <- fixupRedeemers tx1
+        tx3 <-
+          ( fixupPPHash
+              >=> fixupTxOuts
+              >=> fixupFees
+              >=> updateAddrTxWits
+          )
+            tx2
+        pure ()
+        withNoFixup $ submitTx_ tx3
+  -- submitTx_ tx0
+
+  -- submitTx_ tx
   it "Wrong network ID" $ do
     submitFailingTx
       (mkBasicTx mkBasicTxBody & bodyTxL . networkIdTxBodyL .~ SJust Mainnet)