WIP: Utilize Protocol data type

cardano-api/cardano-api.cabal

@@ -16,6 +16,7 @@ library
 
   exposed-modules:      Cardano.Api
                         Cardano.Api.Protocol
+                        Cardano.Api.Protocol.Orphans
                         Cardano.Api.Protocol.Types
                         Cardano.Api.Protocol.Byron
                         Cardano.Api.Protocol.Cardano

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

@@ -13,7 +13,7 @@ import           Data.Aeson (ToJSON (..))
 
 import           Control.Concurrent.STM
 
-import           Cardano.Api.Protocol (ProtocolData (..))
+import           Cardano.Api.Protocol (Protocol (..))
 import           Cardano.Api.Protocol.Byron (mkNodeClientProtocolByron)
 import           Cardano.Api.Protocol.Cardano (mkNodeClientProtocolCardano)
 import           Cardano.Api.Protocol.Shelley (mkNodeClientProtocolShelley)
@@ -51,22 +51,24 @@ instance ToJSON LocalTip where
 getLocalTip
   :: FilePath
   -> NetworkId
-  -> ProtocolData
+  -> Protocol
   -> IO LocalTip
-getLocalTip sockPath nw protocolData =
-  case protocolData of
-    ProtocolDataByron epSlots secParam ->
+getLocalTip sockPath nw protocol =
+  case protocol of
+    ByronProtocol epSlots secParam ->
       let ptcl = mkNodeClientProtocolByron epSlots secParam
       in ByronLocalTip <$> getLocalTip' sockPath nw ptcl
 
-    ProtocolDataShelley ->
+    ShelleyProtocol ->
       let ptcl = mkNodeClientProtocolShelley
       in ShelleyLocalTip <$> getLocalTip' sockPath nw ptcl
 
-    ProtocolDataCardano epSlots secParam ->
+    CardanoProtocol epSlots secParam ->
       let ptcl = mkNodeClientProtocolCardano epSlots secParam
       in CardanoLocalTip <$> getLocalTip' sockPath nw ptcl
 
+    p -> panic $ "TODO: Unsupported protocol: " <> show p
+
 -- | Get the node's tip using the local chain sync protocol.
 --
 -- This is an alternative version of the 'getLocalTip' function that instead

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

@@ -21,54 +21,26 @@ module Cardano.Api.Protocol
     -- a protocol.
   , mkNodeClientProtocol
   , SomeNodeClientProtocol(..)
-
-    -- TODO: Does this really belong here?
-  , ProtocolData(..)
   ) 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.Orphans ()
 import           Cardano.Api.Protocol.Shelley
 
 import qualified Ouroboros.Consensus.Cardano as Consensus
 
 data Protocol = MockProtocol !MockProtocol
-              | ByronProtocol
+              | ByronProtocol !EpochSlots !Consensus.SecurityParam
               | ShelleyProtocol
-              | CardanoProtocol
+              | CardanoProtocol !EpochSlots !Consensus.SecurityParam
   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
 
@@ -96,33 +68,11 @@ 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 ->
+        mkSomeNodeClientProtocolByron 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)
-
-data ProtocolData
-  = ProtocolDataByron !EpochSlots !Consensus.SecurityParam
-  | ProtocolDataShelley
-  | ProtocolDataCardano !EpochSlots !Consensus.SecurityParam
-  deriving (Eq, Show)
+      CardanoProtocol epSlots secParam ->
+        mkSomeNodeClientProtocolCardano epSlots secParam

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

@@ -0,0 +1,15 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Cardano.Api.Protocol.Orphans () where
+
+import           Cardano.Prelude
+
+import           Cardano.Chain.Slotting (EpochSlots (..))
+
+import           Ouroboros.Consensus.Cardano (SecurityParam (..))
+
+deriving instance NFData EpochSlots
+deriving instance NFData SecurityParam

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

@@ -18,7 +18,7 @@ import           Cardano.Prelude
 import           Control.Tracer
 import           Control.Concurrent.STM
 
