Merge pull request IntersectMBO#5518 from input-output-hk/newhoggy/remove-ByronMode-and-ShelleyMode-support

newhoggy · web-flow · commit e88d5af28a36 · 2023-11-03T10:08:08.000Z
Remove `ByronMode` and `ShelleyMode` support
diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs
@@ -40,19 +40,17 @@ getGenesis (SomeConsensusProtocol CardanoBlockType proto)
 
 -- | extract the path to genesis file from a NodeConfiguration for Cardano protocol
 getGenesisPath :: NodeConfiguration -> Maybe GenesisFile
-getGenesisPath nodeConfig
- = case ncProtocolConfig nodeConfig of
-   NodeProtocolConfigurationCardano _ shelleyConfig _ _ _ -> Just $ npcShelleyGenesisFile shelleyConfig
-   _ -> Nothing
+getGenesisPath nodeConfig =
+  case ncProtocolConfig nodeConfig of
+    NodeProtocolConfigurationCardano _ shelleyConfig _ _ _ ->
+      Just $ npcShelleyGenesisFile shelleyConfig
 
 mkConsensusProtocol :: NodeConfiguration -> IO (Either TxGenError SomeConsensusProtocol)
-mkConsensusProtocol nodeConfig
-  = case ncProtocolConfig nodeConfig of
-    NodeProtocolConfigurationByron _    -> pure $ Left $ TxGenError "NodeProtocolConfigurationByron not supported"
-    NodeProtocolConfigurationShelley _  -> pure $ Left $ TxGenError "NodeProtocolConfigurationShelley not supported"
-    NodeProtocolConfigurationCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig
-        -> first ProtocolError
-            <$> runExceptT (mkSomeConsensusProtocolCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig Nothing)
+mkConsensusProtocol nodeConfig =
+  case ncProtocolConfig nodeConfig of
+    NodeProtocolConfigurationCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig ->
+      first ProtocolError
+        <$> runExceptT (mkSomeConsensusProtocolCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig Nothing)
 
 -- | Creates a NodeConfiguration from a config file;
 --   the result is devoid of any keys/credentials
diff --git a/cardano-node-chairman/app/Cardano/Chairman.hs b/cardano-node-chairman/app/Cardano/Chairman.hs
@@ -35,7 +35,6 @@ import qualified Ouroboros.Network.Block as Block
 import           Ouroboros.Network.Protocol.ChainSync.Client
 
 import           Cardano.Api
-import           Cardano.Api.Byron
 import           Cardano.Api.Shelley
 
 -- | The chairman checks for consensus and progress.
@@ -51,17 +50,16 @@ import           Cardano.Api.Shelley
 -- The consensus condition is checked incrementally as well as at the end, so
 -- that failures can be detected as early as possible. The progress condition
 -- is only checked at the end.
-chairmanTest
-  :: Tracer IO String
+chairmanTest :: ()
+  => Tracer IO String
   -> NetworkId
   -> DiffTime
   -> BlockNo
   -> [SocketPath]
-  -> AnyConsensusModeParams
+  -> ConsensusModeParams CardanoMode
   -> SecurityParam
   -> IO ()
-chairmanTest tracer nw runningTime progressThreshold socketPaths
-             (AnyConsensusModeParams cModeParams) secParam = do
+chairmanTest tracer nw runningTime progressThreshold socketPaths cModeParams secParam = do
   traceWith tracer ("Will observe nodes for " ++ show runningTime)
   traceWith tracer ("Will require chain growth of " ++ show progressThreshold)
 
@@ -110,11 +108,11 @@ instance Exception ConsensusFailure where
 -- | For this test we define consensus as follows: for all pairs of chains,
 -- the intersection of each pair is within K blocks of each tip.
 
-consensusCondition
-  :: ConsensusBlockForMode mode ~ blk
+consensusCondition :: ()
+  => ConsensusBlockForMode CardanoMode ~ blk
   => HasHeader (Header blk)
   => ConvertRawHash blk
-  => ConsensusMode mode
+  => ConsensusMode CardanoMode
   -> Map PeerId (AnchoredFragment (Header blk))
   -> SecurityParam
   -> Either ConsensusFailure ConsensusSuccess
@@ -246,9 +244,9 @@ progressCondition minBlockNo (ConsensusSuccess _ tips) = do
    getBlockNo (ChainTip _ _ bNum) = bNum
    getBlockNo ChainTipAtGenesis = 0
 
