WIP

IntersectMBO · Nov 25, 2022 · e07cc7c · e07cc7c
1 parent 2a82e46
commit e07cc7c
Show file tree

Hide file tree

Showing 14 changed files with 134 additions and 69 deletions.
diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -684,8 +684,8 @@ module Cardano.Api (
     SlotsToEpochEnd(..),
     slotToEpoch,
 
-    -- * Node socket related
-    EnvSocketError(..),
+    -- * environment related
+    EnvLookupError(..),
     SocketPath(..),
     readEnvSocketPath,
     renderEnvSocketError,

diff --git a/cardano-api/src/Cardano/Api/Convenience/Query.hs b/cardano-api/src/Cardano/Api/Convenience/Query.hs
@@ -36,7 +36,7 @@ import           Cardano.Api.Utils
 
 data QueryConvenienceError
   = AcqFailure AcquiringFailure
-  | SockErr EnvSocketError
+  | SockErr EnvLookupError
   | QueryEraMismatch EraMismatch
   | ByronEraNotSupported
   | EraConsensusModeMismatch !AnyConsensusMode !AnyCardanoEra

diff --git a/cardano-api/src/Cardano/Api/Environment.hs b/cardano-api/src/Cardano/Api/Environment.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Cardano.Api.Environment
-  ( EnvSocketError(..)
+  ( EnvLookupError(..)
   , SocketPath(..)
   , readEnvSocketPath
   , renderEnvSocketError
@@ -21,24 +21,27 @@ newtype SocketPath
   = SocketPath { unSocketPath :: FilePath }
   deriving (FromJSON, Show, Eq, Ord)
 
-newtype EnvSocketError = CliEnvVarLookup Text deriving Show
+data EnvLookupError
+  = SocketLookupError Text
+  | NetworkIdLookupError Text
+  deriving Show
 
-renderEnvSocketError :: EnvSocketError -> Text
+renderEnvSocketError :: EnvLookupError -> Text
 renderEnvSocketError err =
   case err of
-    CliEnvVarLookup txt ->
+    SocketLookupError txt ->
       "Error while looking up environment variable: CARDANO_NODE_SOCKET_PATH " <> " Error: " <> textShow txt
 
 -- | Read the node socket path from the environment.
 -- Fails if the environment variable is not set.
-readEnvSocketPath :: IO (Either EnvSocketError SocketPath)
+readEnvSocketPath :: IO (Either EnvLookupError SocketPath)
 readEnvSocketPath = do
     mEnvName <- lookupEnv envName
     case mEnvName of
       Just sPath ->
         return . Right $ SocketPath sPath
       Nothing ->
-        return . Left $ CliEnvVarLookup (Text.pack envName)
+        return . Left $ SocketLookupError (Text.pack envName)
   where
     envName :: String
     envName = "CARDANO_NODE_SOCKET_PATH"
diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -89,6 +89,7 @@ library
                         Cardano.CLI.Shelley.Run.Transaction
                         Cardano.CLI.Shelley.Run.Read
                         Cardano.CLI.Shelley.Run.Validate
+                        Cardano.CLI.Shelley.Util
 
                         Cardano.CLI.TopHandler
 

diff --git a/cardano-cli/src/Cardano/CLI/Byron/Query.hs b/cardano-cli/src/Cardano/CLI/Byron/Query.hs
@@ -20,21 +20,21 @@ import qualified Data.Text.Encoding as Text
 
 {- HLINT ignore "Reduce duplication" -}
 
-newtype ByronQueryError = ByronQueryEnvVarSocketErr EnvSocketError
+newtype ByronQueryError = ByronQueryErr EnvLookupError
   deriving Show
 
 renderByronQueryError :: ByronQueryError -> Text
 renderByronQueryError err =
   case err of
-    ByronQueryEnvVarSocketErr sockEnvErr -> renderEnvSocketError sockEnvErr
+    ByronQueryErr sockEnvErr -> renderEnvSocketError sockEnvErr
 
 --------------------------------------------------------------------------------
 -- Query local node's chain tip
 --------------------------------------------------------------------------------
 
 runGetLocalNodeTip :: NetworkId -> ExceptT ByronQueryError IO ()
 runGetLocalNodeTip networkId = do
-    SocketPath sockPath <- firstExceptT ByronQueryEnvVarSocketErr
+    SocketPath sockPath <- firstExceptT ByronQueryErr
                              $ newExceptT readEnvSocketPath
     let connctInfo =
           LocalNodeConnectInfo {

diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs
@@ -54,7 +54,7 @@ data ByronTxError
   = TxDeserialisationFailed !FilePath !Binary.DecoderError
   | ByronTxSubmitError !Text
   | ByronTxSubmitErrorEraMismatch !EraMismatch
-  | EnvSocketError !EnvSocketError
+  | EnvSocketError !EnvLookupError
   deriving Show
 
 renderByronTxError :: ByronTxError -> Text

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs
@@ -18,6 +18,7 @@ module Cardano.CLI.Shelley.Commands
   , renderShelleyCommand
 
     -- * CLI flag types
+  , NetworkIdArg (..)
   , AddressKeyType (..)
   , ByronKeyType (..)
   , ByronKeyFormat (..)
@@ -57,6 +58,7 @@ import           Cardano.CLI.Types
 
 import           Cardano.Chain.Common (BlockCount)
 import           Cardano.Ledger.Shelley.TxBody (MIRPot)
+
 --
 -- Shelley CLI command data types
 --
@@ -95,9 +97,9 @@ data AddressCmd
   | AddressBuild
       PaymentVerifier
       (Maybe StakeVerifier)
-      NetworkId
+      NetworkIdArg
       (Maybe OutputFile)
-  | AddressBuildMultiSig ScriptFile NetworkId (Maybe OutputFile)
+  | AddressBuildMultiSig ScriptFile NetworkIdArg (Maybe OutputFile)
   | AddressInfo Text (Maybe OutputFile)
   deriving Show
 
@@ -114,7 +116,7 @@ renderAddressCmd cmd =
 data StakeAddressCmd
   = StakeAddressKeyGen VerificationKeyFile SigningKeyFile
   | StakeAddressKeyHash (VerificationKeyOrFile StakeKey) (Maybe OutputFile)
-  | StakeAddressBuild StakeVerifier NetworkId (Maybe OutputFile)
+  | StakeAddressBuild StakeVerifier NetworkIdArg (Maybe OutputFile)
   | StakeRegistrationCert StakeVerifier OutputFile
   | StakeCredentialDelegationCert
       StakeVerifier
@@ -196,7 +198,7 @@ data TransactionCmd
   | TxBuild
       AnyCardanoEra
       AnyConsensusModeParams
-      NetworkId
+      NetworkIdArg
       (Maybe ScriptValidity) -- ^ Mark script as expected to pass or fail validation
       (Maybe Word)
       -- ^ Override the required number of tx witnesses
@@ -233,14 +235,14 @@ data TransactionCmd
       (Maybe ProtocolParamsSourceSpec)
       (Maybe UpdateProposalFile)
       TxBuildOutputOptions
-  | TxSign InputTxBodyOrTxFile [WitnessSigningData] (Maybe NetworkId) TxFile
-  | TxCreateWitness TxBodyFile WitnessSigningData (Maybe NetworkId) OutputFile
+  | TxSign InputTxBodyOrTxFile [WitnessSigningData] (Maybe NetworkIdArg) TxFile
+  | TxCreateWitness TxBodyFile WitnessSigningData (Maybe NetworkIdArg) OutputFile
   | TxAssembleTxBodyWitness TxBodyFile [WitnessFile] OutputFile
-  | TxSubmit AnyConsensusModeParams NetworkId FilePath
+  | TxSubmit AnyConsensusModeParams NetworkIdArg FilePath
   | TxMintedPolicyId ScriptFile
   | TxCalculateMinFee
       TxBodyFile
-      (Maybe NetworkId)
+      (Maybe NetworkIdArg)
       ProtocolParamsSourceSpec
       TxInCount
       TxOutCount
@@ -326,7 +328,7 @@ data PoolCmd
       -- ^ Stake pool relays.
       (Maybe StakePoolMetadataReference)
       -- ^ Stake pool metadata.
-      NetworkId
+      NetworkIdArg
       OutputFile
   | PoolRetirementCert
       (VerificationKeyOrFile StakePoolKey)
@@ -349,29 +351,29 @@ renderPoolCmd cmd =
 data QueryCmd =
     QueryLeadershipSchedule
       AnyConsensusModeParams
-      NetworkId
+      NetworkIdArg
       GenesisFile
       (VerificationKeyOrHashOrFile StakePoolKey)
       SigningKeyFile
       EpochLeadershipSchedule
       (Maybe OutputFile)
-  | QueryProtocolParameters' AnyConsensusModeParams NetworkId (Maybe OutputFile)
-  | QueryTip AnyConsensusModeParams NetworkId (Maybe OutputFile)
-  | QueryStakePools' AnyConsensusModeParams NetworkId (Maybe OutputFile)
-  | QueryStakeDistribution' AnyConsensusModeParams NetworkId (Maybe OutputFile)
-  | QueryStakeAddressInfo AnyConsensusModeParams StakeAddress NetworkId (Maybe OutputFile)
-  | QueryUTxO' AnyConsensusModeParams QueryUTxOFilter NetworkId (Maybe OutputFile)
-  | QueryDebugLedgerState' AnyConsensusModeParams NetworkId (Maybe OutputFile)
-  | QueryProtocolState' AnyConsensusModeParams NetworkId (Maybe OutputFile)
-  | QueryStakeSnapshot' AnyConsensusModeParams NetworkId (Hash StakePoolKey)
+  | QueryProtocolParameters' AnyConsensusModeParams NetworkIdArg (Maybe OutputFile)
+  | QueryTip AnyConsensusModeParams NetworkIdArg (Maybe OutputFile)
+  | QueryStakePools' AnyConsensusModeParams NetworkIdArg (Maybe OutputFile)
+  | QueryStakeDistribution' AnyConsensusModeParams NetworkIdArg (Maybe OutputFile)
+  | QueryStakeAddressInfo AnyConsensusModeParams StakeAddress NetworkIdArg (Maybe OutputFile)
+  | QueryUTxO' AnyConsensusModeParams QueryUTxOFilter NetworkIdArg (Maybe OutputFile)
+  | QueryDebugLedgerState' AnyConsensusModeParams NetworkIdArg (Maybe OutputFile)
+  | QueryProtocolState' AnyConsensusModeParams NetworkIdArg (Maybe OutputFile)
+  | QueryStakeSnapshot' AnyConsensusModeParams NetworkIdArg (Hash StakePoolKey)
   | QueryKesPeriodInfo
       AnyConsensusModeParams
-      NetworkId
+      NetworkIdArg
       FilePath
       -- ^ Node operational certificate
       (Maybe OutputFile)
-  | QueryPoolState' AnyConsensusModeParams NetworkId [Hash StakePoolKey]
-  | QueryTxMempool AnyConsensusModeParams NetworkId TxMempoolQuery (Maybe OutputFile)
+  | QueryPoolState' AnyConsensusModeParams NetworkIdArg [Hash StakePoolKey]
+  | QueryTxMempool AnyConsensusModeParams NetworkIdArg TxMempoolQuery (Maybe OutputFile)
   deriving Show
 
 renderQueryCmd :: QueryCmd -> Text
@@ -434,8 +436,8 @@ renderTextViewCmd :: TextViewCmd -> Text
 renderTextViewCmd (TextViewInfo _ _) = "text-view decode-cbor"
 
 data GenesisCmd
-  = GenesisCreate GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) NetworkId
-  | GenesisCreateCardano GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) BlockCount Word Rational NetworkId FilePath FilePath FilePath (Maybe FilePath)
+  = GenesisCreate GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) NetworkIdArg
+  | GenesisCreateCardano GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) BlockCount Word Rational NetworkIdArg FilePath FilePath FilePath (Maybe FilePath)
   | GenesisCreateStaked
       GenesisDir
       Word