-import           Cardano.Api.Protocol (ProtocolData (..))
+import           Cardano.Api.Protocol (Protocol (..))
 import           Cardano.Api.Protocol.Cardano (mkNodeClientProtocolCardano)
 import           Cardano.Api.Types
 import           Cardano.Api.TxSubmit.ErrorRender (renderApplyMempoolPayloadErr)
@@ -57,7 +57,7 @@ data TxSubmitResult
    | TxSubmitFailureByron   !(ApplyTxErr ByronBlock)
    | TxSubmitFailureShelley !(ApplyTxErr (ShelleyBlock TPraosStandardCrypto))
    | TxSubmitFailureCardano !(ApplyTxErr (CardanoBlock TPraosStandardCrypto))
-   | TxSubmitFailureProtocolAndTxMismatch !ProtocolData !TxSigned
+   | TxSubmitFailureProtocolAndTxMismatch !Protocol !TxSigned
    deriving Show
 
 renderTxSubmitResult :: TxSubmitResult -> Text
@@ -76,18 +76,18 @@ renderTxSubmitResult res =
 
 submitTx
   :: Network
-  -> ProtocolData
+  -> Protocol
   -> SocketPath
   -> TxSigned
   -> IO TxSubmitResult
-submitTx network protocolData socketPath tx =
+submitTx network protocol socketPath tx =
     NtC.withIOManager $ \iocp ->
       case tx of
         TxSignedByron txbody _txCbor _txHash vwit -> do
           let aTxAux = Byron.annotateTxAux (Byron.mkTxAux txbody vwit)
               genTx  = Byron.ByronTx (Byron.byronIdTx aTxAux) aTxAux
-          case protocolData of
-            ProtocolDataByron epSlots secParam -> do
+          case protocol of
+            ByronProtocol epSlots secParam -> do
               result <- submitGenTx
                           nullTracer
                           iocp
@@ -101,7 +101,7 @@ submitTx network protocolData socketPath tx =
                 SubmitSuccess  -> return TxSubmitSuccess
                 SubmitFail err -> return (TxSubmitFailureByron err)
 
-            ProtocolDataCardano epSlots secParam -> do
+            CardanoProtocol epSlots secParam -> do
               result <- submitGenTx
                           nullTracer
                           iocp
@@ -115,12 +115,12 @@ submitTx network protocolData socketPath tx =
                 SubmitSuccess -> return TxSubmitSuccess
                 SubmitFail err -> return (TxSubmitFailureCardano err)
 
-            _ -> return (TxSubmitFailureProtocolAndTxMismatch protocolData tx)
+            _ -> return (TxSubmitFailureProtocolAndTxMismatch protocol tx)
 
         TxSignedShelley stx -> do
           let genTx = mkShelleyTx stx
-          case protocolData of
-            ProtocolDataShelley -> do
+          case protocol of
+            ShelleyProtocol -> do
               result <- submitGenTx
                           nullTracer
                           iocp
@@ -132,7 +132,7 @@ submitTx network protocolData socketPath tx =
                 SubmitSuccess  -> return TxSubmitSuccess
                 SubmitFail err -> return (TxSubmitFailureShelley err)
 
-            ProtocolDataCardano epSlots secParam -> do
+            CardanoProtocol epSlots secParam -> do
               result <- submitGenTx
                           nullTracer
                           iocp
@@ -146,7 +146,7 @@ submitTx network protocolData socketPath tx =
                 SubmitSuccess -> return TxSubmitSuccess
                 SubmitFail err -> return (TxSubmitFailureCardano err)
 
-            _ -> return (TxSubmitFailureProtocolAndTxMismatch protocolData tx)
+            _ -> return (TxSubmitFailureProtocolAndTxMismatch protocol tx)
 
 submitGenTx
   :: forall blk.

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

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

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

@@ -41,7 +41,7 @@ import qualified Shelley.Spec.Ledger.BaseTypes as Shelley
 import qualified Shelley.Spec.Ledger.TxData as Shelley
 
 import qualified Cardano.Api as OldApi
-import           Cardano.Api.Protocol (ProtocolData (..))
+import           Cardano.Api.Protocol (Protocol (..))
 import           Cardano.Api.Typed hiding (PoolId)
 
 import           Cardano.Slotting.Slot (EpochNo (..))