-runChairman
-  :: forall mode blk. ConsensusBlockForMode mode ~ blk
-  => GetHeader (ConsensusBlockForMode mode)
+runChairman :: forall blk. ()
+  => ConsensusBlockForMode CardanoMode ~ blk
+  => GetHeader (ConsensusBlockForMode CardanoMode)
   => Tracer IO String
   -> NetworkId
   -- ^ Security parameter, if a fork is deeper than it 'runChairman'
@@ -257,7 +255,7 @@ runChairman
   -- ^ Run for this much time.
   -> [SocketPath]
   -- ^ Local socket directory
-  -> ConsensusModeParams mode
+  -> ConsensusModeParams CardanoMode
   -> SecurityParam
   -> IO (Map SocketPath
              (AF.AnchoredSeq
@@ -312,41 +310,41 @@ addBlock sockPath chainsVar blk =
 
 -- | Rollback a single block.  If the rollback point is not found, we simply
 -- error.  It should never happen if the security parameter is set up correctly.
-rollback
-  :: forall mode blk. ConsensusBlockForMode mode ~ blk
+rollback :: forall blk. ()
+  => ConsensusBlockForMode CardanoMode ~ blk
   => HasHeader (Header blk)
   => SocketPath
-  -> StrictTVar IO (Map SocketPath (AnchoredFragment (Header (ConsensusBlockForMode mode))))
-  -> ConsensusMode mode
+  -> StrictTVar IO (Map SocketPath (AnchoredFragment (Header (ConsensusBlockForMode CardanoMode))))
+  -> ConsensusMode CardanoMode
   -> ChainPoint
   -> STM IO ()
 rollback sockPath chainsVar cMode p =
   modifyTVar chainsVar (Map.adjust fn sockPath)
   where
-    p' :: Point (Header (ConsensusBlockForMode mode))
+    p' :: Point (Header (ConsensusBlockForMode CardanoMode))
     p' = coerce $ toConsensusPointInMode cMode p
 
-    fn :: AnchoredFragment (Header (ConsensusBlockForMode mode))
-       -> AnchoredFragment (Header (ConsensusBlockForMode mode))
+    fn :: AnchoredFragment (Header (ConsensusBlockForMode CardanoMode))
+       -> AnchoredFragment (Header (ConsensusBlockForMode CardanoMode))
     fn cf = case AF.rollback p' cf of
       Nothing  -> error "rollback error: rollback beyond chain fragment"
       Just cf' -> cf'
 
 -- Chain-Sync client
 type ChairmanTrace' = ConsensusSuccess
 
-type ChainVar mode = StrictTVar IO (Map SocketPath (AnchoredFragment (Header (ConsensusBlockForMode mode))))
+type ChainVar = StrictTVar IO (Map SocketPath (AnchoredFragment (Header (ConsensusBlockForMode CardanoMode))))
 
 -- | 'chainSyncClient which build chain fragment; on every roll forward it will
 -- check if there is consensus on immutable chain.
 chainSyncClient
-  :: forall mode. GetHeader (ConsensusBlockForMode mode)
+  :: GetHeader (ConsensusBlockForMode CardanoMode)
   => Tracer IO ChairmanTrace'
   -> SocketPath
-  -> ChainVar mode
-  -> ConsensusModeParams mode
+  -> ChainVar
+  -> ConsensusModeParams CardanoMode
   -> SecurityParam
-  -> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
+  -> ChainSyncClient (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
 chainSyncClient tracer sockPath chainsVar cModeP secParam = ChainSyncClient $ pure $
   -- Notify the core node about the our latest points at which we are
   -- synchronised.  This client is not persistent and thus it just
@@ -359,10 +357,10 @@ chainSyncClient tracer sockPath chainsVar cModeP secParam = ChainSyncClient $ pu
     , recvMsgIntersectNotFound = \  _ -> ChainSyncClient $ pure clientStIdle
     }
   where
-    clientStIdle :: ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
+    clientStIdle :: ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
     clientStIdle = SendMsgRequestNext clientStNext (pure clientStNext)
 
-    clientStNext :: ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
+    clientStNext :: ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
     clientStNext = ClientStNext
       { recvMsgRollForward = \blk _tip -> ChainSyncClient $ do
           -- add block & check if there is consensus on immutable chain
@@ -384,33 +382,27 @@ chainSyncClient tracer sockPath chainsVar cModeP secParam = ChainSyncClient $ pu
 -- Helpers
 
 obtainHasHeader
-  :: ConsensusBlockForMode mode ~ blk
-  => ConsensusMode mode
-  -> ((HasHeader (Header blk), ConvertRawHash (ConsensusBlockForMode mode)) => a)
+  :: ConsensusBlockForMode CardanoMode ~ blk
+  => ConsensusMode CardanoMode
+  -> ((HasHeader (Header blk), ConvertRawHash (ConsensusBlockForMode CardanoMode)) => a)
   -> a
-obtainHasHeader ByronMode f = f
-obtainHasHeader ShelleyMode f = f
 obtainHasHeader CardanoMode f = f
 
 obtainGetHeader
-  :: ConsensusMode mode
-  -> ( (GetHeader (ConsensusBlockForMode mode)
+  :: ConsensusMode CardanoMode
+  -> ( (GetHeader (ConsensusBlockForMode CardanoMode)
        ) => a)
   -> a
-obtainGetHeader ByronMode f = f
-obtainGetHeader ShelleyMode f = f
 obtainGetHeader CardanoMode f = f
 
 -- | Check that all nodes agree with each other, within the security parameter.
 checkConsensus
-  :: HasHeader (Header (ConsensusBlockForMode mode))
-  => ConvertRawHash (ConsensusBlockForMode mode)
-  => ConsensusMode mode
-  -> ChainVar mode
+  :: HasHeader (Header (ConsensusBlockForMode CardanoMode))
+  => ConvertRawHash (ConsensusBlockForMode CardanoMode)
+  => ConsensusMode CardanoMode
+  -> ChainVar
   -> SecurityParam
   -> STM IO ConsensusSuccess
 checkConsensus cMode chainsVar secParam = do
   chainsSnapshot <- readTVar chainsVar
   either throwIO return $ consensusCondition cMode  chainsSnapshot secParam
-
-
diff --git a/cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs b/cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs
@@ -139,15 +139,11 @@ run RunOpts
 
   return ()
  where
-  getConsensusMode :: SecurityParam -> NodeProtocolConfiguration -> AnyConsensusModeParams
+  getConsensusMode :: SecurityParam -> NodeProtocolConfiguration -> ConsensusModeParams CardanoMode
   getConsensusMode (SecurityParam k) ncProtocolConfig =
     case ncProtocolConfig of
-      NodeProtocolConfigurationByron{} ->
-        AnyConsensusModeParams $ ByronModeParams $ EpochSlots k
-      NodeProtocolConfigurationShelley{} ->
-        AnyConsensusModeParams ShelleyModeParams
       NodeProtocolConfigurationCardano{} ->
-        AnyConsensusModeParams $ CardanoModeParams $ EpochSlots k
+        CardanoModeParams $ EpochSlots k
 
   getProtocolConfiguration
     :: PartialNodeConfiguration
diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal
@@ -238,6 +238,7 @@ test-suite cardano-node-test
                       , aeson
                       , bytestring
                       , cardano-crypto-class
+                      , cardano-crypto-wrapper
                       , cardano-api
                       , cardano-ledger-core
                       , cardano-node
diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs
@@ -257,21 +257,17 @@ instance FromJSON PartialNodeConfiguration where
                              else return $ Last $ Just PartialTracingOff
 
       -- Protocol parameters
-      protocol <-  v .:? "Protocol" .!= ByronProtocol
+      protocol <-  v .:? "Protocol" .!= CardanoProtocol
       pncProtocolConfig <-
         case protocol of
-          ByronProtocol ->
-            Last . Just . NodeProtocolConfigurationByron <$> parseByronProtocol v
-
-          ShelleyProtocol ->
-            Last . Just . NodeProtocolConfigurationShelley <$> parseShelleyProtocol v
-
           CardanoProtocol ->
-            Last . Just  <$> (NodeProtocolConfigurationCardano <$> parseByronProtocol v
-                                                               <*> parseShelleyProtocol v
-                                                               <*> parseAlonzoProtocol v
-                                                               <*> parseConwayProtocol v
-                                                               <*> parseHardForkProtocol v)
+            fmap (Last . Just) $
+              NodeProtocolConfigurationCardano
+                <$> parseByronProtocol v
+                <*> parseShelleyProtocol v
+                <*> parseAlonzoProtocol v
+                <*> parseConwayProtocol v
+                <*> parseHardForkProtocol v
       pncMaybeMempoolCapacityOverride <- Last <$> parseMempoolCapacityBytesOverride v
 
       -- Network timeouts
@@ -619,16 +615,14 @@ makeNodeConfiguration pnc = do
 ncProtocol :: NodeConfiguration -> Protocol
 ncProtocol nc =
   case ncProtocolConfig nc of
-    NodeProtocolConfigurationByron{}   -> ByronProtocol
-    NodeProtocolConfigurationShelley{} -> ShelleyProtocol
+    -- NodeProtocolConfigurationByron{}   -> ByronProtocol -- jky delete me
+    -- NodeProtocolConfigurationShelley{} -> ShelleyProtocol -- jky delete me
     NodeProtocolConfigurationCardano{} -> CardanoProtocol
 
 pncProtocol :: PartialNodeConfiguration -> Either Text Protocol
 pncProtocol pnc =
   case pncProtocolConfig pnc of
     Last Nothing -> Left "Node protocol configuration not found"
-    Last (Just NodeProtocolConfigurationByron{})   -> Right ByronProtocol
-    Last (Just NodeProtocolConfigurationShelley{}) -> Right ShelleyProtocol
     Last (Just NodeProtocolConfigurationCardano{}) -> Right CardanoProtocol
 
 parseNodeConfigurationFP :: Maybe ConfigYamlFilePath -> IO PartialNodeConfiguration
diff --git a/cardano-node/src/Cardano/Node/Protocol.hs b/cardano-node/src/Cardano/Node/Protocol.hs
@@ -27,29 +27,21 @@ mkConsensusProtocol
   -> Maybe ProtocolFilepaths
   -> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
 mkConsensusProtocol ncProtocolConfig mProtocolFiles =
-    case ncProtocolConfig of
-
-      NodeProtocolConfigurationByron config ->
-        firstExceptT ByronProtocolInstantiationError $
-          mkSomeConsensusProtocolByron config mProtocolFiles
-
-      NodeProtocolConfigurationShelley config ->
-        firstExceptT ShelleyProtocolInstantiationError $
-          mkSomeConsensusProtocolShelley config mProtocolFiles
-
-      NodeProtocolConfigurationCardano byronConfig
-                                       shelleyConfig
-                                       alonzoConfig
-                                       conwayConfig
-                                       hardForkConfig ->
-        firstExceptT CardanoProtocolInstantiationError $
-          mkSomeConsensusProtocolCardano
-            byronConfig
-            shelleyConfig
-            alonzoConfig
-            conwayConfig
-            hardForkConfig
-            mProtocolFiles
+  case ncProtocolConfig of
+    NodeProtocolConfigurationCardano
+        byronConfig
+        shelleyConfig
+        alonzoConfig
+        conwayConfig
+        hardForkConfig ->
+      firstExceptT CardanoProtocolInstantiationError $
+        mkSomeConsensusProtocolCardano
+          byronConfig
+          shelleyConfig
+          alonzoConfig
+          conwayConfig
+          hardForkConfig
+          mProtocolFiles
 
 ------------------------------------------------------------------------------
 -- Errors
diff --git a/cardano-node/src/Cardano/Node/Protocol/Types.hs b/cardano-node/src/Cardano/Node/Protocol/Types.hs
@@ -24,14 +24,10 @@ import           GHC.Generics (Generic)
 import           NoThunks.Class (NoThunks)
 
 
-data Protocol = ByronProtocol
-              | ShelleyProtocol
-              | CardanoProtocol
+data Protocol = CardanoProtocol
   deriving (Eq, Generic)
 
 instance Show Protocol where
-  show ByronProtocol = "Byron"
-  show ShelleyProtocol = "Shelley"
   show CardanoProtocol = "Byron; Shelley"
 
 deriving instance NFData Protocol
@@ -40,18 +36,8 @@ deriving instance NoThunks Protocol
 instance FromJSON Protocol where
   parseJSON =
     withText "Protocol" $ \str -> case str of
-
-      -- The new names
-      "Byron" -> pure ByronProtocol
-      "Shelley" -> pure ShelleyProtocol
       "Cardano" -> pure CardanoProtocol
-
-      -- The old names
-      "RealPBFT" -> pure ByronProtocol
-      "TPraos" -> pure ShelleyProtocol
-
-      _ -> fail $ "Parsing of Protocol failed. "
-                <> show str <> " is not a valid protocol"
+      _ -> fail $ "Parsing of Protocol failed. " <> show str <> " is not a valid protocol"
 
 data SomeConsensusProtocol where
 
diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs
diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs
diff --git a/cardano-testnet/src/Testnet/Runtime.hs b/cardano-testnet/src/Testnet/Runtime.hs
