SCP-3631: Make protocolParameters configurable (#455)

* WIP

* Pass around Params instead of SlotConfig

* Use Params in Ledger.Validation

* Implement collateralPercent

* Use alternative protocol parameters for some bigger test cases.

* Restore all use case tests

* PR feedback

* Don't enable "allowBigTransactions" by default for contract model testing

* Fix pab test.

plutus-contract/src/Plutus/Contract/Test.hs

@@ -71,6 +71,7 @@ module Plutus.Contract.Test(
     , minLogLevel
     , emulatorConfig
     , changeInitialWalletValue
+    , allowBigTransactions
     -- * Etc
     , goldenPir
     ) where
@@ -132,7 +133,7 @@ import Plutus.V1.Ledger.Scripts qualified as Ledger
 import Data.IORef
 import Plutus.Contract.Test.Coverage
 import Plutus.Contract.Trace as X
-import Plutus.Trace.Emulator (EmulatorConfig (..), EmulatorTrace, runEmulatorStream)
+import Plutus.Trace.Emulator (EmulatorConfig (..), EmulatorTrace, params, runEmulatorStream)
 import Plutus.Trace.Emulator.Types (ContractConstraints, ContractInstanceLog, ContractInstanceState (..),
                                     ContractInstanceTag, UserThreadMsg)
 import PlutusTx.Coverage
@@ -184,6 +185,11 @@ defaultCheckOptions =
 changeInitialWalletValue :: Wallet -> (Value -> Value) -> CheckOptions -> CheckOptions
 changeInitialWalletValue wallet = over (emulatorConfig . initialChainState . _Left . ix wallet)
 
+-- | Set higher limits on transaction size and execution units.
+-- This can be used to work around @MaxTxSizeUTxO@ and @ExUnitsTooBigUTxO@ errors.
+-- Note that if you need this your Plutus script will probably not validate on Mainnet.
+allowBigTransactions :: CheckOptions -> CheckOptions
+allowBigTransactions = over (emulatorConfig . params) Ledger.allowBigTransactions
 
 -- | Check if the emulator trace meets the condition
 checkPredicate ::

plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs

@@ -47,7 +47,7 @@ import Plutus.Contract.Resumable (Request (Request, itID, rqID, rqRequest),
                                   Response (Response, rspItID, rspResponse, rspRqID))
 
 import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, LogObserve, logDebug, logWarn, surroundDebug)
-import Ledger (POSIXTime, POSIXTimeRange, PaymentPubKeyHash, Slot, SlotRange)
+import Ledger (POSIXTime, POSIXTimeRange, Params (..), PaymentPubKeyHash, Slot, SlotRange)
 import Ledger.Constraints.OffChain (UnbalancedTx)
 import Ledger.TimeSlot qualified as TimeSlot
 import Ledger.Tx (CardanoTx)
@@ -147,11 +147,11 @@ handleTimeNotifications =
     RequestHandler $ \targetTime_ ->
         surroundDebug @Text "handleTimeNotifications" $ do
             currentSlot <- Wallet.Effects.getClientSlot
-            slotConfig <- Wallet.Effects.getClientSlotConfig
-            let targetSlot_ = TimeSlot.posixTimeToEnclosingSlot slotConfig targetTime_
+            Params { pSlotConfig } <- Wallet.Effects.getClientParams
+            let targetSlot_ = TimeSlot.posixTimeToEnclosingSlot pSlotConfig targetTime_
             logDebug $ SlotNoticationTargetVsCurrent targetSlot_ currentSlot
             guard (currentSlot >= targetSlot_)
-            pure $ TimeSlot.slotToEndPOSIXTime slotConfig currentSlot
+            pure $ TimeSlot.slotToEndPOSIXTime pSlotConfig currentSlot
 
 handleCurrentSlot ::
     forall effs a.
@@ -173,8 +173,8 @@ handleCurrentTime ::
 handleCurrentTime =
     RequestHandler $ \_ ->
         surroundDebug @Text "handleCurrentTime" $ do