@@ -322,7 +322,7 @@ pTransaction =
     pTransactionSubmit  :: Parser TransactionCmd
     pTransactionSubmit = TxSubmit <$> pTxSubmitFile
                                   <*> pNetwork
-                                  <*> pProtocolData
+                                  <*> pProtocol
 
     pTransactionCalculateMinFee :: Parser TransactionCmd
     pTransactionCalculateMinFee =
@@ -458,41 +458,41 @@ pQueryCmd =
     pQueryProtocolParameters :: Parser QueryCmd
     pQueryProtocolParameters =
       QueryProtocolParameters
-        <$> pProtocolData
+        <$> pProtocol
         <*> pNetworkId
         <*> pMaybeOutputFile
 
     pQueryTip :: Parser QueryCmd
-    pQueryTip = QueryTip <$> pProtocolData <*> pNetworkId <*> pMaybeOutputFile
+    pQueryTip = QueryTip <$> pProtocol <*> pNetworkId <*> pMaybeOutputFile
 
     pQueryUTxO :: Parser QueryCmd
     pQueryUTxO =
       QueryUTxO
         <$> pQueryFilter
-        <*> pProtocolData
+        <*> pProtocol
         <*> pNetworkId
         <*> pMaybeOutputFile
 
     pQueryStakeDistribution :: Parser QueryCmd
     pQueryStakeDistribution =
       QueryStakeDistribution
-        <$> pProtocolData
+        <$> pProtocol
         <*> pNetworkId
         <*> pMaybeOutputFile
 
     pQueryStakeAddressInfo :: Parser QueryCmd
     pQueryStakeAddressInfo =
       QueryStakeAddressInfo
         <$> pFilterByStakeAddress
-        <*> pProtocolData
+        <*> pProtocol
         <*> pNetworkId
         <*> pMaybeOutputFile
 
     pQueryVersion :: Parser QueryCmd
     pQueryVersion = QueryVersion <$> parseNodeAddress
 
     pQueryLedgerState :: Parser QueryCmd
-    pQueryLedgerState = QueryLedgerState <$> pProtocolData <*> pNetworkId <*> pMaybeOutputFile
+    pQueryLedgerState = QueryLedgerState <$> pProtocol <*> pNetworkId <*> pMaybeOutputFile
 
     pQueryStatus :: Parser QueryCmd
     pQueryStatus = QueryStatus <$> parseNodeAddress
@@ -1065,11 +1065,11 @@ pITNVerificationKeyFile =
       <> Opt.completer (Opt.bashCompleter "file")
       )
 
-pProtocolData :: Parser ProtocolData
-pProtocolData = pProtocolData'
+pProtocol :: Parser Protocol
+pProtocol = pProtocol'
   where
-    pProtocolData' :: Parser ProtocolData
-    pProtocolData' =
+    pProtocol' :: Parser Protocol
+    pProtocol' =
         (  Opt.flag' ()
             (  Opt.long "shelley"
             <> Opt.help "Use the Shelley protocol (default)."
@@ -1091,16 +1091,17 @@ pProtocolData = pProtocolData'
         *> pCardano
         )
       <|>
-        pure ProtocolDataShelley
+        -- Default to the Shelley protocol.
+        pure ShelleyProtocol
 
-    pByron :: Parser ProtocolData
-    pByron = ProtocolDataByron <$> pEpochSlots <*> pSecurityParam
+    pByron :: Parser Protocol
+    pByron = ByronProtocol <$> pEpochSlots <*> pSecurityParam
 
-    pShelley :: Parser ProtocolData
-    pShelley = pure ProtocolDataShelley
+    pShelley :: Parser Protocol
+    pShelley = pure ShelleyProtocol
 
-    pCardano :: Parser ProtocolData
-    pCardano = ProtocolDataCardano <$> pEpochSlots <*> pSecurityParam
+    pCardano :: Parser Protocol
+    pCardano = CardanoProtocol <$> pEpochSlots <*> pSecurityParam
 
     pEpochSlots :: Parser EpochSlots
     pEpochSlots =