@@ -445,7 +447,7 @@ data GenesisCmd
       (Maybe SystemStart)
       (Maybe Lovelace)
       Lovelace
-      NetworkId
+      NetworkIdArg
       Word
       Word
       Word
@@ -455,8 +457,8 @@ data GenesisCmd
   | GenesisKeyGenUTxO VerificationKeyFile SigningKeyFile
   | GenesisCmdKeyHash VerificationKeyFile
   | GenesisVerKey VerificationKeyFile SigningKeyFile
-  | GenesisTxIn VerificationKeyFile NetworkId (Maybe OutputFile)
-  | GenesisAddr VerificationKeyFile NetworkId (Maybe OutputFile)
+  | GenesisTxIn VerificationKeyFile NetworkIdArg (Maybe OutputFile)
+  | GenesisAddr VerificationKeyFile NetworkIdArg (Maybe OutputFile)
   | GenesisHashFile GenesisFile
   deriving Show
 
@@ -479,6 +481,11 @@ renderGenesisCmd cmd =
 -- Shelley CLI flag/option data types
 --
 
+data NetworkIdArg
+  = NetworkIdFromCLI NetworkId
+  | NetworkIdFromEnv
+  deriving (Show,Eq)
+
 newtype ProtocolParamsFile
   = ProtocolParamsFile FilePath
   deriving (Show, Eq)

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs
@@ -2027,25 +2027,38 @@ pKesVerificationKeyFile =
         )
     )
 
-pNetworkId :: Parser NetworkId
+pNetworkId :: Parser NetworkIdArg
 pNetworkId =
-  pMainnet <|> fmap Testnet pTestnetMagic
+  (NetworkIdFromCLI <$> (pMainnet <|> pTestnetMagic))
+  <|> pNetworkFromEnv
+  <|> pure NetworkIdFromEnv
  where
-   pMainnet :: Parser NetworkId
-   pMainnet =
-    Opt.flag' Mainnet
-      (  Opt.long "mainnet"
-      <> Opt.help "Use the mainnet magic id."
-      )
+  pMainnet :: Parser NetworkId
+  pMainnet =
+   Opt.flag' Mainnet
+     (  Opt.long "mainnet"
+     <> Opt.help "Use the mainnet magic id."
+     )
 
-pTestnetMagic :: Parser NetworkMagic
-pTestnetMagic =
-  NetworkMagic <$>
-    Opt.option Opt.auto
-      (  Opt.long "testnet-magic"
-      <> Opt.metavar "NATURAL"
-      <> Opt.help "Specify a testnet magic id."
-      )
+  pTestnetMagic :: Parser NetworkId
+  pTestnetMagic =
+    Testnet . NetworkMagic <$>
+      Opt.option Opt.auto
+        (  Opt.long "testnet-magic"
+        <> Opt.metavar "NATURAL"
+        <> Opt.help "Specify a testnet magic id."
+        )
+
+  pNetworkFromEnv :: Parser NetworkIdArg
+  pNetworkFromEnv = pure NetworkIdFromEnv
+{--    
+    NetworkMagic <$>
+      Opt.option Opt.auto
+        (  Opt.long "network-id-from-env"
+        <> Opt.metavar "NATURAL"
+        <> Opt.help "Use the network id from the environment. (This is the default.)"
+        )
+--}
 
 pTxSubmitFile :: Parser FilePath
 pTxSubmitFile =

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs
@@ -23,13 +23,15 @@ import           Cardano.Api
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.Helpers
+import           Cardano.CLI.Shelley.Commands (NetworkIdArg(..))
 import           Cardano.CLI.Shelley.Key (PaymentVerifier (..), StakeVerifier (..),
                    VerificationKeyTextOrFile, VerificationKeyTextOrFileError (..), generateKeyPair,
                    readVerificationKeyOrFile, readVerificationKeyTextOrFileAnyOf,
                    renderVerificationKeyTextOrFileError)
 import           Cardano.CLI.Shelley.Parsers (AddressCmd (..), AddressKeyType (..), OutputFile (..))
 import           Cardano.CLI.Shelley.Run.Address.Info (ShelleyAddressInfoError, runAddressInfo)
 import           Cardano.CLI.Shelley.Run.Read