-            slotConfig <- Wallet.Effects.getClientSlotConfig
-            TimeSlot.slotToEndPOSIXTime slotConfig <$> Wallet.Effects.getClientSlot
+            Params { pSlotConfig }  <- Wallet.Effects.getClientParams
+            TimeSlot.slotToEndPOSIXTime pSlotConfig <$> Wallet.Effects.getClientSlot
 
 handleTimeToSlotConversions ::
     forall effs.
@@ -185,8 +185,8 @@ handleTimeToSlotConversions ::
 handleTimeToSlotConversions =
     RequestHandler $ \poxisTimeRange ->
         surroundDebug @Text "handleTimeToSlotConversions" $ do
-            slotConfig <- Wallet.Effects.getClientSlotConfig
-            pure $ TimeSlot.posixTimeRangeToContainedSlotRange slotConfig poxisTimeRange
+            Params { pSlotConfig }  <- Wallet.Effects.getClientParams
+            pure $ TimeSlot.posixTimeRangeToContainedSlotRange pSlotConfig poxisTimeRange
 
 handleUnbalancedTransactions ::
     forall effs.

plutus-contract/src/Plutus/Trace/Emulator.hs

@@ -58,7 +58,7 @@ module Plutus.Trace.Emulator(
     -- * Running traces
     , EmulatorConfig(..)
     , initialChainState
-    , slotConfig
+    , params
     , runEmulatorStream
     , TraceConfig(..)
     , runEmulatorTrace
@@ -94,8 +94,8 @@ import Wallet.Emulator.MultiAgent (EmulatorEvent,
                                    EmulatorEvent' (InstanceEvent, SchedulerEvent, UserThreadEvent, WalletEvent),
                                    EmulatorState (_chainState, _walletStates), MultiAgentControlEffect,
                                    MultiAgentEffect, _eteEmulatorTime, _eteEvent, schedulerEvent)
-import Wallet.Emulator.Stream (EmulatorConfig (_initialChainState), EmulatorErr, _slotConfig, foldEmulatorStreamM,
-                               initialChainState, initialDist, runTraceStream, slotConfig)
+import Wallet.Emulator.Stream (EmulatorConfig (_initialChainState, _params), EmulatorErr, foldEmulatorStreamM,
+                               initialChainState, initialDist, params, runTraceStream)
 import Wallet.Emulator.Stream qualified
 import Wallet.Emulator.Wallet (Entity, balances)
 import Wallet.Emulator.Wallet qualified as Wallet
@@ -123,6 +123,7 @@ import Streaming (Stream)
 import Streaming.Prelude (Of ((:>)))
 
 import Data.Aeson qualified as A
+import Ledger.Params (Params (..))
 import Ledger.TimeSlot (SlotConfig)
 import Plutus.V1.Ledger.Slot (getSlot)
 import Plutus.V1.Ledger.Value (Value, flattenValue)
@@ -208,7 +209,7 @@ interpretEmulatorTrace conf action =
         $ runThreads
         $ do
             raise $ launchSystemThreads wallets
-            handleEmulatorTrace (_slotConfig conf) action'
+            handleEmulatorTrace (pSlotConfig $ _params conf) action'
 
 -- | Options for how to set up and print the trace.
 data TraceConfig = TraceConfig

plutus-contract/src/Plutus/Trace/Emulator/Extract.hs

@@ -23,10 +23,11 @@ import Data.Monoid (Sum (..))
 import Flat (flat)
 import Ledger.Constraints.OffChain (UnbalancedTx (..))
 import Ledger.Index (ScriptValidationEvent (..), ValidatorMode (..), getScript)
+import Ledger.Params (Params (..))
 import Ledger.TimeSlot (SlotConfig)
 import Plutus.Contract.Request (MkTxLog)
 import Plutus.Contract.Wallet (export)
-import Plutus.Trace.Emulator (EmulatorConfig (_slotConfig), EmulatorTrace)
+import Plutus.Trace.Emulator (EmulatorConfig (_params), EmulatorTrace)
 import Plutus.Trace.Emulator qualified as Trace
 import Plutus.V1.Ledger.Api (ExBudget (..))
 import Plutus.V1.Ledger.Scripts (Script (..))
@@ -68,7 +69,7 @@ writeScriptsTo
     -> IO (Sum Int64, ExBudget) -- Total size and 'ExBudget' of extracted scripts
 writeScriptsTo ScriptsConfig{scPath, scCommand} prefix trace emulatorCfg = do
     let stream = Trace.runEmulatorStream emulatorCfg trace
-        slotCfg = _slotConfig emulatorCfg
+        slotCfg = pSlotConfig $ _params emulatorCfg
         getEvents :: Folds.EmulatorEventFold a -> a
         getEvents theFold = S.fst' $ run $ foldEmulatorStreamM (L.generalize theFold) stream
     createDirectoryIfMissing True scPath

plutus-contract/src/Plutus/Trace/Playground.hs

@@ -38,6 +38,7 @@ import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Maybe (fromMaybe)
 
+import Ledger.Params (pSlotConfig)
 import Plutus.Contract (Contract (..))
 import Plutus.Trace.Effects.ContractInstanceId (ContractInstanceIdEff, handleDeterministicIds)
 import Plutus.Trace.Effects.EmulatedWalletAPI (EmulatedWalletAPI, handleEmulatedWalletAPI)
@@ -110,7 +111,7 @@ handlePlaygroundTrace ::
 handlePlaygroundTrace conf contract action = do
     _ <- flip handleError (throwError . EmulatedWalletError)
             . reinterpret handleEmulatedWalletAPI
-            . interpret (handleWaiting @_ @effs (_slotConfig conf))
+            . interpret (handleWaiting @_ @effs (pSlotConfig $ _params conf))
             . subsume
             . interpret (handleRunContractPlayground @w @s @e @_ @effs contract)
             $ raiseEnd action

plutus-contract/src/Wallet/API.hs

@@ -29,13 +29,14 @@ module Wallet.API(
     NodeClientEffect,
     publishTx,
     getClientSlot,
-    getClientSlotConfig,
+    getClientParams,
     PubKey(..),
     PubKeyHash(..),
     signTxAndSubmit,
     signTxAndSubmit_,
     payToPaymentPublicKeyHash,
     payToPaymentPublicKeyHash_,
+    Params(..),
     -- * Slot ranges
     Interval(..),
     Slot,
@@ -63,13 +64,13 @@ import Control.Monad.Freer.Extras.Log (LogMsg, logWarn)
 import Data.Default (Default (def))
 import Data.Text (Text)
 import Data.Void (Void)
-import Ledger (CardanoTx, Interval (Interval, ivFrom, ivTo), PaymentPubKeyHash, PubKey (PubKey, getPubKey),
+import Ledger (CardanoTx, Interval (Interval, ivFrom, ivTo), Params (..), PaymentPubKeyHash, PubKey (PubKey, getPubKey),
                PubKeyHash (PubKeyHash, getPubKeyHash), Slot, SlotRange, Value, after, always, before, contains,
                interval, isEmpty, member, singleton, width)
 import Ledger.Constraints qualified as Constraints
 import Ledger.TimeSlot qualified as TimeSlot
-import Wallet.Effects (NodeClientEffect, WalletEffect, balanceTx, getClientSlot, getClientSlotConfig,
-                       ownPaymentPubKeyHash, publishTx, submitTxn, walletAddSignature, yieldUnbalancedTx)
+import Wallet.Effects (NodeClientEffect, WalletEffect, balanceTx, getClientParams, getClientSlot, ownPaymentPubKeyHash,
+                       publishTx, submitTxn, walletAddSignature, yieldUnbalancedTx)
 import Wallet.Error (WalletAPIError (PaymentMkTxError))
 import Wallet.Error qualified
 

plutus-contract/src/Wallet/Effects.hs

@@ -22,13 +22,12 @@ module Wallet.Effects(
     , NodeClientEffect(..)
     , publishTx
     , getClientSlot
-    , getClientSlotConfig
+    , getClientParams
     ) where
 
 import Control.Monad.Freer.TH (makeEffect)
-import Ledger (CardanoTx, PaymentPubKeyHash, Slot, Value)
+import Ledger (CardanoTx, Params, PaymentPubKeyHash, Slot, Value)
 import Ledger.Constraints.OffChain (UnbalancedTx)
-import Ledger.TimeSlot (SlotConfig)
 import Wallet.Error (WalletAPIError)
 
 data WalletEffect r where
@@ -44,5 +43,5 @@ makeEffect ''WalletEffect
 data NodeClientEffect r where
     PublishTx :: CardanoTx -> NodeClientEffect ()
     GetClientSlot :: NodeClientEffect Slot
-    GetClientSlotConfig :: NodeClientEffect SlotConfig
+    GetClientParams :: NodeClientEffect Params
 makeEffect ''NodeClientEffect

plutus-contract/src/Wallet/Emulator/Chain.hs

@@ -31,12 +31,11 @@ import Data.Maybe (mapMaybe)
 import Data.Monoid (Ap (Ap))
 import Data.Traversable (for)
 import GHC.Generics (Generic)
-import Ledger (Block, Blockchain, CardanoTx (..), OnChainTx (..), ScriptValidationEvent, Slot (..),
+import Ledger (Block, Blockchain, CardanoTx (..), OnChainTx (..), Params (..), ScriptValidationEvent, Slot (..),
                SomeCardanoApiTx (SomeTx), Tx (..), TxId, TxIn (txInRef), TxOut (txOutValue), Value, eitherTx,
                getCardanoTxId, mergeCardanoTxWith, onCardanoTx)
 import Ledger.Index qualified as Index
 import Ledger.Interval qualified as Interval
-import Ledger.TimeSlot (SlotConfig)
 import Ledger.Validation qualified as Validation
 import Plutus.Contract.Util (uncurry3)
 import Prettyprinter
@@ -79,7 +78,7 @@ data ChainControlEffect r where
 data ChainEffect r where
     QueueTx :: CardanoTx -> ChainEffect ()
     GetCurrentSlot :: ChainEffect Slot
-    GetSlotConfig :: ChainEffect SlotConfig
+    GetParams :: ChainEffect Params
 
 -- | Make a new block
 processBlock :: Member ChainControlEffect effs => Eff effs Block
@@ -92,23 +91,23 @@ modifySlot = send . ModifySlot
 queueTx :: Member ChainEffect effs => CardanoTx -> Eff effs ()
 queueTx tx = send (QueueTx tx)
 
-getSlotConfig :: Member ChainEffect effs => Eff effs SlotConfig
-getSlotConfig = send GetSlotConfig
+getParams :: Member ChainEffect effs => Eff effs Params
+getParams = send GetParams
 
 getCurrentSlot :: Member ChainEffect effs => Eff effs Slot
 getCurrentSlot = send GetCurrentSlot
 
 type ChainEffs = '[State ChainState, LogMsg ChainEvent]
 
-handleControlChain :: Members ChainEffs effs => SlotConfig -> ChainControlEffect ~> Eff effs
-handleControlChain slotCfg = \case
+handleControlChain :: Members ChainEffs effs => Params -> ChainControlEffect ~> Eff effs
+handleControlChain params = \case
     ProcessBlock -> do
         st <- get
         let pool  = st ^. txPool
             slot  = st ^. currentSlot
             idx   = st ^. index
             ValidatedBlock block events rest =
-                validateBlock slotCfg slot idx pool
+                validateBlock params slot idx pool
 
         let st' = st & txPool .~ rest
                      & addBlock block
@@ -125,11 +124,11 @@ logEvent e = case e of
     TxnValidationFail{} -> logWarn e
     TxnValidate{}       -> logInfo e
 
-handleChain :: (Members ChainEffs effs) => SlotConfig -> ChainEffect ~> Eff effs
-handleChain slotConfig = \case
+handleChain :: (Members ChainEffs effs) => Params -> ChainEffect ~> Eff effs
+handleChain params = \case
     QueueTx tx     -> modify $ over txPool (addTxToPool tx)
     GetCurrentSlot -> gets _currentSlot
-    GetSlotConfig  -> pure slotConfig
+    GetParams      -> pure params
 
 -- | The result of validating a block.
 data ValidatedBlock = ValidatedBlock
@@ -145,17 +144,17 @@ data ValidatedBlock = ValidatedBlock
 -- | Validate a block given the current slot and UTxO index, returning the valid
 --   transactions, success/failure events, remaining transactions and the
 --   updated UTxO set.
-validateBlock :: SlotConfig -> Slot -> Index.UtxoIndex -> TxPool -> ValidatedBlock
-validateBlock slotCfg slot@(Slot s) idx txns =
+validateBlock :: Params -> Slot -> Index.UtxoIndex -> TxPool -> ValidatedBlock
+validateBlock params slot@(Slot s) idx txns =
     let
         -- Select those transactions that can be validated in the
         -- current slot
         (eligibleTxns, rest) = partition (canValidateNow slot) txns
 
         -- Validate eligible transactions, updating the UTXO index each time
         processed =
-            flip S.evalState (Index.ValidationCtx idx slotCfg) $ for eligibleTxns $ \tx -> do
-                (err, events_) <- validateEm slot cUtxoIndex tx
+            flip S.evalState (Index.ValidationCtx idx $ pSlotConfig params) $ for eligibleTxns $ \tx -> do
+                (err, events_) <- validateEm params slot cUtxoIndex tx
                 pure (tx, err, events_)
 
         -- The new block contains all transaction that were validated
@@ -174,7 +173,7 @@ validateBlock slotCfg slot@(Slot s) idx txns =
         nextSlot = Slot (s + 1)
         events   = (uncurry3 (mkValidationEvent idx) <$> processed) ++ [SlotAdd nextSlot]
 
-        cUtxoIndex = either (error . show) id $ Validation.fromPlutusIndex idx
+        cUtxoIndex = either (error . show) id $ Validation.fromPlutusIndex params idx
 
     in ValidatedBlock block events rest
 
@@ -198,22 +197,23 @@ mkValidationEvent idx t result events =
 -- | Validate a transaction in the current emulator state.
 validateEm
     :: S.MonadState Index.ValidationCtx m
-    => Slot
+    => Params
+    -> Slot
     -> Validation.UTxO Index.EmulatorEra
     -> CardanoTx
     -> m (Maybe Index.ValidationErrorInPhase, [ScriptValidationEvent])
-validateEm h cUtxoIndex txn = do
+validateEm params h cUtxoIndex txn = do
     ctx@(Index.ValidationCtx idx _) <- S.get
     let ((e, idx'), events) = txn & mergeCardanoTxWith
             (\tx -> Index.runValidation (Index.validateTransaction h tx) ctx)
-            (\tx -> ((validateL h cUtxoIndex tx, idx), []))
+            (\tx -> ((validateL params h cUtxoIndex tx, idx), []))
             (\((e1, utxo), sve1) ((e2, _), sve2) -> ((e1 <|> e2, utxo), sve1 ++ sve2))
     _ <- S.put ctx{Index.vctxIndex=idx'}
     pure (e, events)
 
-validateL :: Slot -> Validation.UTxO Index.EmulatorEra -> SomeCardanoApiTx -> Maybe Index.ValidationErrorInPhase
-validateL slot idx (SomeTx tx AlonzoEraInCardanoMode) = Validation.hasValidationErrors (fromIntegral slot) idx tx
-validateL _    _   _                                  = Nothing
+validateL :: Params -> Slot -> Validation.UTxO Index.EmulatorEra -> SomeCardanoApiTx -> Maybe Index.ValidationErrorInPhase
+validateL params slot idx (SomeTx tx AlonzoEraInCardanoMode) = Validation.hasValidationErrors params (fromIntegral slot) idx tx
+validateL _      _    _   _                                  = Nothing
 
 -- | Adds a block to ChainState, without validation.
 addBlock :: Block -> ChainState -> ChainState

plutus-contract/src/Wallet/Emulator/NodeClient.hs

@@ -70,6 +70,6 @@ handleNodeClient
     :: (Members NodeClientEffs effs)
     => Eff (NodeClientEffect ': effs) ~> Eff effs
 handleNodeClient = interpret $ \case
-    PublishTx tx        -> queueTx tx >> logInfo (TxSubmit (getCardanoTxId tx) (getCardanoTxFee tx))
-    GetClientSlot       -> gets _clientSlot
-    GetClientSlotConfig -> getSlotConfig
+    PublishTx tx    -> queueTx tx >> logInfo (TxSubmit (getCardanoTxId tx) (getCardanoTxFee tx))
+    GetClientSlot   -> gets _clientSlot
+    GetClientParams -> getParams

plutus-contract/src/Wallet/Emulator/Stream.hs

@@ -16,7 +16,7 @@ module Wallet.Emulator.Stream(
     , initialChainState
     , initialDist
     , initialState
-    , slotConfig
+    , params
     , runTraceStream
     -- * Stream manipulation
     , takeUntilSlot
@@ -61,7 +61,7 @@ import Wallet.Emulator.MultiAgent (EmulatorState, EmulatorTimeEvent (EmulatorTim
 import Wallet.Emulator.Wallet (Wallet, mockWalletAddress)
 
 -- TODO: Move these two to 'Wallet.Emulator.XXX'?
-import Ledger.TimeSlot (SlotConfig)
+import Ledger.Params (Params)
 import Plutus.Contract.Trace (InitialDistribution, defaultDist, knownWallets)
 import Plutus.Trace.Emulator.ContractInstance (EmulatorRuntimeError)
 
@@ -119,7 +119,7 @@ runTraceStream :: forall effs.
             , Error EmulatorRuntimeError
             ] ()
     -> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) (Maybe EmulatorErr, EmulatorState)
-runTraceStream conf@EmulatorConfig{_slotConfig} =
+runTraceStream conf@EmulatorConfig{_params} =
     fmap (first (either Just (const Nothing)))
     . S.hoist (pure . run)
     . runStream @(LogMessage EmulatorEvent) @_ @'[]
@@ -131,15 +131,15 @@ runTraceStream conf@EmulatorConfig{_slotConfig} =
     . wrapError ChainIndexErr
     . wrapError AssertionErr
     . wrapError InstanceErr
-    . EM.processEmulated _slotConfig
+    . EM.processEmulated _params
     . subsume
     . subsume @(State EmulatorState)
     . raiseEnd
 
 data EmulatorConfig =
     EmulatorConfig
         { _initialChainState :: InitialChainState -- ^ State of the blockchain at the beginning of the simulation. Can be given as a map of funds to wallets, or as a block of transactions.
-        , _slotConfig        :: SlotConfig -- ^ Set the start time of slot 0 and the length of one slot
+        , _params            :: Params -- ^ Set the protocol parameters, network ID and slot configuration for the emulator.
         } deriving (Eq, Show)
 
 type InitialChainState = Either InitialDistribution [Tx]
@@ -156,7 +156,7 @@ initialDist = either id (walletFunds . map Valid) where
 instance Default EmulatorConfig where
   def = EmulatorConfig
           { _initialChainState = Left defaultDist
-          , _slotConfig = def
+          , _params = def
           }
 
 initialState :: EmulatorConfig -> EM.EmulatorState