-
Notifications
You must be signed in to change notification settings - Fork 157
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- round trip test for translating exunits to/from plutus
- determining whether evaluateTransactionExecutionUnits
provides enough exUnits- Loading branch information
Showing
6 changed files
with
136 additions
and
32 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,111 @@ | ||
| {-# Language TypeApplications #-} | ||
| {-# Language DataKinds #-} | ||
|
|
||
| module Test.Cardano.Ledger.Alonzo.Tools | ||
| (tests, testExUnitCalculation) | ||
| where | ||
|
|
||
| import Test.Tasty (TestTree) | ||
| import Test.Tasty.QuickCheck | ||
|
|
||
| import Cardano.Ledger.Alonzo.TxInfo (transExUnits, exBudgetToExUnits) | ||
|
|
||
| import Cardano.Ledger.Alonzo.Scripts | ||
|
|
||
| import Data.Map (Map) | ||
| import qualified Data.Map as Map | ||
|
|
||
|
|
||
| import Control.State.Transition.Extended (TRC (..)) | ||
| import Test.Cardano.Ledger.EraBuffet | ||
| import Cardano.Ledger.Alonzo | ||
| import qualified Cardano.Ledger.Tx as Core | ||
|
|
||
| import Shelley.Spec.Ledger.LedgerState (UTxOState (..)) | ||
| import Shelley.Spec.Ledger.STS.Utxo (UtxoEnv (..)) | ||
|
|
||
| import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..), IsValidating (..)) | ||
|
|
||
| import GHC.Records (getField) | ||
| import Cardano.Ledger.Alonzo.Rules.Utxos | ||
| import Test.Shelley.Spec.Ledger.Utils | ||
|
|
||
| import Cardano.Ledger.Alonzo.PParams (PParams' (..)) | ||
| import Cardano.Slotting.EpochInfo.API | ||
| import Cardano.Slotting.Time | ||
| import Shelley.Spec.Ledger.UTxO | ||
| import Data.Array (Array) | ||
|
|
||
| import Cardano.Ledger.Alonzo.Tools | ||
| import Cardano.Ledger.Alonzo.Language | ||
| import Cardano.Ledger.Alonzo.TxWitness | ||
|
|
||
| tests :: TestTree | ||
| tests = testProperty "Plutus ExUnit translation round-trip" exUnitsTranslationRoundTrip | ||
|
|
||
| -- ExUnits should remain intact when translating to and from the plutus type | ||
| exUnitsTranslationRoundTrip :: Gen Property | ||
| exUnitsTranslationRoundTrip = do | ||
| e <- ExUnits <$> arbitrary <*> arbitrary | ||
| pure $ counterexample (show e) $ | ||
| (exBudgetToExUnits . transExUnits) e == Just e | ||
|
|
||
| type A = AlonzoEra StandardCrypto | ||
|
|
||
|
|
||
| -- checks plutus script validation against a tx which has had | ||
| -- its ex units replaced by the output of evaluateTransactionExecutionUnits | ||
| testExUnitCalculation :: | ||
| MonadFail m => | ||
| Core.Tx A -> | ||
| UTxOState A -> | ||
| UtxoEnv A -> | ||
| EpochInfo m -> | ||
| SystemStart -> | ||
| Array Language CostModel -> | ||
| m () | ||
| testExUnitCalculation tx utxoState utxoEnv ei ss costmdls = do | ||
| tx' <- updateTxExUnits tx utxo ei ss costmdls | ||
| _ <- failLeft $ runShelleyBase $ | ||
| applySTSTest @(UTXOS A) (TRC (utxoEnv, utxoState, vtx tx')) | ||
| pure () | ||
| where | ||
| utxo = _utxo utxoState | ||
|
|
||
| updateTxExUnits :: | ||
| MonadFail m => | ||
| Core.Tx A -> | ||
| UTxO A -> | ||
| EpochInfo m -> | ||
| SystemStart -> | ||
| Array Language CostModel -> | ||
| m (Core.Tx A) | ||
| updateTxExUnits tx utxo ei ss costmdls = do | ||
| -- rdmrs :: Map RdmrPtr ExUnits | ||
| rdmrs <- traverse failLeft =<< | ||
| evaluateTransactionExecutionUnits tx utxo ei ss costmdls | ||
| pure (replaceRdmrs tx rdmrs) | ||
|
|
||
| replaceRdmrs :: Core.Tx A -> Map RdmrPtr ExUnits -> Core.Tx A | ||
| replaceRdmrs tx rdmrs = tx { Core.wits = wits' } | ||
| where | ||
| wits' = (Core.wits tx) { txrdmrs = newrdmrs } | ||
| newrdmrs = foldr replaceRdmr (txrdmrs (Core.wits tx)) (Map.assocs rdmrs) | ||
|
|
||
| replaceRdmr :: (RdmrPtr,ExUnits) -> Redeemers A -> Redeemers A | ||
| replaceRdmr (ptr,ex) x@(Redeemers r) = | ||
| case Map.lookup ptr r of | ||
| Just (dat,_ex) -> Redeemers $ Map.insert ptr (dat,ex) r | ||
| Nothing -> x | ||
|
|
||
| failLeft :: MonadFail m => Show e => Either e a -> m a | ||
| failLeft (Right a) = pure a | ||
| failLeft (Left e) = fail (show e) | ||
|
|
||
| vtx :: Core.Tx A -> ValidatedTx A | ||
| vtx tx = ValidatedTx | ||
| { body = getField @"body" tx | ||
| , wits = getField @"wits" tx | ||
| , isValidating = IsValidating True | ||
| , auxiliaryData = getField @"auxiliaryData" tx | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters