tx-generator: remove usage of cardano-api's ProtocolParameters (WIP)

bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs

@@ -1,5 +1,6 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -22,7 +23,7 @@ import qualified Data.Attoparsec.ByteString as Atto
 import qualified Data.Yaml as Yaml (encode)
 
 import           Cardano.Api
-import           Cardano.Api.Shelley (ProtocolParameters)
+import qualified Cardano.Ledger.Core as L
 
 import           Cardano.Benchmarking.Script.Types
 import           Cardano.TxGenerator.Internal.Orphans ()
@@ -158,5 +159,9 @@ parseJSONFile parser filePath = do
 parseScriptFileAeson :: FilePath -> IO [Action]
 parseScriptFileAeson = parseJSONFile fromJSON
 
-readProtocolParametersFile :: FilePath -> IO ProtocolParameters
-readProtocolParametersFile = parseJSONFile fromJSON
+readProtocolParametersFile ::
+  ()
+  => L.EraPParams era
+  => FilePath
+  -> IO (L.PParams era)
+readProtocolParametersFile  = parseJSONFile fromJSON

bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs

@@ -39,8 +39,8 @@ module Cardano.Benchmarking.Script.Types (
 ) where
 
 import           Cardano.Api
-import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley
+import qualified Cardano.Api.Ledger as L
 
 import           Cardano.Benchmarking.OuroborosImports (SigningKeyFile)
 import           Cardano.Node.Configuration.NodeAddress (NodeIPv4Address)
@@ -214,4 +214,4 @@ newtype TxList era = TxList [Tx era]
 
 data ProtocolParameterMode where
   ProtocolParameterQuery :: ProtocolParameterMode
-  ProtocolParameterLocal :: ProtocolParameters -> ProtocolParameterMode
+  ProtocolParameterLocal :: L.PParams (ShelleyLedgerEra era) -> ProtocolParameterMode

bench/tx-generator/src/Cardano/TxGenerator/PlutusContext.hs

@@ -26,9 +26,11 @@ module  Cardano.TxGenerator.PlutusContext
         where
 
 import           Cardano.Api
-import           Cardano.Api.Shelley (ProtocolParameters (..))
+import           Cardano.Api.Shelley (fromAlonzoExUnits, toAlonzoExUnits, executionSteps, executionMemory)
 
+import qualified Cardano.Ledger.Alonzo.Core as L
 import           Cardano.Ledger.Coin (Coin)
+import qualified Cardano.Ledger.Core as L
 import           Cardano.TxGenerator.Setup.Plutus (preExecutePlutusScript)
 import           Cardano.TxGenerator.Types
 
@@ -38,6 +40,7 @@ import           Data.List (maximumBy, minimumBy)
 import           Data.Ord (comparing)
 import           GHC.Generics (Generic)
 import           GHC.Natural (Natural)
+import           Lens.Micro
 
 
 -- | This collects information describing the budget. It's only
@@ -105,8 +108,9 @@ readScriptData jsonFilePath
 -- | Can find the optimal scaling factor for block expenditure, by aiming at highest
 -- loop count per block iff TargetBlockExpenditure Nothing is given;
 -- will calibrate loop for any fully specified fitting strategy otherwise
-plutusAutoScaleBlockfit ::
-     ProtocolParameters
+plutusAutoScaleBlockfit :: ()
+  => L.AlonzoEraPParams era
+  => L.PParams era
   -> FilePath
   -> ScriptInAnyLang
   -> PlutusAutoBudget
@@ -151,8 +155,9 @@ plutusAutoScaleBlockfit pparams fp script pab strategy txInputs
 --      termination value when counting down.
 --   2. In the redeemer's argument structure, this value is the first numerical value
 --      that's encountered during traversal.
-plutusAutoBudgetMaxOut ::
-     ProtocolParameters
+plutusAutoBudgetMaxOut :: ()
+  => L.AlonzoEraPParams era
+  => L.PParams era
   -> ScriptInAnyLang
   -> PlutusAutoBudget
   -> PlutusBudgetFittingStrategy
@@ -161,10 +166,7 @@ plutusAutoBudgetMaxOut ::
 plutusAutoBudgetMaxOut _ _ _ (TargetBlockExpenditure Nothing) _
   = Left $ TxGenError "plutusAutoBudgetMaxOut : a scaling factor is required for TargetBlockExpenditure"
 plutusAutoBudgetMaxOut
-  protocolParams@ProtocolParameters
-    { protocolParamMaxBlockExUnits  = Just budgetPerBlock
-    , protocolParamMaxTxExUnits     = Just budgetPerTx
-    }
+  pparams
   script
   pab@PlutusAutoBudget{..}
   target
@@ -174,6 +176,8 @@ plutusAutoBudgetMaxOut
     let pab' = pab {autoBudgetUnits = targetBudget, autoBudgetRedeemer = unsafeHashableScriptData $ toLoopArgument n}
     pure (pab', fromIntegral n, limitFactors)
   where
+    budgetPerBlock = fromAlonzoExUnits $ pparams ^. L.ppMaxBlockExUnitsL
+    budgetPerTx    = fromAlonzoExUnits $ pparams ^. L.ppMaxTxExUnitsL
     -- The highest loop counter that is tried - this is about 10 times the current mainnet limit.
     searchUpperBound  = 20000
 
@@ -195,7 +199,7 @@ plutusAutoBudgetMaxOut
     -- the execution is considered within limits when there's no limiting factor, i.e. the list is empty
     isInLimits :: Integer -> Either TxGenError [PlutusAutoLimitingFactor]
     isInLimits n = do
-      used <- preExecutePlutusScript protocolParams script autoBudgetDatum (unsafeHashableScriptData $ toLoopArgument n)
+      used <- preExecutePlutusScript pparams script autoBudgetDatum (unsafeHashableScriptData $ toLoopArgument n)
       pure $   [ExceededStepLimit   | executionSteps used > executionSteps targetBudget]
             ++ [ExceededMemoryLimit | executionMemory used > executionMemory targetBudget]
 
@@ -207,26 +211,26 @@ plutusAutoBudgetMaxOut _ _ _ _ _
 -- Some of the function arguments share names with the record fields
 -- mass imported with the @Constr{..}@ notation, setting the field
 -- of the final result to that argument.
-plutusBudgetSummary ::
-     ProtocolParameters
+plutusBudgetSummary :: ()
+  => L.AlonzoEraPParams era
+  => L.PParams era
   -> FilePath
   -> PlutusBudgetFittingStrategy
   -> (PlutusAutoBudget, Int, [PlutusAutoLimitingFactor])
   -> ExecutionUnits
   -> Int
   -> PlutusBudgetSummary
 plutusBudgetSummary
-  ProtocolParameters
-    { protocolParamMaxBlockExUnits  = Just budgetPerBlock
-    , protocolParamMaxTxExUnits     = Just budgetPerTx
-    }
+  pparams
   scriptId
   budgetStrategy
   (PlutusAutoBudget{..}, loopCounter, loopLimitingFactors)
   budgetUsedPerTxInput
   txInputs
   = PlutusBudgetSummary{..}
   where
+    budgetPerBlock          = fromAlonzoExUnits $ pparams ^. L.ppMaxBlockExUnitsL
+    budgetPerTx             = fromAlonzoExUnits $ pparams ^. L.ppMaxTxExUnitsL
     projectedTxSize         = Nothing           -- we defer this value until after splitting phase
     projectedTxFee          = Nothing           -- we defer this value until after splitting phase
     strategyMessage         = Nothing
@@ -287,10 +291,10 @@ minus :: ExecutionUnits -> ExecutionUnits -> ExecutionUnits
 minus (ExecutionUnits a b) (ExecutionUnits a' b')
   = ExecutionUnits (a - a') (b - b')
 
-calc :: ExecutionUnits -> (Natural -> Natural -> Natural) -> Int -> ExecutionUnits
+calc :: ExecutionUnits -> (Natural -> Natural -> Natural) -> Int -> ExecutionUnits 
 calc (ExecutionUnits a b) op (fromIntegral -> n)
   = ExecutionUnits (a `op` n) (b `op` n)
 
-bmin :: ExecutionUnits -> ExecutionUnits -> ExecutionUnits
+bmin :: ExecutionUnits -> ExecutionUnits -> ExecutionUnits 
 bmin (ExecutionUnits a b) (ExecutionUnits a' b')
   = ExecutionUnits (min a a') (min b b')

bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs

@@ -7,7 +7,6 @@ module  Cardano.TxGenerator.PureExample
         where
 
 import           Cardano.Api
-import           Cardano.Api.Shelley (convertToLedgerProtocolParameters)
 
 import qualified Cardano.Ledger.Coin as L
 import           Cardano.TxGenerator.FundQueue
@@ -105,11 +104,7 @@ generateTx TxEnvironment{..}
     sbe = ShelleyBasedEraBabbage
 
     generator :: TxGenerator BabbageEra
-    generator =
-        case convertToLedgerProtocolParameters sbe txEnvProtocolParams of
-          Right ledgerParameters ->
-            genTx sbe ledgerParameters collateralFunds txEnvFee txEnvMetadata
-          Left err -> \_ _ -> Left (ApiError err)
+    generator = genTx ShelleyBasedEraBabbage txEnvProtocolParams collateralFunds txEnvFee txEnvMetadata
       where
         -- collateralFunds are needed for Plutus transactions
         collateralFunds :: (TxInsCollateral BabbageEra, [Fund])
@@ -158,11 +153,7 @@ generateTxPure TxEnvironment{..} inQueue
     sbe = ShelleyBasedEraBabbage
 
     generator :: TxGenerator BabbageEra
-    generator =
-        case convertToLedgerProtocolParameters sbe txEnvProtocolParams of
-          Right ledgerParameters ->
-            genTx ShelleyBasedEraBabbage ledgerParameters collateralFunds txEnvFee txEnvMetadata
-          Left err -> \_ _ -> Left (ApiError err)
+    generator = genTx ShelleyBasedEraBabbage txEnvProtocolParams collateralFunds txEnvFee txEnvMetadata
       where
         -- collateralFunds are needed for Plutus transactions
         collateralFunds :: (TxInsCollateral BabbageEra, [Fund])

bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs

@@ -1,8 +1,9 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 {-|
 Module      : Cardano.TxGenerator.Setup.Plutus
@@ -14,10 +15,10 @@
        )
        where
 
-import           Data.Bifunctor
+
 import           Data.ByteString.Short (ShortByteString)
-import           Data.Int (Int64)
-import           Data.Map.Strict as Map (lookup)
+import           Data.Map.Strict as Map (lookup, Map)
+import           Lens.Micro
 
 import           Control.Monad.Trans.Except
 import           Control.Monad.Trans.Except.Extra
@@ -26,8 +27,10 @@
 import           Cardano.CLI.Read (readFileScriptInAnyLang)
 
 import           Cardano.Api
-import           Cardano.Api.Shelley (PlutusScript (..), ProtocolParameters (..), fromAlonzoExUnits,
-                   protocolParamCostModels, toPlutusData)
+import           Cardano.Api.Shelley (PlutusScript (..), fromAlonzoExUnits, toAlonzoLanguage, toPlutusData)
+import qualified Cardano.Ledger.Alonzo.Core as L
+import           Cardano.Ledger.BaseTypes
+import qualified Cardano.Ledger.Plutus as LP
 import           Cardano.Ledger.Plutus.TxInfo (exBudgetToExUnits)
 
 import qualified PlutusLedgerApi.V1 as PlutusV1
@@ -81,21 +84,23 @@
 -- the script's binary representation to count the number of execution
 -- units needed.
 preExecutePlutusScript ::
-     ProtocolParameters
+  ()
+  => L.AlonzoEraPParams era
+  => L.PParams era
   -> ScriptInAnyLang
   -> ScriptData
   -> ScriptRedeemer
   -> Either TxGenError ExecutionUnits
 preExecutePlutusScript
-  ProtocolParameters{protocolParamCostModels, protocolParamProtocolVersion}
+  pparams
   script@(ScriptInAnyLang scriptLang _)
   datum
   redeemer
   = runExcept $ do
     costModel <- hoistMaybe (TxGenError $ "preExecutePlutusScript: cost model unavailable for: " ++ show scriptLang) $
       case script of
         ScriptInAnyLang _ (PlutusScript lang _) ->
-          AnyPlutusScriptVersion lang `Map.lookup` protocolParamCostModels
+          (toAlonzoLanguage (AnyPlutusScriptVersion lang)) `Map.lookup` langToCostModels
         _ ->
           Nothing
 
@@ -109,15 +114,17 @@
       _ ->
         throwE $ TxGenError $ "preExecutePlutusScript: script not supported: " ++ show scriptLang
   where
-    protocolVersion :: ProtocolVersion
-    protocolVersion = bimap fromIntegral fromIntegral protocolParamProtocolVersion
+    protocolParamCostModels :: LP.CostModels = pparams ^. L.ppCostModelsL
+    langToCostModels :: Map.Map LP.Language LP.CostModel = LP.costModelsValid protocolParamCostModels
+    protocolVersion :: ProtocolVersion = (getVersion @Int pvMajor, fromIntegral pvMinor)
+    ProtVer pvMajor pvMinor = pparams ^. L.ppProtocolVersionL
 
 preExecutePlutusV1 ::
      ProtocolVersion
   -> Script PlutusScriptV1
   -> ScriptData
   -> ScriptRedeemer
-  -> CostModel
+  -> LP.CostModel
   -> Either TxGenError ExecutionUnits
 preExecutePlutusV1 protocolVersion_ (PlutusScript _ (PlutusScriptSerialised script)) datum redeemer costModel
   = fst $ runWriter $ runExceptT go       -- for now, we discard warnings (:: PlutusCore.Evaluation.Machine.CostModelInterface.CostModelApplyWarn)
@@ -126,7 +133,7 @@
     go
       = do
       evaluationContext <- firstExceptT PlutusError $
-        PlutusV1.mkEvaluationContext (flattenCostModel costModel)
+        PlutusV1.mkEvaluationContext (LP.getCostModelParams costModel)
 
       deserialisedScript <- firstExceptT PlutusError $ PlutusV1.deserialiseScript protocolVersion script
       exBudget <- firstExceptT PlutusError $
@@ -166,7 +173,7 @@
   -> Script PlutusScriptV2
   -> ScriptData
   -> ScriptRedeemer
-  -> CostModel
+  -> LP.CostModel
   -> Either TxGenError ExecutionUnits
 preExecutePlutusV2 (major, _minor) (PlutusScript _ (PlutusScriptSerialised script)) datum redeemer costModel
   = fst $ runWriter $ runExceptT go       -- for now, we discard warnings (:: PlutusCore.Evaluation.Machine.CostModelInterface.CostModelApplyWarn)
@@ -175,7 +182,7 @@
     go
       = do
       evaluationContext <- firstExceptT PlutusError $
-        PlutusV2.mkEvaluationContext (flattenCostModel costModel)
+        PlutusV2.mkEvaluationContext (LP.getCostModelParams costModel)
 
       deserialisedScript <- firstExceptT PlutusError $ PlutusV2.deserialiseScript protocolVersion script
 
@@ -218,7 +225,7 @@
   -> Script PlutusScriptV3
   -> ScriptData
   -> ScriptRedeemer
-  -> CostModel
+  -> LP.CostModel
   -> Either TxGenError ExecutionUnits
 preExecutePlutusV3 (major, _minor) (PlutusScript _ (PlutusScriptSerialised (script :: ShortByteString {- a.k.a. SerialisedScript -}))) datum redeemer costModel
   = fst $ runWriter $ runExceptT go       -- for now, we discard warnings (:: PlutusCore.Evaluation.Machine.CostModelInterface.CostModelApplyWarn)
@@ -227,7 +234,7 @@
     go
       = do
       evaluationContext <- firstExceptT PlutusError $
-        PlutusV3.mkEvaluationContext (flattenCostModel costModel)
+        PlutusV3.mkEvaluationContext (LP.getCostModelParams costModel)
 
       scriptForEval <- withExceptT PlutusError $ PlutusV3.deserialiseScript protocolVersion script
       exBudget <- firstExceptT PlutusError $
@@ -272,7 +279,4 @@
       , PlutusV3.txInfoProposalProcedures = []
       , PlutusV3.txInfoCurrentTreasuryAmount = Nothing
       , PlutusV3.txInfoTreasuryDonation = Nothing
-      }
-
-flattenCostModel :: CostModel -> [Int64]
-flattenCostModel (CostModel cm) = cm
+      }

bench/tx-generator/src/Cardano/TxGenerator/Tx.hs

@@ -7,9 +7,10 @@ module  Cardano.TxGenerator.Tx
         where
 
 import           Cardano.Api
-import           Cardano.Api.Shelley (LedgerProtocolParameters)
+import           Cardano.Api.Shelley
 
 import qualified Cardano.Ledger.Coin as L
+import qualified Cardano.Ledger.Core as L
 import           Cardano.TxGenerator.Fund
 import           Cardano.TxGenerator.Types
 import           Cardano.TxGenerator.UTxO (ToUTxOList)
@@ -159,7 +160,7 @@ sourceTransactionPreview txGenerator inputFunds valueSplitter toStore =
 -- for a function type -- of two arguments.
 genTx :: ()
   => ShelleyBasedEra era
-  -> LedgerProtocolParameters era
+  -> L.PParams (ShelleyLedgerEra era)
   -> (TxInsCollateral era, [Fund])
   -> TxFee era
   -> TxMetadataInEra era
@@ -179,7 +180,7 @@ genTx sbe ledgerParameters (collateral, collFunds) fee metadata inFunds outputs
     & setTxValidityLowerBound TxValidityNoLowerBound
     & setTxValidityUpperBound (defaultTxValidityUpperBound sbe)
     & setTxMetadata metadata
-    & setTxProtocolParams (BuildTxWith (Just ledgerParameters))
+    & setTxProtocolParams (BuildTxWith (Just $ LedgerProtocolParameters ledgerParameters))
 
 
 txSizeInBytes ::

bench/tx-generator/src/Cardano/TxGenerator/Types.hs

@@ -14,9 +14,10 @@ module  Cardano.TxGenerator.Types
         where
 
 import           Cardano.Api
-import           Cardano.Api.Shelley (ProtocolParameters)
+import           Cardano.Api.Shelley
 
 import qualified Cardano.Ledger.Coin as L
+import qualified Cardano.Ledger.Core as L
 import           Cardano.Ledger.Crypto (StandardCrypto)
 import qualified Cardano.Ledger.Shelley.API as Ledger (ShelleyGenesis)
 import           Cardano.TxGenerator.Fund (Fund)
@@ -67,7 +68,7 @@ data TxEnvironment era = TxEnvironment
   { txEnvNetworkId        :: !NetworkId
   -- , txEnvGenesis          :: !ShelleyGenesis
   -- , txEnvProtocolInfo     :: !SomeConsensusProtocol
-  , txEnvProtocolParams   :: !ProtocolParameters
+  , txEnvProtocolParams   :: !(L.PParams (ShelleyLedgerEra era))
   , txEnvFee              :: TxFee era
   , txEnvMetadata         :: TxMetadataInEra era
   }

bench/tx-generator/test/ApiTest.hs

@@ -14,7 +14,7 @@ module Main (module Main) where
 
 import           Cardano.Api
 import qualified Cardano.Api.Ledger as Api
-import           Cardano.Api.Shelley (ProtocolParameters (..), fromPlutusData)
+import           Cardano.Api.Shelley (fromPlutusData)
 
 #ifdef WITH_LIBRARY
 import           Cardano.Benchmarking.PlutusScripts