diff --git a/cluster-data/alonzo-genesis.yaml b/cluster-data/alonzo-genesis.yaml index 16cd0ead..d33d36e8 100644 --- a/cluster-data/alonzo-genesis.yaml +++ b/cluster-data/alonzo-genesis.yaml @@ -8,14 +8,7 @@ executionPrices: prMem: numerator: 577 denominator: 10000 -maxTxExUnits: - exUnitsMem: 10000000 - exUnitsSteps: 10000000000 -maxBlockExUnits: - exUnitsMem: 50000000 - exUnitsSteps: 40000000000 maxValueSize: 5000 -collateralPercentage: 150 maxCollateralInputs: 3 costModels: PlutusV1: diff --git a/plutip-server/Api/Handlers.hs b/plutip-server/Api/Handlers.hs index 8639c0e4..ec950d8f 100644 --- a/plutip-server/Api/Handlers.hs +++ b/plutip-server/Api/Handlers.hs @@ -7,9 +7,9 @@ import Cardano.Api (serialiseToCBOR) import Cardano.Launcher.Node (nodeSocketFile) import Test.Plutip.Tools.CardanoApi qualified as Tools -import Control.Concurrent.MVar (isEmptyMVar, putMVar, tryTakeMVar) import Control.Concurrent (threadDelay) import Control.Concurrent.Async (race) +import Control.Concurrent.MVar (isEmptyMVar, putMVar, tryTakeMVar) import Control.Monad (unless) import Control.Monad.Except (runExceptT, throwError) import Control.Monad.Extra (unlessM) @@ -17,9 +17,10 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Reader (ReaderT, ask, asks) import Data.ByteString.Base16 qualified as Base16 import Data.Default (def) -import Data.Foldable (for_) import Data.Either (fromRight) +import Data.Foldable (for_) import Data.List.Extra (firstJust) +import Data.Maybe (fromMaybe) import Data.Text.Encoding qualified as Text import Data.Traversable (for) import System.Directory (doesFileExist) @@ -37,10 +38,21 @@ import Test.Plutip.Internal.BotPlutusInterface.Wallet ( cardanoMainnetAddress, ) import Test.Plutip.Internal.Cluster (RunningNode (RunningNode)) -import Test.Plutip.Internal.Cluster.Extra.Types (ExtraConfig (ExtraConfig, ecSlotLength)) +import Test.Plutip.Internal.Cluster.Extra.Types ( + ExtraConfig ( + ExtraConfig, + ecEpochSize, + ecMaxTxSize, + ecRaiseExUnitsToMax, + ecSlotLength + ), + ) import Test.Plutip.Internal.LocalCluster (startCluster, stopCluster) import Test.Plutip.Internal.Types (ClusterEnv (plutipConf, runningNode)) -import Test.Plutip.Tools.CardanoApi (AwaitWalletFundedError (AwaitingCapiError, AwaitingTimeoutError), awaitWalletFunded) +import Test.Plutip.Tools.CardanoApi ( + AwaitWalletFundedError (AwaitingCapiError, AwaitingTimeoutError), + awaitWalletFunded, + ) import Types ( AppM, ClusterStartupFailureReason ( @@ -63,6 +75,8 @@ import Types ( StartClusterRequest, epochSize, keysToGenerate, + maxTxSize, + raiseExUnitsToMax, slotLength ), StartClusterResponse ( @@ -77,7 +91,13 @@ import UnliftIO.Exception (throwString) startClusterHandler :: ServerOptions -> StartClusterRequest -> AppM StartClusterResponse startClusterHandler ServerOptions {nodeLogs} - StartClusterRequest {slotLength, epochSize, keysToGenerate} = interpret $ do + StartClusterRequest + { keysToGenerate + , slotLength + , epochSize + , maxTxSize + , raiseExUnitsToMax + } = interpret $ do -- Check that lovelace amounts are positive for_ keysToGenerate $ \lovelaceAmounts -> do for_ lovelaceAmounts $ \lovelaces -> do @@ -86,8 +106,7 @@ startClusterHandler statusMVar <- asks status isClusterDown <- liftIO $ isEmptyMVar statusMVar unless isClusterDown $ throwError ClusterIsRunningAlready - let extraConf = ExtraConfig slotLength epochSize - cfg = def {relayNodeLogs = nodeLogs, chainIndexMode = NotNeeded, extraConfig = extraConf} + let cfg = def {relayNodeLogs = nodeLogs, chainIndexMode = NotNeeded, extraConfig = extraConf} (statusTVar, (clusterEnv, wallets)) <- liftIO $ startCluster cfg setup liftIO $ putMVar statusMVar statusTVar @@ -115,7 +134,7 @@ startClusterHandler addSomeWallet (fromInteger . unLovelace <$> lovelaceAmounts) return (env, wallets) - -- wait for confirmation of funding txs, throw the first error if there's any + -- wait for confirmation of funding txs, throw the first error if there's any waitForFundingTxs clusterEnv wallets extraConfig = do res <- for wallets $ \w -> awaitWalletFunded clusterEnv (cardanoMainnetAddress w) extraConfig @@ -132,10 +151,20 @@ startClusterHandler getNodeConfigFile = -- assumption is that node.config lies in the same directory as node.socket flip replaceFileName "node.config" . getNodeSocketFile + getWalletPrivateKey :: BpiWallet -> PrivateKey getWalletPrivateKey = Text.decodeUtf8 . Base16.encode . serialiseToCBOR . signKey interpret = fmap (either ClusterStartupFailure id) . runExceptT + extraConf :: ExtraConfig + extraConf = + let defConfig = def + in ExtraConfig + (fromMaybe (ecSlotLength defConfig) slotLength) + (fromMaybe (ecEpochSize defConfig) epochSize) + (fromMaybe (ecMaxTxSize defConfig) maxTxSize) + (fromMaybe (ecRaiseExUnitsToMax defConfig) raiseExUnitsToMax) + stopClusterHandler :: StopClusterRequest -> AppM StopClusterResponse stopClusterHandler StopClusterRequest = do statusMVar <- asks status diff --git a/plutip-server/Types.hs b/plutip-server/Types.hs index 6e1399d9..25b6e534 100644 --- a/plutip-server/Types.hs +++ b/plutip-server/Types.hs @@ -11,7 +11,14 @@ module Types ( PlutipServerError (PlutipServerError), PrivateKey, ServerOptions (ServerOptions, nodeLogs, port), - StartClusterRequest (StartClusterRequest, keysToGenerate, slotLength, epochSize), + StartClusterRequest ( + StartClusterRequest, + keysToGenerate, + slotLength, + epochSize, + maxTxSize, + raiseExUnitsToMax + ), StartClusterResponse ( ClusterStartupSuccess, ClusterStartupFailure @@ -38,6 +45,7 @@ import Data.Text (Text) import Data.Time (NominalDiffTime) import GHC.Generics (Generic) import Network.Wai.Handler.Warp (Port) +import Numeric.Natural (Natural) import Test.Plutip.Internal.BotPlutusInterface.Wallet (BpiWallet) import Test.Plutip.Internal.LocalCluster (ClusterStatus) import Test.Plutip.Internal.Types (ClusterEnv) @@ -93,10 +101,17 @@ instance FromJSON Lovelace where else pure $ Lovelace value data StartClusterRequest = StartClusterRequest - { slotLength :: NominalDiffTime - , epochSize :: EpochSize - , -- | Lovelace amounts for each UTXO of each wallet + { -- | Lovelace amounts for each UTXO of each wallet keysToGenerate :: [[Lovelace]] + , -- | Set the SlotLength. If set to Nothing use the default + slotLength :: Maybe NominalDiffTime + , -- | Set the EpochSize. If set to Nothing use the default + epochSize :: Maybe EpochSize + , -- | Set The maxTxSize. If set to Nothing use the default + maxTxSize :: Maybe Natural + , -- | Raise the execustion units to the maxbound when true. + -- If set to Nothing use the default + raiseExUnitsToMax :: Maybe Bool } deriving stock (Show, Eq, Generic) deriving anyclass (FromJSON, ToJSON) diff --git a/src/Test/Plutip/Internal/Cluster.hs b/src/Test/Plutip/Internal/Cluster.hs index 58695e6a..e3455fd0 100644 --- a/src/Test/Plutip/Internal/Cluster.hs +++ b/src/Test/Plutip/Internal/Cluster.hs @@ -18,12 +18,12 @@ -- Warnings turned off intetnionally to keep module close to the original -- as much as possible for easier maintenance. -{-# OPTIONS_GHC -Wwarn=missing-import-lists #-} -{-# OPTIONS_GHC -Wwarn=incomplete-uni-patterns #-} -{-# OPTIONS_GHC -Wwarn=missing-deriving-strategies #-} -{-# OPTIONS_GHC -Wwarn=name-shadowing #-} +{-# OPTIONS_GHC -Wno-missing-import-lists #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} --- | +-- | -- This module is modified copy of https://github.com/input-output-hk/cardano-wallet/blob/1952de13f1cd954514cfa1cb02e628cfc9fde675/lib/shelley/src/Cardano/Wallet/Shelley/Launch/Cluster.hs -- which is -- Copyright: © 2018-2020 IOHK @@ -270,7 +270,16 @@ import qualified Data.Text.Encoding.Error as T import qualified Data.Yaml as Yaml import Data.Default (def) -import Test.Plutip.Internal.Cluster.Extra.Types (ExtraConfig, ecSlotLength, ecEpochSize) +import Test.Plutip.Internal.Cluster.Extra.Types + ( ExtraConfig + , ecSlotLength + , ecEpochSize + , ecMaxTxSize + , ecRaiseExUnitsToMax + , stdBlockExUnits + , calculateCollateral + , stdTxExUnits + , maxExUnits) -- | Returns the shelley test data path, which is usually relative to the -- package sources, but can be overridden by the @SHELLEY_TEST_DATA@ environment @@ -885,6 +894,7 @@ unsafePositiveUnitInterval x = fromMaybe (error $ "unsafeNonNegativeInterval: " <> show x <> " is out of bounds") (boundRational x) + -- altered generateGenesis :: FilePath @@ -896,7 +906,14 @@ generateGenesis -> IO GenesisFiles generateGenesis dir systemStart initialFunds addPoolsToGenesis extraConf = do source <- getShelleyTestDataPath + let (maxTxExUnits, maxBlockExUnits) = if ecRaiseExUnitsToMax extraConf + then (maxExUnits, maxExUnits) + else (stdTxExUnits, stdBlockExUnits) + collateral = calculateCollateral $ ecMaxTxSize extraConf Yaml.decodeFileThrow @_ @Aeson.Value (source "alonzo-genesis.yaml") + >>= withAddedKey "maxTxExUnits" maxTxExUnits + >>= withAddedKey "maxBlockExUnits" maxBlockExUnits + >>= withAddedKey "collateralPercentage" collateral >>= Aeson.encodeFile (dir "genesis.alonzo.json") let startTime = round @_ @Int . utcTimeToPOSIXSeconds $ systemStart @@ -912,7 +929,7 @@ generateGenesis dir systemStart initialFunds addPoolsToGenesis extraConf = do , _maxBBSize = 239857 , _maxBHSize = 217569 - , _maxTxSize = 16384 + , _maxTxSize = ecMaxTxSize extraConf , _minPoolCost = Ledger.Coin 0 @@ -921,7 +938,7 @@ generateGenesis dir systemStart initialFunds addPoolsToGenesis extraConf = do -- There are a few smaller features/fixes which are enabled based on -- the protocol version rather than just the era, so we need to -- set it to a realisitic value. - , _protocolVersion = Ledger.ProtVer 7 0 + , _protocolVersion = Ledger.ProtVer 8 0 -- Sensible pool & reward parameters: , _nOpt = 3 diff --git a/src/Test/Plutip/Internal/Cluster/Extra/Types.hs b/src/Test/Plutip/Internal/Cluster/Extra/Types.hs index 959f8c01..cdd8eef9 100644 --- a/src/Test/Plutip/Internal/Cluster/Extra/Types.hs +++ b/src/Test/Plutip/Internal/Cluster/Extra/Types.hs @@ -1,10 +1,22 @@ module Test.Plutip.Internal.Cluster.Extra.Types ( ExtraConfig (..), + ExBudget (..), + stdBlockExUnits, + stdTxExUnits, + stdTxSize, + maxExUnits, + stdCollateral, + calculateCollateral, ) where import Cardano.Ledger.Slot (EpochSize) import Data.Default (Default (def)) +import Data.Ratio ((%)) import Data.Time (NominalDiffTime) +import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Numeric.Natural (Natural) +import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (ExCPU), ExMemory (ExMemory)) -- | Extra configuration options to set slot length and epoch size for local network. -- `ExtraConfig` used both in `PlutipConfig` and `LocalClusterConfig` to pass @@ -16,8 +28,40 @@ import Data.Time (NominalDiffTime) data ExtraConfig = ExtraConfig { ecSlotLength :: NominalDiffTime , ecEpochSize :: EpochSize + , ecMaxTxSize :: Natural + , ecRaiseExUnitsToMax :: Bool } deriving stock (Show) +data ExBudget = ExBudget + { exUnitsMem :: ExMemory + , exUnitsSteps :: ExCPU + } + deriving stock (Show, Eq, Generic) + deriving anyclass (FromJSON, ToJSON) + +-- below from https://github.com/input-output-hk/cardano-node/blob/master/configuration/cardano/mainnet-alonzo-genesis.json +stdTxExUnits :: ExBudget +stdTxExUnits = ExBudget (ExMemory 10000000) (ExCPU 10000000000) + +stdBlockExUnits :: ExBudget +stdBlockExUnits = ExBudget (ExMemory 50000000) (ExCPU 40000000000) + +maxExUnits :: ExBudget +maxExUnits = ExBudget (ExMemory maxBound) (ExCPU maxBound) + +stdCollateral :: Natural +stdCollateral = 150 + +stdTxSize :: Natural +stdTxSize = 16384 + +-- | Necessary when increasing TxSize so as not raise collateral above expected. +calculateCollateral :: Natural -> Natural +calculateCollateral maxTxSize = + if maxTxSize > stdTxSize + then truncate $ stdCollateral * stdTxSize % maxTxSize + else stdCollateral + instance Default ExtraConfig where - def = ExtraConfig 0.2 160 + def = ExtraConfig 0.1 80 stdTxSize False diff --git a/src/Test/Plutip/Tools/CardanoApi.hs b/src/Test/Plutip/Tools/CardanoApi.hs index 6a37d06f..a0d232c1 100644 --- a/src/Test/Plutip/Tools/CardanoApi.hs +++ b/src/Test/Plutip/Tools/CardanoApi.hs @@ -20,8 +20,8 @@ import Cardano.Launcher.Node (nodeSocketFile) import Cardano.Slotting.Slot (WithOrigin) import Test.Plutip.Internal.Cluster (RunningNode (RunningNode)) -import Control.Exception (Exception) import Control.Arrow (right) +import Control.Exception (Exception) import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Reader (MonadReader (ask), ReaderT) @@ -34,8 +34,8 @@ import GHC.Generics (Generic) import Ledger (Value) import Ledger.Tx.CardanoAPI (fromCardanoValue) import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch) -import Test.Plutip.Internal.Types (ClusterEnv (runningNode)) import Test.Plutip.Internal.Cluster.Extra.Types (ExtraConfig (ecSlotLength)) +import Test.Plutip.Internal.Types (ClusterEnv (runningNode)) import UnliftIO (throwString) newtype CardanoApiError @@ -142,7 +142,7 @@ instance Show AwaitWalletFundedError where awaitWalletFunded :: ClusterEnv -> C.AddressAny -> - ExtraConfig -> + ExtraConfig -> IO (Either AwaitWalletFundedError ()) awaitWalletFunded cenv addr extraConfig = toErrorMsg <$> retrying policy checkResponse action where @@ -159,4 +159,4 @@ awaitWalletFunded cenv addr extraConfig = toErrorMsg <$> retrying policy checkRe Right noUtxos -> if noUtxos then Left AwaitingTimeoutError - else Right () \ No newline at end of file + else Right ()