Merge #4516

4516: Condense Read and Validation modules in cardano-cli r=Jimbo4350 a=Jimbo4350 Two things occur before constructing a tx. You must first read the parts you need and then validate that they can indeed be used in a particular era. We condense these into two module in the cli, with the eventual aim of moving them to cardano-api. Co-authored-by: Jordan Millar <jordan.millar@iohk.io>
IntersectMBO · Oct 31, 2022 · e37ae4f · e37ae4f
2 parents 521b64a + d724518
commit e37ae4f
Show file tree

Hide file tree

Showing 13 changed files with 1,328 additions and 932 deletions.
diff --git a/bench/tx-generator/src/Cardano/Benchmarking/PlutusExample.hs b/bench/tx-generator/src/Cardano/Benchmarking/PlutusExample.hs
@@ -3,21 +3,23 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Cardano.Benchmarking.PlutusExample
 where
-import           Prelude
 import qualified Data.Map as Map
+import           Prelude
 
 import           Control.Monad.Trans.Except
 import qualified Data.ByteString.Char8 as BSC
 
-import           Cardano.CLI.Shelley.Script (readFileScriptInAnyLang)
 
 import           Cardano.Api
-import           Cardano.Api.Shelley ( ProtocolParameters(..), PlutusScript(..)
-                                     , fromAlonzoExUnits, protocolParamCostModels, toPlutusData)
+import           Cardano.Api.Shelley (PlutusScript (..), ProtocolParameters (..), fromAlonzoExUnits,
+                   protocolParamCostModels, toPlutusData)
 import           Cardano.Ledger.Alonzo.TxInfo (exBudgetToExUnits)
 
 import qualified Plutus.V1.Ledger.Api as Plutus
-import           Plutus.V1.Ledger.Contexts (ScriptContext(..), ScriptPurpose(..), TxInfo(..), TxOutRef(..))
+import           Plutus.V1.Ledger.Contexts (ScriptContext (..), ScriptPurpose (..), TxInfo (..),
+                   TxOutRef (..))
+
+import           Cardano.CLI.Shelley.Run.Read
 
 readScript :: FilePath -> IO (Script PlutusScriptV1)
 readScript fp = do

diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -701,6 +701,7 @@ module Cardano.Api (
     -- ** Misc
     ScriptLockedTxInsError(..),
     TxInsExistError(..),
+    renderEra,
     renderNotScriptLockedTxInsError,
     renderTxInsExistError,
     txInsExistInUTxO,

diff --git a/cardano-api/src/Cardano/Api/Utils.hs b/cardano-api/src/Cardano/Api/Utils.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 
 #if !defined(mingw32_HOST_OS)
@@ -17,6 +18,7 @@ module Cardano.Api.Utils
   , note
   , parseFilePath
   , readFileBlocking
+  , renderEra
   , runParsecParser
   , textShow
   , writeSecrets
@@ -47,6 +49,8 @@ import           System.Posix.Files (ownerReadMode, setFileMode)
 import           System.Directory (emptyPermissions, readable, setPermissions)
 #endif
 
+import           Cardano.Api.Eras
+
 (?!) :: Maybe a -> e -> Either e a
 Nothing ?! e = Left e
 Just x  ?! _ = Right x
@@ -121,3 +125,12 @@ readFileBlocking path = bracket
 
 textShow :: Show a => a -> Text
 textShow = Text.pack . show
+
+renderEra :: AnyCardanoEra -> Text
+renderEra (AnyCardanoEra ByronEra)   = "Byron"
+renderEra (AnyCardanoEra ShelleyEra) = "Shelley"
+renderEra (AnyCardanoEra AllegraEra) = "Allegra"
+renderEra (AnyCardanoEra MaryEra)    = "Mary"
+renderEra (AnyCardanoEra AlonzoEra)  = "Alonzo"
+renderEra (AnyCardanoEra BabbageEra) = "Babbage"
+
diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -87,7 +87,8 @@ library
                         Cardano.CLI.Shelley.Run.StakeAddress
                         Cardano.CLI.Shelley.Run.TextView
                         Cardano.CLI.Shelley.Run.Transaction
-                        Cardano.CLI.Shelley.Script
+                        Cardano.CLI.Shelley.Run.Read
+                        Cardano.CLI.Shelley.Run.Validate
 
                         Cardano.CLI.TopHandler
 

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs
@@ -31,7 +31,7 @@ import           Cardano.CLI.Shelley.Key (InputDecodeError, PaymentVerifier (..)
                    readVerificationKeyTextOrFileAnyOf, renderVerificationKeyTextOrFileError)
 import           Cardano.CLI.Shelley.Parsers (AddressCmd (..), AddressKeyType (..), OutputFile (..))
 import           Cardano.CLI.Shelley.Run.Address.Info (ShelleyAddressInfoError, runAddressInfo)
-import           Cardano.CLI.Shelley.Script
+import           Cardano.CLI.Shelley.Run.Read
 import           Cardano.CLI.Types
 
 data ShelleyAddressCmdError

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs
@@ -20,6 +20,12 @@ module Cardano.CLI.Shelley.Run.Genesis
   , readAndDecodeShelleyGenesis
   , readAlonzoGenesis
   , runGenesisCmd
+
+  -- * Protocol Parameters
+  , ProtocolParamsError(..)
+  , renderProtocolParamsError
+  , readProtocolParameters
+  , readProtocolParametersSourceSpec
   ) where
 
 import           Cardano.Prelude hiding (unlines)
