Merge pull request #405 from input-output-hk/ch/update-costmodels

Add cost models file to protocol parameter update command

cardano-cli/cardano-cli.cabal

@@ -298,10 +298,10 @@ test-suite cardano-cli-test
                       , base16-bytestring
                       , bech32 >= 1.1.0
                       , bytestring
-                      , cardano-api:{cardano-api, internal}
-                      , cardano-api-gen ^>= 8.2.0.0
+                      , cardano-api:{cardano-api, gen, internal}
                       , cardano-cli
                       , cardano-cli:cardano-cli-test-lib
+                      , cardano-ledger-alonzo
                       , cardano-slotting
                       , containers
                       , filepath
@@ -315,7 +315,8 @@ test-suite cardano-cli-test
 
   build-tool-depends:   tasty-discover:tasty-discover
 
-  other-modules:        Test.Cli.CliIntermediateFormat
+  other-modules:        Test.Cli.AddCostModels
+                        Test.Cli.CliIntermediateFormat
                         Test.Cli.FilePermissions
                         Test.Cli.Governance.Hash
                         Test.Cli.ITN

cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs

@@ -17,6 +17,7 @@ module Cardano.CLI.EraBased.Commands.Governance.Actions
   , GovernanceActionTreasuryWithdrawalCmdArgs(..)
   , UpdateProtocolParametersConwayOnwards(..)
   , UpdateProtocolParametersPreConway(..)
+  , CostModelsFile(..)
   , renderGovernanceActionCmds
   ) where
 
@@ -32,6 +33,7 @@ import qualified Cardano.Ledger.SafeHash as Ledger
 
 import           Data.Text (Text)
 import           Data.Word
+import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
 
 data GovernanceActionCmds era
   = GovernanceActionCreateConstitutionCmd         !(GovernanceActionCreateConstitutionCmdArgs era)
@@ -102,7 +104,15 @@ data GovernanceActionProtocolParametersUpdateCmdArgs era
       { uppShelleyBasedEra :: !(ShelleyBasedEra era)
       , uppPreConway       :: !(Maybe (UpdateProtocolParametersPreConway era))
       , uppConwayOnwards   :: !(Maybe (UpdateProtocolParametersConwayOnwards era))
-      , uppNewPParams      :: !(EraBasedProtocolParametersUpdate era)
+      -- | New parameters to be proposed. From Alonzo onwards, the type
+      -- 'EraBasedProtocolParametersUpdate' also contains cost models. Since all
+      -- other protocol parameters are read from command line arguments, whereas
+      -- the cost models are read from a file, we separate the cost models from
+      -- the rest of the protocol parameters to ease parsing.
+      , uppNewPParams :: !(EraBasedProtocolParametersUpdate era)
+      -- | The new cost models proposed. See the comment at 'uppNewPParams' for
+      -- why this is a separate field.
+      , uppCostModelsFile :: !(Maybe (CostModelsFile era))
       , uppFilePath        :: !(File () Out)
       } deriving Show
 
@@ -137,6 +147,12 @@ data UpdateProtocolParametersConwayOnwards era
       , governanceActionId  :: !(Maybe (TxId, Word32))
       }
 
+data CostModelsFile era
+  = CostModelsFile
+      { eon :: !(AlonzoEraOnwards era)
+      , costModelsFile :: !(File Alonzo.CostModels In)
+      } deriving Show
+
 deriving instance Show (UpdateProtocolParametersConwayOnwards era)
 
 data UpdateProtocolParametersPreConway era

cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs

@@ -903,6 +903,13 @@ pGovActionDeposit =
     , Opt.help "Deposit required to submit a governance action."
     ]
 
+pNewGovActionDeposit :: Parser Lovelace
+pNewGovActionDeposit =
+  Opt.option (readerFromParsecParser parseLovelace) $ mconcat
+    [ Opt.long "new-governance-action-deposit"
+    , Opt.metavar "NATURAL"
+    , Opt.help "Proposed new value of the deposit required to submit a governance action."
+    ]
 
 -- | First argument is the optional prefix
 pStakeVerificationKeyOrHashOrFile :: Maybe String -> Parser (VerificationKeyOrHashOrFile StakeKey)
