Use a single set of credentials for all Shelley-based eras

For each era, there will be a thread periodically trying to evolve the KES key
and securely forget the previous one.

Previously, we required a set of credentials for each Shelley-based era, e.g.,
Shelley, Allegra, and Mary. In practice, most users will want to use the same
credentials for, e.g., Shelley and Allegra. However, when using the same
in-memory KES key for multiple eras, multiple threads will try to evolve and
secure forget the *same KES key*. Depending on the implementation of secure
forgetting for KES keys, this could lead to segfaults.

Instead of having a separate set of credentials per Shelley-based era (this
remains independent of how Byron credentials are handled), we now share a single
set of credentials for all of them. We use the new `shelleySharedBlockForging`
function to do this in a safe way, i.e., by sharing the same thread-safe
`HotKey` across the threads.

We refactor the protocol parameters for Shelley/Allegra/Mary to handle the
shared key: we now have a `ProtocolParamsShelleyBased` record which contains
everything needed for a Shelley-based chain, i.e., the genesis config and the
credentials. This record should be combined with the right era-specific ones.
This also paves the way for adding a Mary-only mode.

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

@@ -751,26 +751,26 @@ mkProtocolCardanoAndHardForkTxs
           , byronSoftwareVersion        = softVerByron
           , byronLeaderCredentials      = Just leaderCredentialsByron
           }
+        ProtocolParamsShelleyBased {
+            shelleyBasedGenesis           = genesisShelley
+          , shelleyBasedInitialNonce      = initialNonce
+          , shelleyBasedLeaderCredentials = Just leaderCredentialsShelley
+          }
         ProtocolParamsShelley {
-            shelleyGenesis           = genesisShelley
-          , shelleyInitialNonce      = initialNonce
-          , shelleyProtVer           = SL.ProtVer shelleyMajorVersion 0
-          , shelleyLeaderCredentials = Just leaderCredentialsShelley
+            shelleyProtVer = SL.ProtVer shelleyMajorVersion 0
           }
         ProtocolParamsAllegra {
-            allegraProtVer           = SL.ProtVer allegraMajorVersion 0
-          , allegraLeaderCredentials = Nothing
+            allegraProtVer = SL.ProtVer allegraMajorVersion 0
           }
         ProtocolParamsMary {
-            maryProtVer           = SL.ProtVer maryMajorVersion 0
-          , maryLeaderCredentials = Nothing
+            maryProtVer    = SL.ProtVer maryMajorVersion    0
           }
         protocolParamsByronShelley
         ProtocolParamsTransition {
-            transitionTrigger    = TriggerHardForkAtVersion allegraMajorVersion
+            transitionTrigger = TriggerHardForkAtVersion allegraMajorVersion
           }
         ProtocolParamsTransition {
-            transitionTrigger    = TriggerHardForkAtVersion maryMajorVersion
+            transitionTrigger = TriggerHardForkAtVersion maryMajorVersion
           }
 
     -- Byron

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

@@ -89,15 +89,17 @@ data Protocol (m :: Type -> Type) blk p where
 
   -- | Run TPraos against the real Shelley ledger
   ProtocolShelley
-    :: ProtocolParamsShelley StandardCrypto []
+    :: ProtocolParamsShelleyBased StandardShelley []
+    -> ProtocolParamsShelley
     -> Protocol m (ShelleyBlockHFC StandardShelley) ProtocolShelley
 
   -- | Run the protocols of /the/ Cardano block
   ProtocolCardano
     :: ProtocolParamsByron
-    -> ProtocolParamsShelley StandardCrypto Maybe
-    -> ProtocolParamsAllegra StandardCrypto Maybe
-    -> ProtocolParamsMary    StandardCrypto Maybe
+    -> ProtocolParamsShelleyBased StandardShelley Maybe
+    -> ProtocolParamsShelley
+    -> ProtocolParamsAllegra
+    -> ProtocolParamsMary
     -> ProtocolParamsTransition
          ByronBlock
          (ShelleyBlock StandardShelley)
