Skip to content

Commit

Permalink
wip
Browse files Browse the repository at this point in the history
  • Loading branch information
@teodanciu
teodanciu committed Nov 22, 2024
1 parent faebab7 commit 526f084
Show file tree
Hide file tree
Showing 5 changed files with 516 additions and 10 deletions.
21 changes: 17 additions & 4 deletions eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxoSpec.hs
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
Expand All @@ -20,11 +21,12 @@ import Cardano.Ledger.Shelley.LedgerState (curPParamsEpochStateL, nesEsL)
import Control.Monad (forM)
import qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import Debug.Trace
import Lens.Micro (to, (&), (.~), (<>~), (^.))
import qualified PlutusLedgerApi.Common as P
import Test.Cardano.Ledger.Alonzo.ImpTest
import Test.Cardano.Ledger.Imp.Common
import Test.Cardano.Ledger.Plutus.Examples (alwaysSucceedsWithDatum)
import Test.Cardano.Ledger.Plutus.Examples -- (alwaysSucceedsWithDatum)

spec ::
forall era.
Expand All @@ -33,6 +35,17 @@ spec ::
) =>
SpecWith (ImpInit (LedgerSpec era))
spec = describe "UTXO" $ do
it "xxx" $ do
forM_ (eraLanguages @era) $ \lang ->
withSLanguage lang $ \slang -> do
maxExUnits <- getsNES $ nesEsL . curPParamsEpochStateL . ppMaxTxExUnitsL
let !_ = trace ("\n MAX EX UNITS:" <> (show maxExUnits) <> "\n") True

txIn <- produceScript . hashPlutusScript $ alwaysSucceedsWithDatum slang
-- txIn <- produceScript . hashPlutusScript $ alwaysSucceedsNoDatum slang
let tx = mkBasicTx mkBasicTxBody & bodyTxL . inputsTxBodyL .~ [txIn]
submitTx_ tx

it "Wrong network ID" $ do
submitFailingTx
(mkBasicTx mkBasicTxBody & bodyTxL . networkIdTxBodyL .~ SJust Mainnet)
Expand Down Expand Up @@ -71,13 +84,13 @@ spec = describe "UTXO" $ do
-- including random garbage. Auxiliary data fits the bill quite nicely
metadata <-
Map.fromList
<$> forM [1 .. (12 * 1024 `div` 64)] (\ix -> (,) ix . M.B <$> uniformByteStringM 64)
<$> forM [1 .. (1 * 1024 `div` 64)] (\ix -> (,) ix . M.B <$> uniformByteStringM 64)
let auxData = mkAlonzoTxAuxData @[] @era metadata []
tx =
mkBasicTx mkBasicTxBody
& bodyTxL . inputsTxBodyL <>~ [scriptInput]
& bodyTxL . collateralInputsTxBodyL <>~ [collateralInput]
& auxDataTxL .~ SJust auxData
-- & bodyTxL . collateralInputsTxBodyL <>~ [collateralInput]
-- & auxDataTxL .~ SJust auxData
percentage <-
getsNES $ nesEsL . curPParamsEpochStateL . ppCollateralPercentageL . to toInteger
submitFailingTxM tx $ \txFixed -> do
Expand Down
3 changes: 1 addition & 2 deletions eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -413,8 +413,7 @@ instance
pure
AlonzoGenesis
{ agCoinsPerUTxOWord = CoinPerWord (Coin 34482)
, -- TODO: Replace with correct cost model.
agCostModels = testingCostModels [PlutusV1]
, agCostModels = testingCostModels [PlutusV1]
, agPrices =
Prices
{ prMem = 577 %! 10_000
Expand Down
3 changes: 1 addition & 2 deletions eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -321,8 +321,7 @@ instance
, ucppDRepDeposit = Coin 70_000_000
, ucppDRepActivity = EpochInterval 100
, ucppMinFeeRefScriptCostPerByte = 15 %! 1
, -- TODO: Replace with correct cost model.
ucppPlutusV3CostModel = testingCostModel PlutusV3
, ucppPlutusV3CostModel = testingCostModel PlutusV3
}
, cgConstitution = Constitution constitutionAnchor (SJust guardrailScriptHash)
, cgCommittee = committee
Expand Down
177 changes: 175 additions & 2 deletions libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Plutus.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,7 @@ zeroTestingCostModels =
foldMap $ \lang -> mkCostModels (Map.singleton lang (zeroTestingCostModel lang))

zeroTestingCostModel :: HasCallStack => Language -> CostModel
zeroTestingCostModel lang = mkCostModelConst lang 0
zeroTestingCostModel lang = mkCostModelConst lang 1

zeroTestingCostModelV1 :: HasCallStack => CostModel
zeroTestingCostModelV1 = zeroTestingCostModel PlutusV1
Expand All @@ -106,7 +106,180 @@ testingCostModel = \case
PlutusV3 -> testingCostModelV3

testingCostModelV1 :: HasCallStack => CostModel
testingCostModelV1 = mkCostModel' PlutusV1 $ snd <$> PV1.costModelParamsForTesting
testingCostModelV1 = mkCostModelConst PlutusV1 1

actualTestingCostModelV1 :: HasCallStack => CostModel
actualTestingCostModelV1 =
mkCostModel' PlutusV1 $
( [ 4
, 1000
, 100
, 103599
, 1
, 621
, 29175
, 150000
, 1000
, 150000
, 61516
, 100
, 150000
, 150000
, 150000
, 32
, 150000
, 29773
, 150000
, 0
, 150000
, 0
, 1
, 118
, 150000
, 150000
, 32
, 136542
, 82363
, 5000
, 150000
, 179690
, 150000
, 0
, 118
, 1
, 150000
, 145276
, 1
, 32
, 32
, 150000
, 1
, 1
, 0
, 4
, 32
, 32
, 150000
, 32
, 1
, 32
, 248
, 0
, 100
, 0
, 32
, 118
, 29773
, 1
, 29773
, 29175
, 1
, 1
, 1
, 150000
, 150000
, 29773
, 150000
, 1
, 1000
, 1
, 1366
, 32
, 0
, 150000
, 1
, 32
, 32
, 197209
, 8
, 150000
, 150000
, 150000
, 148000
, 1
, 100
, 150000
, 150000
, 1326
, 100
, 197209
, 425507
, 0
, 100
, 2477736
, 148000
, 150000
, 150000
, 1000
, 1
, 11218
, 396231
, 248
, 1
, 0
, 10000
, 0
, 150000
, 150000
, 1
, 29773
, 1
, 3345831
, 32
, 32
, 1
, 4
, 1
, 32
, 247
, 150000
, 118
, 100
, 1
, 1
, 100
, 0
, 2477736
, 425507
, 1
, 32
, 150000
, 150000
, 32
, 4
, 32
, 32
, 29773
, 1
, 103599
, 1000
, 1
, 32
, 148000
, 29773
, 8
, 425507
, 32
, 1000
, 148000
, 1
, 32
, 0
, 150000
, 0
, 32
, 112536
, 1
, 497
, 425507
, 1
, 0
, 1
, 100
, 150000
] ::
[Integer]
)

testingCostModelV2 :: HasCallStack => CostModel
testingCostModelV2 = mkCostModel' PlutusV2 $ snd <$> PV2.costModelParamsForTesting
Expand Down
Loading

0 comments on commit 526f084

Please sign in to comment.