@@ -3197,8 +3204,8 @@ pAnchorDataHash =
 
 pPreviousGovernanceAction :: Parser (Maybe (TxId, Word32))
 pPreviousGovernanceAction = optional $
-  (,) <$> pTxId "governance-action-tx-id" "Previous txid of the governance action."
-      <*> pWord32 "governance-action-index" "Previous tx's governance action index."
+  (,) <$> pTxId "prev-governance-action-tx-id" "Txid of the previous governance action."
+      <*> pWord32 "prev-governance-action-index" "Action index of the previous governance action."
 
 pGovernanceActionId :: Parser (TxId, Word32)
 pGovernanceActionId =

cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs

@@ -180,6 +180,7 @@ pUpdateProtocolParametersCmd =
                                  <$> fmap Just (pUpdateProtocolParametersPreConway shelleyToBab)
                                  <*> pure Nothing
                                  <*> dpGovActionProtocolParametersUpdate sbe
+                                 <*> pCostModelsFile sbe
                                  <*> pOutputFile
                              )
                          $ Opt.progDesc "Create a protocol parameters update.")
@@ -191,12 +192,24 @@ pUpdateProtocolParametersCmd =
                                 (conwayEraOnwardsToShelleyBasedEra conwayOnwards) Nothing
                                 <$> fmap Just (pUpdateProtocolParametersPostConway conwayOnwards)
                                 <*> dpGovActionProtocolParametersUpdate sbe
+                                <*> pCostModelsFile sbe
                                 <*> pOutputFile
                             )
                         $ Opt.progDesc "Create a protocol parameters update."
 
     )
 
+-- | Cost models only makes sense in eras from Alonzo onwards. For earlier
+-- eras, this parser doesn't show up in the command line and returns 'Nothing'.
+pCostModelsFile :: ShelleyBasedEra era -> Parser (Maybe (Cmd.CostModelsFile era))
+pCostModelsFile =
+  caseShelleyToMaryOrAlonzoEraOnwards
+    (const $ pure Nothing)
+    ( \alonzoOnwards ->
+         fmap (Cmd.CostModelsFile alonzoOnwards . File)
+           <$> optional pCostModels
+    )
+
 pGovernanceActionProtocolParametersUpdateCmd :: ()
   => CardanoEra era
   -> Maybe (Parser (Cmd.GovernanceActionCmds era))
@@ -260,7 +273,7 @@ pShelleyToAlonzoPParams =
 
 pAlonzoOnwardsPParams :: Parser (AlonzoOnwardsPParams ledgerera)
 pAlonzoOnwardsPParams =
-  AlonzoOnwardsPParams SNothing -- TODO: Conway era cost model
+  AlonzoOnwardsPParams SNothing -- The cost models are read separately from a file, so we use 'SNothing' as the place holder here
     <$> convertToLedger (either (\e -> error $ "pAlonzoOnwardsPParams: " <> show e) id . toAlonzoPrices)
                         (optional pExecutionUnitPrices)
     <*> convertToLedger toAlonzoExUnits (optional pMaxTxExecutionUnits)
@@ -283,7 +296,7 @@ pIntroducedInConwayPParams =
     <*> convertToLedger id (optional pMinCommitteeSize)
     <*> convertToLedger id (optional (fromIntegral . unEpochNo <$> pCommitteeTermLength))
     <*> convertToLedger id (optional pGovActionLifetime)
-    <*> convertToLedger toShelleyLovelace (optional pGovActionDeposit)
+    <*> convertToLedger toShelleyLovelace (optional pNewGovActionDeposit)
     <*> convertToLedger toShelleyLovelace (optional pDRepDeposit)
     <*> convertToLedger id (optional pDRepActivity)
 

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs

@@ -8,9 +8,11 @@
 module Cardano.CLI.EraBased.Run.Governance.Actions
   ( runGovernanceActionCmds
   , GovernanceActionsError(..)
+  , addCostModelsToEraBasedProtocolParametersUpdate
   ) where
 
 import           Cardano.Api
+import           Cardano.Api.Ledger (StrictMaybe (..))
 import qualified Cardano.Api.Ledger as Ledger
 import           Cardano.Api.Shelley
 
@@ -21,6 +23,7 @@ import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.GovernanceActionsError
 import           Cardano.CLI.Types.Key
+import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
 
 import           Control.Monad
 import           Control.Monad.Except (ExceptT)
@@ -230,19 +233,24 @@ runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do
     (\sToB -> do
          let oFp = uppFilePath eraBasedPParams'
              anyEra = AnyShelleyBasedEra $ shelleyToBabbageEraToShelleyBasedEra sToB
-         UpdateProtocolParametersPreConway _cOn expEpoch genesisVerKeys
+         UpdateProtocolParametersPreConway _stB expEpoch genesisVerKeys
            <- hoistMaybe (GovernanceActionsValueUpdateProtocolParametersNotFound anyEra)
                 $ uppPreConway eraBasedPParams'
-         let eraBasedPParams = uppNewPParams eraBasedPParams'
-             updateProtocolParams = createEraBasedProtocolParamUpdate sbe eraBasedPParams
+
+         eraBasedPParams <- theUpdate
+
+         let updateProtocolParams = createEraBasedProtocolParamUpdate sbe eraBasedPParams
              apiUpdateProtocolParamsType = fromLedgerPParamsUpdate sbe updateProtocolParams
+
          genVKeys <- sequence
            [ firstExceptT GovernanceActionsCmdReadTextEnvelopeFileError . newExceptT
                $ readFileTextEnvelope (AsVerificationKey AsGenesisKey) vkeyFile
            | vkeyFile <- genesisVerKeys
            ]
+
          let genKeyHashes = fmap verificationKeyHash genVKeys
              upProp = makeShelleyUpdateProposal apiUpdateProtocolParamsType genKeyHashes expEpoch
+
          firstExceptT GovernanceActionsCmdWriteFileError . newExceptT
            $ writeLazyByteStringFile oFp $ textEnvelopeToJSON Nothing upProp
     )
@@ -255,10 +263,11 @@ runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do
           <- hoistMaybe (GovernanceActionsValueUpdateProtocolParametersNotFound anyEra)
               $ uppConwayOnwards eraBasedPParams'
 
+        eraBasedPParams <- theUpdate
+
         returnKeyHash <- readStakeKeyHash returnAddr
 
-        let eraBasedPParams = uppNewPParams eraBasedPParams'
-            updateProtocolParams = createEraBasedProtocolParamUpdate sbe eraBasedPParams
+        let updateProtocolParams = createEraBasedProtocolParamUpdate sbe eraBasedPParams
 
             prevGovActId = Ledger.maybeToStrictMaybe $ uncurry createPreviousGovernanceActionId <$> mPrevGovActId
             proposalAnchor = Ledger.Anchor
@@ -275,12 +284,42 @@ runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do
           $ writeFileTextEnvelope oFp Nothing proposalProcedure
     )
     sbe
+  where
+    theUpdate =
+      case uppCostModelsFile eraBasedPParams' of
+        Nothing -> pure $ uppNewPParams eraBasedPParams'
+        Just (Cmd.CostModelsFile alonzoOnwards costModelsFile) -> do
+          costModels <- firstExceptT GovernanceActionsCmdCostModelsError
+            $ readCostModels costModelsFile
+          pure . addCostModelsToEraBasedProtocolParametersUpdate alonzoOnwards costModels
+            $ uppNewPParams eraBasedPParams'
 
 readStakeKeyHash :: VerificationKeyOrHashOrFile StakeKey -> ExceptT GovernanceActionsError IO (Hash StakeKey)
 readStakeKeyHash stake =
   firstExceptT GovernanceActionsCmdReadFileError
     . newExceptT $ readVerificationKeyOrHashOrFile AsStakeKey stake
 
