Implement support for specifying node protocol in CLI (V2)

cardano-api/src/Cardano/Api/LocalChainSync.hs

@@ -8,7 +8,6 @@ module Cardano.Api.LocalChainSync
 import           Cardano.Prelude hiding (atomically, catch)
 
 import           Control.Concurrent.STM
-
 import           Cardano.Api.Typed
 
 import           Ouroboros.Network.Block (Tip)

cardano-api/src/Cardano/Api/Protocol.hs

@@ -19,66 +19,57 @@ module Cardano.Api.Protocol
     -- * Node client support
     -- | Support for the context needed to run a client of a node that is using
     -- a protocol.
-  , mkNodeClientProtocol
-  , SomeNodeClientProtocol(..)
+  , localNodeConnectInfo
+  , withlocalNodeConnectInfo
+  , LocalNodeConnectInfoForSomeMode(..)
   ) where
 
 import           Cardano.Prelude
 
-import           Control.Monad.Fail (fail)
-import           Data.Aeson
-
 import           Cardano.Chain.Slotting (EpochSlots(..))
 
-import           Cardano.Api.Protocol.Types
-import           Cardano.Api.Protocol.Byron
-import           Cardano.Api.Protocol.Cardano
-import           Cardano.Api.Protocol.Shelley
+import           Cardano.Api.Typed
 
 import qualified Ouroboros.Consensus.Cardano as Consensus
+import           Ouroboros.Consensus.Node.Run (RunNode)
+
 
 data Protocol = MockProtocol !MockProtocol
-              | ByronProtocol
+              | ByronProtocol !EpochSlots !Consensus.SecurityParam
               | ShelleyProtocol
-              | CardanoProtocol
-  deriving (Eq, Show, Generic)
-
-instance FromJSON Protocol where
-  parseJSON =
-    withText "Protocol" $ \str -> case str of
-
-      -- The new names
-      "MockBFT"   -> pure (MockProtocol MockBFT)
-      "MockPBFT"  -> pure (MockProtocol MockPBFT)
-      "MockPraos" -> pure (MockProtocol MockPraos)
-      "Byron"     -> pure ByronProtocol
-      "Shelley"   -> pure ShelleyProtocol
-      "Cardano"   -> pure CardanoProtocol
-
-      -- The old names
-      "BFT"       -> pure (MockProtocol MockBFT)
-    --"MockPBFT"  -- same as new name
-      "Praos"     -> pure (MockProtocol MockPraos)
-      "RealPBFT"  -> pure ByronProtocol
-      "TPraos"    -> pure ShelleyProtocol
-
-      _           -> fail $ "Parsing of Protocol failed. "
-                         <> show str <> " is not a valid protocol"
-
-
-deriving instance NFData Protocol
-deriving instance NoUnexpectedThunks Protocol
+              | CardanoProtocol !EpochSlots !Consensus.SecurityParam
+  deriving (Eq, Show)
 
 data MockProtocol = MockBFT
                   | MockPBFT
                   | MockPraos
-  deriving (Eq, Show, Generic)
-
-deriving instance NFData MockProtocol
-deriving instance NoUnexpectedThunks MockProtocol
-
-mkNodeClientProtocol :: Protocol -> SomeNodeClientProtocol
-mkNodeClientProtocol protocol =
+  deriving (Eq, Show)
+
+
+data LocalNodeConnectInfoForSomeMode where
+
+     LocalNodeConnectInfoForSomeMode
+       :: RunNode block
+       => LocalNodeConnectInfo mode block
+       -> LocalNodeConnectInfoForSomeMode
+
+withlocalNodeConnectInfo :: Protocol
+                         -> NetworkId
+                         -> FilePath
+                         -> (forall mode block.
+                                RunNode block
+                             => LocalNodeConnectInfo mode block
+                             -> a)
+                         -> a
+withlocalNodeConnectInfo protocol network socketPath f =
+    case localNodeConnectInfo protocol network socketPath of
+      LocalNodeConnectInfoForSomeMode connctInfo -> f connctInfo
+
+localNodeConnectInfo :: Protocol
+                     -> NetworkId
+                     -> FilePath
+                     -> LocalNodeConnectInfoForSomeMode
+localNodeConnectInfo protocol network socketPath =
     case protocol of
 {-
       --TODO
@@ -93,27 +84,21 @@ mkNodeClientProtocol protocol =
         panic "TODO: mkNodeClientProtocol NodeProtocolConfigurationMock"
 
       -- Real protocols
-      ByronProtocol ->
-        mkSomeNodeClientProtocolByron
-          --TODO: this is only the correct value for mainnet
-          -- not for Byron testnets. This value is needed because
-          -- to decode legacy EBBs one needs to know how many
-          -- slots there are per-epoch. This info comes from
-          -- the genesis file, but we don't have that in the
-          -- client case.
-          (EpochSlots 21600)
-          (Consensus.SecurityParam 2160)
+      ByronProtocol epSlots secParam ->
+        LocalNodeConnectInfoForSomeMode $
+          LocalNodeConnectInfo
+            socketPath network
+            (ByronMode epSlots secParam)
 
       ShelleyProtocol ->
-        mkSomeNodeClientProtocolShelley
-
-      CardanoProtocol ->
-        mkSomeNodeClientProtocolCardano
-          --TODO: this is only the correct value for mainnet
-          -- not for Byron testnets. This value is needed because
-          -- to decode legacy EBBs one needs to know how many
-          -- slots there are per-epoch. This info comes from
-          -- the genesis file, but we don't have that in the
-          -- client case.
-          (EpochSlots 21600)
-          (Consensus.SecurityParam 2160)
+        LocalNodeConnectInfoForSomeMode $
+          LocalNodeConnectInfo
+            socketPath network
+            ShelleyMode
+
+      CardanoProtocol epSlots secParam ->
+        LocalNodeConnectInfoForSomeMode $
+          LocalNodeConnectInfo
+            socketPath network
+            (CardanoMode epSlots secParam)
+

cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

@@ -44,6 +44,7 @@ import           Prelude
 import           Data.Set (Set)
 import           Data.Text (Text)
 
+import           Cardano.Api.Protocol (Protocol)
 import           Cardano.Api.Typed hiding (PoolId, Hash)
 
 import           Ouroboros.Consensus.BlockchainTime (SystemStart (..))
@@ -112,7 +113,7 @@ data TransactionCmd
   | TxWitness       -- { transaction :: Transaction, key :: PrivKeyFile, nodeAddr :: NodeAddress }
   | TxSignWitness   -- { transaction :: Transaction, witnesses :: [Witness], nodeAddr :: NodeAddress }
   | TxCheck         -- { transaction :: Transaction, nodeAddr :: NodeAddress }
-  | TxSubmit FilePath NetworkId
+  | TxSubmit Protocol NetworkId FilePath
   | TxCalculateMinFee
       TxBodyFile
       (Maybe NetworkId)
@@ -172,13 +173,13 @@ data PoolCmd
 
 data QueryCmd
   = QueryPoolId NodeAddress
-  | QueryProtocolParameters NetworkId (Maybe OutputFile)
-  | QueryTip NetworkId (Maybe OutputFile)
-  | QueryStakeDistribution NetworkId (Maybe OutputFile)
-  | QueryStakeAddressInfo StakeAddress NetworkId (Maybe OutputFile)
-  | QueryUTxO QueryFilter NetworkId (Maybe OutputFile)
+  | QueryProtocolParameters Protocol NetworkId (Maybe OutputFile)
+  | QueryTip Protocol NetworkId (Maybe OutputFile)
+  | QueryStakeDistribution Protocol NetworkId (Maybe OutputFile)
+  | QueryStakeAddressInfo Protocol StakeAddress NetworkId (Maybe OutputFile)
+  | QueryUTxO Protocol QueryFilter NetworkId (Maybe OutputFile)
   | QueryVersion NodeAddress
-  | QueryLedgerState NetworkId (Maybe OutputFile)
+  | QueryLedgerState Protocol NetworkId (Maybe OutputFile)
   | QueryStatus NodeAddress
   deriving (Eq, Show)
 

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

@@ -31,12 +31,16 @@ import qualified Data.Attoparsec.ByteString.Char8 as Atto
 import           Network.Socket (PortNumber)
 import           Network.URI (URI, parseURI)
 
+import           Cardano.Chain.Slotting (EpochSlots(..))
 import           Cardano.Slotting.Slot (SlotNo(..))
 
 import           Ouroboros.Consensus.BlockchainTime (SystemStart (..))
+import           Ouroboros.Consensus.Cardano (SecurityParam (..))
+
 import qualified Shelley.Spec.Ledger.BaseTypes as Shelley
 import qualified Shelley.Spec.Ledger.TxData as Shelley
 
+import           Cardano.Api.Protocol (Protocol (..))
 import           Cardano.Api.Typed hiding (PoolId)
 
 import           Cardano.Slotting.Slot (EpochNo (..))
@@ -315,8 +319,9 @@ pTransaction =
     pTransactionCheck = pure TxCheck
 
     pTransactionSubmit  :: Parser TransactionCmd
-    pTransactionSubmit = TxSubmit <$> pTxSubmitFile
+    pTransactionSubmit = TxSubmit <$> pProtocol
                                   <*> pNetworkId
+                                  <*> pTxSubmitFile
 
     pTransactionCalculateMinFee :: Parser TransactionCmd
     pTransactionCalculateMinFee =
@@ -452,37 +457,41 @@ pQueryCmd =
     pQueryProtocolParameters :: Parser QueryCmd
     pQueryProtocolParameters =
       QueryProtocolParameters
-        <$> pNetworkId
+        <$> pProtocol
+        <*> pNetworkId
         <*> pMaybeOutputFile
 
     pQueryTip :: Parser QueryCmd
-    pQueryTip = QueryTip <$> pNetworkId <*> pMaybeOutputFile
+    pQueryTip = QueryTip <$> pProtocol <*> pNetworkId <*> pMaybeOutputFile
 
     pQueryUTxO :: Parser QueryCmd
     pQueryUTxO =
       QueryUTxO
-        <$> pQueryFilter
+        <$> pProtocol
+        <*> pQueryFilter
         <*> pNetworkId
         <*> pMaybeOutputFile
 
     pQueryStakeDistribution :: Parser QueryCmd
     pQueryStakeDistribution =
       QueryStakeDistribution
-        <$> pNetworkId
+        <$> pProtocol
+        <*> pNetworkId
         <*> pMaybeOutputFile
 
     pQueryStakeAddressInfo :: Parser QueryCmd
     pQueryStakeAddressInfo =
       QueryStakeAddressInfo
-        <$> pFilterByStakeAddress
+        <$> pProtocol
+        <*> pFilterByStakeAddress
         <*> pNetworkId
         <*> pMaybeOutputFile
 
     pQueryVersion :: Parser QueryCmd
     pQueryVersion = QueryVersion <$> parseNodeAddress
 
     pQueryLedgerState :: Parser QueryCmd
-    pQueryLedgerState = QueryLedgerState <$> pNetworkId <*> pMaybeOutputFile
+    pQueryLedgerState = QueryLedgerState <$> pProtocol <*> pNetworkId <*> pMaybeOutputFile
 
     pQueryStatus :: Parser QueryCmd
     pQueryStatus = QueryStatus <$> parseNodeAddress
@@ -1648,6 +1657,68 @@ pExtraEntropy =
     parseEntropyBytes =
       (fst . Base16.decode) <$> Atto.takeWhile1 Char.isHexDigit
 
+
+pProtocol :: Parser Protocol
+pProtocol =
+    (  Opt.flag' ()
+        (  Opt.long "shelley-mode"
+        <> Opt.help "For talking to a node running in Shelley-only mode (default)."
+        )
+    *> pShelley
+    )
+  <|>
+    (  Opt.flag' ()
+        (  Opt.long "byron-mode"
+        <> Opt.help "For talking to a node running in Byron-only mode."
+        )
+    *> pByron
+    )
+  <|>
+    (  Opt.flag' ()
+        (  Opt.long "cardano-mode"
+        <> Opt.help "For talking to a node running in full Cardano mode."
+        )
+    *> pCardano
+    )
+  <|>
+    -- Default to the Shelley protocol for now, due to the testnet.
+    pure ShelleyProtocol
+  where
+    pByron :: Parser Protocol
+    pByron = ByronProtocol <$> pEpochSlots <*> pSecurityParam
+
+    pShelley :: Parser Protocol
+    pShelley = pure ShelleyProtocol
+
+    pCardano :: Parser Protocol
+    pCardano = CardanoProtocol <$> pEpochSlots <*> pSecurityParam
+
+    pEpochSlots :: Parser EpochSlots
+    pEpochSlots =
+      EpochSlots <$>
+        ( Opt.option Opt.auto
+            (  Opt.long "epoch-slots"
+            <> Opt.metavar "NATURAL"
+            <> Opt.help "The number of slots per epoch (default is 21600)."
+            )
+        <|>
+          -- Default to the mainnet value.
+          pure 21600
+        )
+
+    pSecurityParam :: Parser SecurityParam
+    pSecurityParam =
+      SecurityParam <$>
+        ( Opt.option Opt.auto
+            (  Opt.long "security-param"
+            <> Opt.metavar "NATURAL"
+            <> Opt.help "The security parameter (default is 2160)."
+            )
+        <|>
+          -- Default to the mainnet value.
+          pure 2160
+        )
+
 pProtocolVersion :: Parser (Natural, Natural)
 pProtocolVersion =
     (,) <$> pProtocolMajorVersion <*> pProtocolMinorVersion