+import           Cardano.CLI.Shelley.Util (NetworkIdError, getNetworkId, displayErrorText)
 import           Cardano.CLI.Types
 
 data ShelleyAddressCmdError
@@ -39,6 +41,7 @@ data ShelleyAddressCmdError
   | ShelleyAddressCmdVerificationKeyTextOrFileError !VerificationKeyTextOrFileError
   | ShelleyAddressCmdWriteFileError !(FileError ())
   | ShelleyAddressCmdExpectedPaymentVerificationKey SomeAddressVerificationKey
+  | ShelleyAddressCmdGetNetworkIdError !NetworkIdError
   deriving Show
 
 renderShelleyAddressCmdError :: ShelleyAddressCmdError -> Text
@@ -55,7 +58,8 @@ renderShelleyAddressCmdError err =
     ShelleyAddressCmdWriteFileError fileErr -> Text.pack (displayError fileErr)
     ShelleyAddressCmdExpectedPaymentVerificationKey someAddress ->
       "Expected payment verification key but got: " <> renderSomeAddressVerificationKey someAddress
-
+    ShelleyAddressCmdGetNetworkIdError err -> displayErrorText err
+
 runAddressCmd :: AddressCmd -> ExceptT ShelleyAddressCmdError IO ()
 runAddressCmd cmd =
   case cmd of
