Merge #2978

2978: Refactor to decouple consensus modes r=jhartzell42 a=jhartzell42

    Refactor to decouple consensus modes
    
    - Functionality that handles Shelley-based eras in a multi-era consensus
      is moved to ouroboros-consensus-shelley so that it can be shared
      between mainnet consensus (in ouroboros-consensus-cardano) and other
      consensus modes comprising multiple Shelley eras.
    - The `Protocol` GADT that enumerates consensus modes and provides a
      wealth of information for clients is eliminated. It is an
      implementation detail only used by `cardano-node`. This way,
      `ouroboros-consensus-cardano` does not need to know about other
      consensus modes.


Co-authored-by: Jimmy Hartzell <jimmy.hartzell@obsidian.systems>

ouroboros-consensus-cardano-test/src/Test/ThreadNet/TxGen/Cardano.hs

@@ -49,8 +49,8 @@ import qualified Shelley.Spec.Ledger.UTxO as SL (makeWitnessVKey)
 
 import           Ouroboros.Consensus.Shelley.Ledger (GenTx, ShelleyBlock,
                      mkShelleyTx)
-import           Ouroboros.Consensus.Shelley.Ledger.Ledger
-                     (tickedShelleyLedgerState)
+import           Ouroboros.Consensus.Shelley.Ledger.Ledger (Ticked,
+                     tickedShelleyLedgerState)
 
 import           Ouroboros.Consensus.Cardano
 import           Ouroboros.Consensus.Cardano.Block (CardanoEras, GenTx (..),

ouroboros-consensus-cardano-test/test/Test/Consensus/Cardano/Serialisation.hs

@@ -12,11 +12,10 @@ import qualified Data.ByteString.Lazy as Lazy
 import           Ouroboros.Network.Block (Serialised (..))
 
 import           Ouroboros.Consensus.Block
+import           Ouroboros.Consensus.HardFork.Combinator.Block
 import           Ouroboros.Consensus.Storage.Serialisation
 import           Ouroboros.Consensus.Util (Dict (..))
 
-import           Ouroboros.Consensus.HardFork.Combinator (NestedCtxt_ (..))
-
 import           Ouroboros.Consensus.Byron.Ledger
 import           Ouroboros.Consensus.Byron.Node ()
 

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -28,7 +28,6 @@ library
                        Ouroboros.Consensus.Cardano
                        Ouroboros.Consensus.Cardano.Block
                        Ouroboros.Consensus.Cardano.ByronHFC
-                       Ouroboros.Consensus.Cardano.ShelleyHFC
                        Ouroboros.Consensus.Cardano.Condense
                        Ouroboros.Consensus.Cardano.CanHardFork
                        Ouroboros.Consensus.Cardano.Node

ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano.hs

@@ -1,8 +1,4 @@
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE KindSignatures      #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE DataKinds #-}
 
 module Ouroboros.Consensus.Cardano (
     -- * The block type of the Cardano block chain
@@ -17,47 +13,20 @@ module Ouroboros.Consensus.Cardano (
   , ProtocolParamsAllegra(..)
   , ProtocolParamsMary(..)
   , ProtocolParamsTransition(..)
-  , Protocol(..)
-  , verifyProtocol
-    -- * Data required to run a protocol
-  , protocolInfo
-    -- * Evidence that we can run all the supported protocols
-  , runProtocol
   , module X
-
-    -- * Client support for nodes running a protocol
-  , ProtocolClient(..)
-  , protocolClientInfo
-  , runProtocolClient
-  , verifyProtocolClient
   ) where
 
-import           Data.Kind (Type)
-import           Data.Type.Equality
-
-import           Cardano.Chain.Slotting (EpochSlots)
-
-import           Ouroboros.Consensus.Block
-import           Ouroboros.Consensus.Node.ProtocolInfo
-import           Ouroboros.Consensus.Node.Run
-import           Ouroboros.Consensus.Protocol.Abstract as X
-import           Ouroboros.Consensus.Protocol.PBFT as X
-import           Ouroboros.Consensus.Util
-import           Ouroboros.Consensus.Util.IOLike
-
 import           Ouroboros.Consensus.HardFork.Combinator
-import           Ouroboros.Consensus.HardFork.Combinator.Embed.Unary
 
 import           Ouroboros.Consensus.Byron.Ledger
 import           Ouroboros.Consensus.Byron.Node as X
 
 import           Ouroboros.Consensus.Shelley.Ledger
 import           Ouroboros.Consensus.Shelley.Node as X
+import           Ouroboros.Consensus.Shelley.ShelleyHFC
 
 import           Ouroboros.Consensus.Cardano.Block
-import           Ouroboros.Consensus.Cardano.ByronHFC
 import           Ouroboros.Consensus.Cardano.Node
-import           Ouroboros.Consensus.Cardano.ShelleyHFC
 
 {-------------------------------------------------------------------------------
   Supported protocols
@@ -69,143 +38,8 @@ import           Ouroboros.Consensus.Cardano.ShelleyHFC
 -------------------------------------------------------------------------------}
 
 type ProtocolByron   = HardForkProtocol '[ ByronBlock ]
-type ProtocolShelley = HardForkProtocol '[ ShelleyBlock StandardShelley ]
 type ProtocolCardano = HardForkProtocol '[ ByronBlock
                                          , ShelleyBlock StandardShelley
                                          , ShelleyBlock StandardAllegra
                                          , ShelleyBlock StandardMary
                                          ]
-
-{-------------------------------------------------------------------------------
-  Abstract over the various protocols
--------------------------------------------------------------------------------}
-
--- | Consensus protocol to use
-data Protocol (m :: Type -> Type) blk p where
-  -- | Run PBFT against the Byron ledger
-  ProtocolByron
-    :: ProtocolParamsByron
-    -> Protocol m ByronBlockHFC ProtocolByron
-
-  -- | Run TPraos against the Shelley ledger
-  ProtocolShelley
-    :: ProtocolParamsShelleyBased StandardShelley
-    -> ProtocolParamsShelley
-    -> Protocol m (ShelleyBlockHFC StandardShelley) ProtocolShelley
-
-  -- | Run the protocols of /the/ Cardano block
-  --
-  -- WARNING: only a single set of Shelley credentials is allowed when used for
-  -- mainnet. Testnets allow multiple Shelley credentials.
-  ProtocolCardano
-    :: ProtocolParamsByron
-    -> ProtocolParamsShelleyBased StandardShelley
-    -> ProtocolParamsShelley
-    -> ProtocolParamsAllegra
-    -> ProtocolParamsMary
-    -> ProtocolParamsTransition
-         ByronBlock
-         (ShelleyBlock StandardShelley)
-    -> ProtocolParamsTransition
-         (ShelleyBlock StandardShelley)
-         (ShelleyBlock StandardAllegra)
-    -> ProtocolParamsTransition
-         (ShelleyBlock StandardAllegra)
-         (ShelleyBlock StandardMary)
-    -> Protocol m (CardanoBlock StandardCrypto) ProtocolCardano
-
-verifyProtocol :: Protocol m blk p -> (p :~: BlockProtocol blk)
-verifyProtocol ProtocolByron{}   = Refl
-verifyProtocol ProtocolShelley{} = Refl
-verifyProtocol ProtocolCardano{} = Refl
-
-{-------------------------------------------------------------------------------
-  Data required to run a protocol
--------------------------------------------------------------------------------}
-
--- | Data required to run the selected protocol
-protocolInfo :: forall m blk p. IOLike m
-             => Protocol m blk p -> ProtocolInfo m blk
-protocolInfo (ProtocolByron params) =
-    inject $ protocolInfoByron params
-
-protocolInfo (ProtocolShelley paramsShelleyBased paramsShelley) =
-    inject $ protocolInfoShelley paramsShelleyBased paramsShelley
-
-protocolInfo (ProtocolCardano
-               paramsByron
-               paramsShelleyBased
-               paramsShelley
-               paramsAllegra
-               paramsMary
-               paramsByronShelley
-               paramsShelleyAllegra
-               paramsAllegraMary) =
-    protocolInfoCardano
-      paramsByron
-      paramsShelleyBased
-      paramsShelley
-      paramsAllegra
-      paramsMary
-      paramsByronShelley
-      paramsShelleyAllegra
-      paramsAllegraMary
-
-{-------------------------------------------------------------------------------
-  Evidence that we can run all the supported protocols
--------------------------------------------------------------------------------}
-
-runProtocol :: Protocol m blk p -> Dict (RunNode blk)
-runProtocol ProtocolByron{}   = Dict
-runProtocol ProtocolShelley{} = Dict
-runProtocol ProtocolCardano{} = Dict
-
-{-------------------------------------------------------------------------------
-  Client support for the protocols: what you need as a client of the node
--------------------------------------------------------------------------------}
-
--- | Node client support for each consensus protocol.
---
--- This is like 'Protocol' but for clients of the node, so with less onerous
--- requirements than to run a node.
---
-data ProtocolClient blk p where
-  ProtocolClientByron
-    :: EpochSlots
-    -> ProtocolClient
-         ByronBlockHFC
-         ProtocolByron
-
-  ProtocolClientShelley
-    :: ProtocolClient
-         (ShelleyBlockHFC StandardShelley)
-         ProtocolShelley
-
-  ProtocolClientCardano
-    :: EpochSlots
-    -> ProtocolClient
-         (CardanoBlock StandardCrypto)
-         ProtocolCardano
-
--- | Sanity check that we have the right type combinations
-verifyProtocolClient :: ProtocolClient blk p -> (p :~: BlockProtocol blk)
-verifyProtocolClient ProtocolClientByron{}   = Refl
-verifyProtocolClient ProtocolClientShelley{} = Refl
-verifyProtocolClient ProtocolClientCardano{} = Refl
-
--- | Sanity check that we have the right class instances available
-runProtocolClient :: ProtocolClient blk p -> Dict (RunNode blk)
-runProtocolClient ProtocolClientByron{}   = Dict
-runProtocolClient ProtocolClientShelley{} = Dict
-runProtocolClient ProtocolClientCardano{} = Dict
-
--- | Data required by clients of a node running the specified protocol.
-protocolClientInfo :: ProtocolClient blk p -> ProtocolClientInfo blk
-protocolClientInfo (ProtocolClientByron epochSlots) =
-    inject $ protocolClientInfoByron epochSlots
-
-protocolClientInfo ProtocolClientShelley =
-    inject $ protocolClientInfoShelley
-
-protocolClientInfo (ProtocolClientCardano epochSlots) =
-    protocolClientInfoCardano epochSlots