+addCostModelsToEraBasedProtocolParametersUpdate
+  :: AlonzoEraOnwards era
+  -> Alonzo.CostModels
+  -> EraBasedProtocolParametersUpdate era
+  -> EraBasedProtocolParametersUpdate era
+addCostModelsToEraBasedProtocolParametersUpdate
+    AlonzoEraOnwardsAlonzo
+    cmdls
+    (AlonzoEraBasedProtocolParametersUpdate common sTa aOn depAfterB) =
+  AlonzoEraBasedProtocolParametersUpdate common sTa (aOn { alCostModels = SJust cmdls }) depAfterB
+addCostModelsToEraBasedProtocolParametersUpdate
+    AlonzoEraOnwardsBabbage
+    cmdls
+    (BabbageEraBasedProtocolParametersUpdate common aOn depAfterB inB) =
+  BabbageEraBasedProtocolParametersUpdate common (aOn { alCostModels = SJust cmdls }) depAfterB inB
+addCostModelsToEraBasedProtocolParametersUpdate
+    AlonzoEraOnwardsConway
+    cmdls
+    (ConwayEraBasedProtocolParametersUpdate common aOn inB inC) =
+  ConwayEraBasedProtocolParametersUpdate common (aOn { alCostModels = SJust cmdls }) inB inC
+
 runGovernanceActionTreasuryWithdrawalCmd :: ()
   => GovernanceActionTreasuryWithdrawalCmdArgs era
   -> ExceptT GovernanceActionsError IO ()

cardano-cli/src/Cardano/CLI/Read.hs

@@ -59,6 +59,8 @@ module Cardano.CLI.Read
   , readTxGovernanceActions
   , constitutionHashSourceToHash
   , readProposal
+  , CostModelsError (..)
+  , readCostModels
 
   -- * FileOrPipe
   , FileOrPipe
@@ -108,6 +110,7 @@ import           Cardano.CLI.Types.Errors.StakeCredentialError
 import           Cardano.CLI.Types.Governance
 import           Cardano.CLI.Types.Key
 import qualified Cardano.Crypto.Hash.Class as Crypto
+import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
 import qualified Cardano.Ledger.BaseTypes as L
 import qualified Cardano.Ledger.BaseTypes as Ledger
 import qualified Cardano.Ledger.Conway.Governance as Ledger
@@ -121,7 +124,7 @@ import qualified Cardano.Ledger.SafeHash as Ledger
 import           Prelude
 
 import           Control.Exception (bracket, displayException)
-import           Control.Monad (forM, unless)
+import           Control.Monad (forM, unless, when)
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans (MonadTrans (..))
 import           Control.Monad.Trans.Except
@@ -146,6 +149,7 @@ import           Data.Word
 import           GHC.IO.Handle (hClose, hIsSeekable)
 import           GHC.IO.Handle.FD (openFileBlocking)
 import qualified Options.Applicative as Opt
+import           Prettyprinter (vsep)
 import           System.IO (IOMode (ReadMode))
 
 -- Metadata
@@ -858,6 +862,47 @@ constitutionHashSourceToHash constitutionHashSource = do
     ConstitutionHashSourceHash h ->
       pure h
 