@@ -117,10 +121,11 @@ runAddressKeyHash vkeyTextOrFile mOutputFp = do
 
 runAddressBuild :: PaymentVerifier
                 -> Maybe StakeVerifier
-                -> NetworkId
+                -> NetworkIdArg
                 -> Maybe OutputFile
                 -> ExceptT ShelleyAddressCmdError IO ()
-runAddressBuild paymentVerifier mbStakeVerifier nw mOutFp = do
+runAddressBuild paymentVerifier mbStakeVerifier nwArg mOutFp = do
+  nw <- getNetworkId nwArg {-else-} ShelleyAddressCmdGetNetworkIdError
   outText <- case paymentVerifier of
     PaymentVerifierKey payVkeyTextOrFile -> do
       payVKey <- firstExceptT ShelleyAddressCmdVerificationKeyTextOrFileError $
@@ -210,10 +215,9 @@ foldSomeAddressVerificationKey f (AStakeExtendedVerificationKey   vk) = f vk
 
 runAddressBuildScript
   :: ScriptFile
-  -> NetworkId
+  -> NetworkIdArg
   -> Maybe OutputFile
   -> ExceptT ShelleyAddressCmdError IO ()
-runAddressBuildScript scriptFile networkId mOutputFile = do
+runAddressBuildScript scriptFile networkIdArg mOutputFile = do
   liftIO $ deprecationWarning "'address build'"
-  runAddressBuild (PaymentVerifierScriptFile scriptFile) Nothing networkId mOutputFile
-
+  runAddressBuild (PaymentVerifierScriptFile scriptFile) Nothing networkIdArg mOutputFile