@@ -104,7 +110,7 @@ import           Cardano.Chain.Common (BlockCount (unBlockCount))
 import           Cardano.Chain.Delegation (delegateVK)
 import qualified Cardano.Chain.Delegation as Dlg
 import qualified Cardano.Chain.Genesis as Genesis
-import           Cardano.Chain.Update
+import           Cardano.Chain.Update hiding (ProtocolParameters)
 import           Cardano.Slotting.Slot (EpochSize (EpochSize))
 import           Data.Fixed (Fixed (MkFixed))
 import qualified Data.Yaml as Yaml
@@ -1314,3 +1320,36 @@ readAlonzoGenesis fpath = do
   lbs <- handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ LBS.readFile fpath
   firstExceptT (ShelleyGenesisCmdAesonDecodeError fpath . Text.pack)
     . hoistEither $ Aeson.eitherDecode' lbs
+
+
+-- Protocol Parameters
+
+data ProtocolParamsError
+  = ProtocolParamsErrorFile (FileError ())
+  | ProtocolParamsErrorJSON !FilePath !Text
+  | ProtocolParamsErrorGenesis !ShelleyGenesisCmdError
+
+renderProtocolParamsError :: ProtocolParamsError -> Text
+renderProtocolParamsError (ProtocolParamsErrorFile fileErr) =
+  Text.pack $ displayError fileErr
+renderProtocolParamsError (ProtocolParamsErrorJSON fp jsonErr) =
+  "Error while decoding the protocol parameters at: " <> Text.pack fp <> " Error: " <> jsonErr
+renderProtocolParamsError (ProtocolParamsErrorGenesis err) =
+  Text.pack $ displayError  err
+
+readProtocolParametersSourceSpec :: ProtocolParamsSourceSpec
+                                 -> ExceptT ProtocolParamsError IO ProtocolParameters
+readProtocolParametersSourceSpec (ParamsFromGenesis (GenesisFile f)) =
+  fromShelleyPParams . sgProtocolParams
+    <$> firstExceptT ProtocolParamsErrorGenesis (readShelleyGenesisWithDefault f id)
+readProtocolParametersSourceSpec (ParamsFromFile f) = readProtocolParameters f
+
+--TODO: eliminate this and get only the necessary params, and get them in a more
+-- helpful way rather than requiring them as a local file.
+readProtocolParameters :: ProtocolParamsFile
+                       -> ExceptT ProtocolParamsError IO ProtocolParameters
+readProtocolParameters (ProtocolParamsFile fpath) = do
+  pparams <- handleIOExceptT (ProtocolParamsErrorFile . FileIOError fpath) $ LBS.readFile fpath
+  firstExceptT (ProtocolParamsErrorJSON fpath . Text.pack) . hoistEither $
+    Aeson.eitherDecode' pparams
+