+data CostModelsError
+  = CostModelsErrorReadFile (FileError ())
+  | CostModelsErrorJSONDecode FilePath String
+  | CostModelsErrorEmpty FilePath
+  deriving Show
+
+instance Error CostModelsError where
+  prettyError = \case
+    CostModelsErrorReadFile e ->
+      "Cannot read cost model: " <> prettyError e
+    CostModelsErrorJSONDecode fp err ->
+      "Error decoding JSON cost model at " <> pshow fp <> ": " <> pshow err <> formatExplanation
+    CostModelsErrorEmpty fp ->
+      "The decoded cost model was empty at: " <> pshow fp <> formatExplanation
+    where
+      formatExplanation =
+        vsep [ ""
+             , "The expected format of the cost models file is "
+             , "{"
+             , "  \"PlutusV1\" : <costModel>,"
+             , "  \"PlutusV2\" : <costModel>,"
+             , "  \"PlutusV3\" : <costModel>,"
+             , "}"
+             , "where each of the three entries may be ommited, and a <cost model> is either an ordered list of parameter values like"
+             , "[205665, 812, 1, ...]"
+             , "or a map like"
+             , "{ \"addInteger-cpu-arguments-intercept\": 205665, \"addInteger-cpu-arguments-slope\": 812, \"addInteger-memory-arguments-intercept\": 1, ... }"
+             , "In both cases, the cost model must be complete, i.e. it must specify all parameters that are needed for the specific Plutus version."
+             , "It's not specified what will happen if you provide more parameters than necessary."
+             ]
+
+
+readCostModels
+  :: File Alonzo.CostModels In
+  -> ExceptT CostModelsError IO Alonzo.CostModels
+readCostModels (File fp) = do
+  bytes <- handleIOExceptT (CostModelsErrorReadFile . FileIOError fp) $ LBS.readFile fp
+  costModels <- firstExceptT (CostModelsErrorJSONDecode fp) . except $ Aeson.eitherDecode bytes
+  when (null $ fromAlonzoCostModels costModels) $ throwE $ CostModelsErrorEmpty fp
+  return costModels
+
 -- Misc
 
 -- readFileInByronEra = undefined

cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceActionsError.hs

@@ -12,6 +12,7 @@ import           Cardano.CLI.Read
 data GovernanceActionsError
   = GovernanceActionsCmdConstitutionError ConstitutionError
   | GovernanceActionsCmdProposalError ProposalError
+  | GovernanceActionsCmdCostModelsError CostModelsError
   | GovernanceActionsCmdReadFileError (FileError InputDecodeError)
   | GovernanceActionsCmdReadTextEnvelopeFileError (FileError TextEnvelopeError)
   | GovernanceActionsCmdWriteFileError (FileError ())
@@ -20,6 +21,8 @@ data GovernanceActionsError
 
 instance Error GovernanceActionsError where
   prettyError = \case
+    GovernanceActionsCmdCostModelsError e ->
+      prettyError e
     GovernanceActionsCmdProposalError e ->
       "Cannot read proposal: " <> pshow e -- TODO Conway render this properly
     GovernanceActionsCmdConstitutionError e ->

cardano-cli/test/cardano-cli-golden/Test/Golden/ErrorsSpec.hs

@@ -7,6 +7,7 @@ module Test.Golden.ErrorsSpec
   , test_GovernanceComitteeError
   , test_RegistrationError
   , test_VoteReadError
+  , test_CostModelsError
   ) where
 
 import           Cardano.Api
@@ -176,8 +177,22 @@ test_GovernanceActionsError =
       , GovernanceActionsCmdConstitutionError
           $ ConstitutionNotUnicodeError
           $ DecodeError "seq" Nothing)
+    , ("GovernanceActionsCmdCostModelsError"
+      , GovernanceActionsCmdCostModelsError
+          $ CostModelsErrorReadFile
+          $ FileError "some/file.txt" ())
     ]
 
+test_CostModelsError :: TestTree
+test_CostModelsError =
+  testErrorMessagesRendering "Cardano.CLI.Read" "CostModelsError"
+    [ ("CostModelsErrorReadFile"
+      , CostModelsErrorReadFile $ FileError "some/file.txt" ())
+    , ("CostModelsErrorJSONDecode"
+      , CostModelsErrorJSONDecode "some/file.txt" "some error")
+    , ("CostModelsErrorEmpty"
+      , CostModelsErrorEmpty "some/file.txt")
+    ]
 
 goldenFilesPath :: FilePath
 goldenFilesPath = "test/cardano-cli-golden/files/golden/errors"