@@ -124,11 +126,12 @@ protocolInfo :: forall m blk p. IOLike m
 protocolInfo (ProtocolByron params) =
     inject $ protocolInfoByron params
 
-protocolInfo (ProtocolShelley params) =
-    inject $ protocolInfoShelley params
+protocolInfo (ProtocolShelley paramsShelleyBased paramsShelley) =
+    inject $ protocolInfoShelley paramsShelleyBased paramsShelley
 
 protocolInfo (ProtocolCardano
                paramsByron
+               paramsShelleyBased
                paramsShelley
                paramsAllegra
                paramsMary
@@ -137,6 +140,7 @@ protocolInfo (ProtocolCardano
                paramsAllegraMary) =
     protocolInfoCardano
       paramsByron
+      paramsShelleyBased
       paramsShelley
       paramsAllegra
       paramsMary

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE DeriveAnyClass      #-}
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE FlexibleInstances   #-}
@@ -41,7 +42,7 @@ import           Control.Exception (assert)
 import qualified Data.ByteString.Short as Short
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (maybeToList)
-import           Data.SOP.Strict (K (..), NP (..), NS (..))
+import           Data.SOP.Strict (K (..), NP (..), NS (..), unComp)
 import           Data.Word (Word16)
 
 import           Cardano.Binary (DecoderError (..), enforceSize)
@@ -329,9 +330,10 @@ data ProtocolParamsTransition eraFrom eraTo = ProtocolParamsTransition {
 protocolInfoCardano ::
      forall c m. (IOLike m, CardanoHardForkConstraints c)
   => ProtocolParamsByron
-  -> ProtocolParamsShelley c Maybe
-  -> ProtocolParamsAllegra c Maybe
-  -> ProtocolParamsMary    c Maybe
+  -> ProtocolParamsShelleyBased (ShelleyEra c) Maybe
+  -> ProtocolParamsShelley
+  -> ProtocolParamsAllegra
+  -> ProtocolParamsMary
   -> ProtocolParamsTransition
        ByronBlock
        (ShelleyBlock (ShelleyEra c))
@@ -346,28 +348,28 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron {
                         byronGenesis           = genesisByron
                       , byronLeaderCredentials = mCredsByron
                       }
+                    ProtocolParamsShelleyBased {
+                        shelleyBasedGenesis           = genesisShelley
+                      , shelleyBasedInitialNonce      = initialNonceShelley
+                      , shelleyBasedLeaderCredentials = mCredsShelleyBased
+                      }
                     ProtocolParamsShelley {
-                        shelleyGenesis           = genesisShelley
-                      , shelleyInitialNonce      = initialNonceShelley
-                      , shelleyProtVer           = protVerShelley
-                      , shelleyLeaderCredentials = mCredsShelley
+                        shelleyProtVer = protVerShelley
                       }
                     ProtocolParamsAllegra {
-                        allegraProtVer           = protVerAllegra
-                      , allegraLeaderCredentials = mCredsAllegra
+                        allegraProtVer = protVerAllegra
                       }
                     ProtocolParamsMary {
-                        maryProtVer           = protVerMary
-                      , maryLeaderCredentials = mCredsMary
+                        maryProtVer = protVerMary
                       }
                     ProtocolParamsTransition {
-                        transitionTrigger    = triggerHardForkByronShelley
+                        transitionTrigger = triggerHardForkByronShelley
                       }
                     ProtocolParamsTransition {
-                        transitionTrigger    = triggerHardForkShelleyAllegra
+                        transitionTrigger = triggerHardForkShelleyAllegra
                       }
                     ProtocolParamsTransition {
-                        transitionTrigger    = triggerHardForkAllegraMary
+                        transitionTrigger = triggerHardForkAllegraMary
                       } =
     assertWithMsg (validateGenesis genesisShelley) $
     ProtocolInfo {
@@ -382,23 +384,26 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron {
                   WrapChainDepState $
                     headerStateChainDep initHeaderStateByron
           }
-      , pInfoBlockForging = sequence $ mconcat [
-            [ return $ hardForkBlockForging $ Z $ byronBlockForging credsByron
-            | credsByron <- maybeToList mCredsByron
-            ]
-          , [ hardForkBlockForging . S . Z
-                <$> shelleyBlockForging tpraosParams credsShelley
-            | credsShelley <- maybeToList mCredsShelley
-            ]
-          , [ hardForkBlockForging . S . S . Z
-                <$> shelleyBlockForging tpraosParams credsAllegra
-            | credsAllegra <- maybeToList mCredsAllegra
-            ]
-          , [ hardForkBlockForging . S . S . S . Z
-                <$> shelleyBlockForging tpraosParams credsMary
-            | credsMary <- maybeToList mCredsMary
-            ]
-          ]
+      , pInfoBlockForging = do
+          let blockForgingByron =
+                [ hardForkBlockForging $ Z $ byronBlockForging creds
+                | creds <- maybeToList mCredsByron
+                ]
+          blockForgingShelleyBased <- case mCredsShelleyBased of
+            Nothing                -> return []
+            Just credsShelleyBased -> do
+              sharedBlockForgings <-
+                shelleySharedBlockForging
+                  (Proxy @'[ShelleyEra c, AllegraEra c, MaryEra c])
+                  tpraosParams
+                  credsShelleyBased
+              case sharedBlockForgings of
+                bfShelley :* bfAllegra :* bfMary :* Nil -> return [
+                    hardForkBlockForging $         S $ Z $ unComp bfShelley
+                  , hardForkBlockForging $     S $ S $ Z $ unComp bfAllegra
+                  , hardForkBlockForging $ S $ S $ S $ Z $ unComp bfMary
+                  ]
+          return $ blockForgingByron <> blockForgingShelleyBased
       }
   where
     -- The major protocol version of the last era is the maximum major protocol
@@ -445,7 +450,7 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron {
         Shelley.mkShelleyBlockConfig
           protVerShelley
           genesisShelley
-          (tpraosBlockIssuerVKey <$> maybeToList mCredsShelley)
+          (tpraosBlockIssuerVKey <$> maybeToList mCredsShelleyBased)
 
     partialConsensusConfigShelley ::
          PartialConsensusConfig (BlockProtocol (ShelleyBlock (ShelleyEra c)))
@@ -471,7 +476,7 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron {
         Shelley.mkShelleyBlockConfig
           protVerAllegra
           genesisAllegra
-          (tpraosBlockIssuerVKey <$> maybeToList mCredsAllegra)
+          (tpraosBlockIssuerVKey <$> maybeToList mCredsShelleyBased)
 
     partialConsensusConfigAllegra ::
          PartialConsensusConfig (BlockProtocol (ShelleyBlock (AllegraEra c)))
@@ -494,7 +499,7 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron {
         Shelley.mkShelleyBlockConfig
           protVerMary
           genesisMary
-          (tpraosBlockIssuerVKey <$> maybeToList mCredsMary)
+          (tpraosBlockIssuerVKey <$> maybeToList mCredsShelleyBased)
 
     partialConsensusConfigMary ::
          PartialConsensusConfig (BlockProtocol (ShelleyBlock (MaryEra c)))

ouroboros-consensus-cardano/tools/db-analyser/Block/Cardano.hs

@@ -97,28 +97,28 @@ mkCardanoProtocolInfo genesisByron signatureThreshold genesisShelley initialNonc
         , byronSoftwareVersion        = Byron.Update.SoftwareVersion (Byron.Update.ApplicationName "db-analyser") 2
         , byronLeaderCredentials      = Nothing
         }
+      ProtocolParamsShelleyBased {
+          shelleyBasedGenesis           = genesisShelley
+        , shelleyBasedInitialNonce      = initialNonce
+        , shelleyBasedLeaderCredentials = Nothing
+        }
       ProtocolParamsShelley {
-          shelleyGenesis           = genesisShelley
-        , shelleyInitialNonce      = initialNonce
-        , shelleyProtVer           = ProtVer 2 0
-        , shelleyLeaderCredentials = Nothing
+          shelleyProtVer = ProtVer 2 0
         }
       ProtocolParamsAllegra {
-          allegraProtVer           = ProtVer 3 0
-        , allegraLeaderCredentials = Nothing
+          allegraProtVer = ProtVer 3 0
         }
       ProtocolParamsMary {
-          maryProtVer           = ProtVer 4 0
-        , maryLeaderCredentials = Nothing
+          maryProtVer    = ProtVer 4 0
         }
       ProtocolParamsTransition {
-          transitionTrigger    = TriggerHardForkAtVersion 2
+          transitionTrigger = TriggerHardForkAtVersion 2
         }
       ProtocolParamsTransition {
-          transitionTrigger    = TriggerHardForkAtVersion 3
+          transitionTrigger = TriggerHardForkAtVersion 3
         }
       ProtocolParamsTransition {
-          transitionTrigger    = TriggerHardForkAtVersion 4
+          transitionTrigger = TriggerHardForkAtVersion 4
         }
 
 castHeaderHash ::

ouroboros-consensus-cardano/tools/db-analyser/Block/Shelley.hs

@@ -33,7 +33,8 @@ import           Ouroboros.Consensus.Shelley.Eras (ShelleyBasedEra,
 import           Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
 import qualified Ouroboros.Consensus.Shelley.Ledger.Block as Shelley
 import           Ouroboros.Consensus.Shelley.Node (Nonce (..),
-                     ProtocolParamsShelley (..), ShelleyGenesis,
+                     ProtocolParamsShelley (..),
+                     ProtocolParamsShelleyBased (..), ShelleyGenesis,
                      protocolInfoShelley)
 
 import           HasAnalysis
@@ -75,12 +76,15 @@ mkShelleyProtocolInfo ::
   -> Nonce
   -> ProtocolInfo IO (ShelleyBlock StandardShelley)
 mkShelleyProtocolInfo genesis initialNonce =
-    protocolInfoShelley $ ProtocolParamsShelley {
-        shelleyGenesis           = genesis
-      , shelleyInitialNonce      = initialNonce
-      , shelleyProtVer           = SL.ProtVer 2 0
-      , shelleyLeaderCredentials = []
-      }
+    protocolInfoShelley
+      ProtocolParamsShelleyBased {
+          shelleyBasedGenesis           = genesis
+        , shelleyBasedInitialNonce      = initialNonce
+        , shelleyBasedLeaderCredentials = []
+        }
+      ProtocolParamsShelley {
+          shelleyProtVer = SL.ProtVer 2 0
+        }
 
 parseShelleyArgs :: Parser ShelleyBlockArgs
 parseShelleyArgs = ShelleyBlockArgs

ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs

@@ -401,12 +401,15 @@ mkProtocolShelley ::
   -> CoreNode c
   -> ProtocolInfo m (ShelleyBlock (ShelleyEra c))
 mkProtocolShelley genesis initialNonce protVer coreNode =
-    protocolInfoShelley $ ProtocolParamsShelley {
-        shelleyGenesis           = genesis
-      , shelleyInitialNonce      = initialNonce
-      , shelleyProtVer           = protVer
-      , shelleyLeaderCredentials = Just $ mkLeaderCredentials coreNode
-      }
+    protocolInfoShelley
+      ProtocolParamsShelleyBased {
+          shelleyBasedGenesis           = genesis
+        , shelleyBasedInitialNonce      = initialNonce
+        , shelleyBasedLeaderCredentials = Just $ mkLeaderCredentials coreNode
+        }
+      ProtocolParamsShelley {
+          shelleyProtVer = protVer
+        }
 {-------------------------------------------------------------------------------
   Necessary transactions for updating the 'DecentralizationParam'
 -------------------------------------------------------------------------------}