Merge pull request #795 from input-output-hk/dcoutts/pfbt-config

Adjustments to PBFT ByronConfig

ouroboros-consensus/src/Ouroboros/Consensus/Demo/Byron/Elaborate.hs

@@ -116,6 +116,8 @@ elaborateTx (WithEBBNodeConfig cfg) (Mock.Tx ins outs) =
     richmen =
         zip [0..] $
           CC.Genesis.gsRichSecrets $ pbftSecrets (encNodeConfigExt cfg)
+        --TODO: this is the only use of pbftSecrets, and it can be removed
+        --as soon as we no longer need tx elaboration.
 
     fromCompactTxInTxOutList :: [(CC.UTxO.CompactTxIn, CC.UTxO.CompactTxOut)]
                              -> [(CC.UTxO.TxIn, CC.UTxO.TxOut)]

ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron/Config.hs

@@ -6,34 +6,33 @@ module Ouroboros.Consensus.Ledger.Byron.Config (
   , ByronEBBExtNodeConfig
   ) where
 
-import           Data.Bimap (Bimap)
-
 import qualified Cardano.Chain.Genesis as CC.Genesis
 import qualified Cardano.Chain.Slotting as CC.Slot
 import qualified Cardano.Chain.Update as CC.Update
 import qualified Cardano.Crypto as Crypto
 
 import           Ouroboros.Consensus.Ledger.Byron
-import           Ouroboros.Consensus.NodeId (CoreNodeId)
 import           Ouroboros.Consensus.Protocol.ExtNodeConfig
 import           Ouroboros.Consensus.Protocol.PBFT
 import           Ouroboros.Consensus.Protocol.WithEBBs
 
 -- | Extended configuration we need for Byron
 data ByronConfig = ByronConfig {
-      -- | Mapping from generic keys to core node IDs
-      --
-      -- The keys in this map are the verification keys of the core nodes - that
-      -- is, the delegates of the genesis keys.
-      pbftCoreNodes       :: Bimap Crypto.VerificationKey CoreNodeId
-    , pbftProtocolMagic   :: Crypto.ProtocolMagic
+      pbftProtocolMagic   :: Crypto.ProtocolMagic
     , pbftProtocolVersion :: CC.Update.ProtocolVersion
     , pbftSoftwareVersion :: CC.Update.SoftwareVersion
     , pbftEpochSlots      :: CC.Slot.EpochSlots
     , pbftGenesisConfig   :: CC.Genesis.Config
     , pbftGenesisHash     :: CC.Genesis.GenesisHash
     , pbftGenesisDlg      :: CC.Genesis.GenesisDelegation
+
+      -- | This is only needed by "Ouroboros.Consensus.Demo.Byron.Elaborate"
+      -- to elaborate from mock transactions to real ones. This obviously only
+      -- works for demos. This can be removed as soon as the elaboration is
+      -- removed (or moved into the tx submission tool for demos).
+      --
     , pbftSecrets         :: CC.Genesis.GeneratedSecrets
+      -- TODO: remove this ^^
     }
 
 type ByronExtNodeConfig = ExtNodeConfig ByronConfig (PBft PBftCardanoCrypto)

ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron/Forge.hs

@@ -49,11 +49,11 @@ forgeBlockOrEBB
   -> BlockNo                      -- ^ Current block number
   -> ChainHash (ByronBlockOrEBB cfg)   -- ^ Previous hash
   -> [GenTx (ByronBlockOrEBB cfg)]     -- ^ Txs to add in the block
-  -> ()                           -- ^ Leader proof ('IsLeader')
+  -> PBftIsLeader PBftCardanoCrypto    -- ^ Leader proof ('IsLeader')
   -> m (ByronBlockOrEBB ByronConfig)
-forgeBlockOrEBB cfg curSlot curNo prevHash txs () = case prevHash of
+forgeBlockOrEBB cfg curSlot curNo prevHash txs isLeader = case prevHash of
   GenesisHash -> forgeGenesisEBB cfg curSlot
-  BlockHash _ -> forgeBlock cfg curSlot curNo prevHash txs ()
+  BlockHash _ -> forgeBlock cfg curSlot curNo prevHash txs isLeader
 
 forgeGenesisEBB
   :: forall m.
@@ -100,11 +100,11 @@ forgeBlock
   -> BlockNo                      -- ^ Current block number
   -> ChainHash (ByronBlockOrEBB cfg)   -- ^ Previous hash
   -> [GenTx (ByronBlockOrEBB cfg)]     -- ^ Txs to add in the block
-  -> ()                           -- ^ Leader proof ('IsLeader')
+  -> PBftIsLeader PBftCardanoCrypto    -- ^ Leader proof ('IsLeader')
   -> m (ByronBlockOrEBB ByronConfig)
-forgeBlock (WithEBBNodeConfig cfg) curSlot curNo prevHash txs () = do
+forgeBlock (WithEBBNodeConfig cfg) curSlot curNo prevHash txs isLeader = do
     ouroborosPayload <- give (VerKeyCardanoDSIGN headerGenesisKey)
-      $ forgePBftFields (encNodeConfigP cfg) toCBOR toSign
+      $ forgePBftFields isLeader toCBOR toSign
     return $ forge ouroborosPayload
   where
     -- TODO: Might be sufficient to add 'ConfigContainsGenesis' constraint.
@@ -150,15 +150,15 @@ forgeBlock (WithEBBNodeConfig cfg) curSlot curNo prevHash txs () = do
         }
 
     headerGenesisKey :: Crypto.VerificationKey
-    VerKeyCardanoDSIGN headerGenesisKey = pbftGenVerKey $ encNodeConfigP cfg
+    VerKeyCardanoDSIGN headerGenesisKey = pbftGenVerKey isLeader
 
     dlgCertificate :: CC.Delegation.Certificate
     dlgCertificate = case findDelegate of
         Just x  -> x
         Nothing -> error "Issuer is not a valid genesis key delegate."
       where
         dlgMap = CC.Genesis.unGenesisDelegation pbftGenesisDlg
-        VerKeyCardanoDSIGN delegate = pbftVerKey $ encNodeConfigP cfg
+        VerKeyCardanoDSIGN delegate = pbftVerKey isLeader
         findDelegate = find (\crt -> CC.Delegation.delegateVK crt == delegate
                                    && CC.Delegation.issuerVK crt == headerGenesisKey
                              )

ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Mock/Block/PBFT.hs

@@ -90,9 +90,9 @@ instance ( SimpleCrypto c
          ) => ForgeExt (ExtNodeConfig ext (PBft c'))
                        c
                        (SimplePBftExt c c') where
-  forgeExt cfg () SimpleBlock{..} = do
+  forgeExt _cfg isLeader SimpleBlock{..} = do
       ext :: SimplePBftExt c c' <- fmap SimplePBftExt $
-        forgePBftFields (encNodeConfigP cfg) encode $
+        forgePBftFields isLeader encode $
           SignedSimplePBft {
               signedSimplePBft = simpleHeaderStd
             }

ouroboros-consensus/src/Ouroboros/Consensus/Node/ProtocolInfo/Byron.hs

@@ -12,7 +12,6 @@ module Ouroboros.Consensus.Node.ProtocolInfo.Byron (
   ) where
 
 import           Control.Monad.Except
-import qualified Data.Bimap as Bimap
 import           Data.Coerce
 import           Data.Maybe (fromJust)
 import qualified Data.Sequence as Seq
@@ -27,7 +26,7 @@ import           Ouroboros.Consensus.Crypto.DSIGN.Cardano
 import           Ouroboros.Consensus.Ledger.Byron
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Node.ProtocolInfo.Abstract
-import           Ouroboros.Consensus.NodeId (CoreNodeId (..), NodeId (..))
+import           Ouroboros.Consensus.NodeId (CoreNodeId (..))
 import           Ouroboros.Consensus.Protocol.ExtNodeConfig
 import           Ouroboros.Consensus.Protocol.PBFT
 import           Ouroboros.Consensus.Protocol.WithEBBs
@@ -51,29 +50,31 @@ protocolInfoByron (NumCoreNodes numCoreNodes) (CoreNodeId nid) params gc =
     ProtocolInfo {
         pInfoConfig = WithEBBNodeConfig $ EncNodeConfig {
             encNodeConfigP = PBftNodeConfig {
-                  pbftParams  = params
+                  pbftParams   = params
                     { pbftNumNodes = fromIntegral numCoreNodes
                       -- Set the signature window to be short for the demo.
                     , pbftSignatureWindow = 7
                     }
-                , pbftNodeId  = CoreId nid
-                , pbftSignKey = SignKeyCardanoDSIGN (snd (lookupKey nid))
-                , pbftVerKey  = VerKeyCardanoDSIGN  (fst (lookupKey nid))
-                , pbftGenVerKey = VerKeyCardanoDSIGN (lookupGenKey nid)
+                  --TODO: also allow not being a BFT leader:
+                , pbftIsLeader = Just PBftIsLeader {
+                      pbftCoreNodeId = CoreNodeId nid
+                    , pbftSignKey    = SignKeyCardanoDSIGN (snd (lookupKey nid))
+                    , pbftVerKey     = VerKeyCardanoDSIGN  (fst (lookupKey nid))
+                    , pbftGenVerKey  = VerKeyCardanoDSIGN (lookupGenKey nid)
+                    }
                 }
           , encNodeConfigExt = ByronConfig {
-                pbftCoreNodes = Bimap.fromList [
-                    (fst (lookupKey n), CoreNodeId n)
-                    | n <- [0 .. numCoreNodes]
-                    ]
-              , pbftProtocolMagic   = Cardano.Genesis.configProtocolMagic gc
+                pbftProtocolMagic   = Cardano.Genesis.configProtocolMagic gc
               , pbftProtocolVersion = Cardano.Update.ProtocolVersion 1 0 0
               , pbftSoftwareVersion = Cardano.Update.SoftwareVersion (Cardano.Update.ApplicationName "Cardano Demo") 1
               , pbftGenesisConfig   = gc
               , pbftGenesisHash     = coerce Cardano.Genesis.configGenesisHeaderHash gc
               , pbftEpochSlots      = Cardano.Genesis.configEpochSlots gc
               , pbftGenesisDlg      = Cardano.Genesis.configHeavyDelegation gc
               , pbftSecrets         = Dummy.dummyGeneratedSecrets
+                --TODO: These "richmen" secrets ^^ are here to support demos
+                -- where we need to elaborate from mock transactions to real
+                -- ones. It should be removed when we can eliminate elaboration.
               }
           }
       , pInfoInitLedger = ExtLedgerState {

ouroboros-consensus/src/Ouroboros/Consensus/Node/ProtocolInfo/Mock/PBFT.hs

@@ -14,7 +14,7 @@ import           Cardano.Crypto.DSIGN
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Ledger.Mock
 import           Ouroboros.Consensus.Node.ProtocolInfo.Abstract
-import           Ouroboros.Consensus.NodeId (CoreNodeId (..), NodeId (..))
+import           Ouroboros.Consensus.NodeId (CoreNodeId (..))
 import           Ouroboros.Consensus.Protocol.ExtNodeConfig
 import           Ouroboros.Consensus.Protocol.PBFT
 
@@ -28,11 +28,13 @@ protocolInfoMockPBFT (NumCoreNodes numCoreNodes) (CoreNodeId nid) params =
         pInfoConfig = EncNodeConfig {
             encNodeConfigP = PBftNodeConfig {
                 pbftParams   = params {pbftNumNodes = fromIntegral numCoreNodes}
-              , pbftNodeId   = CoreId nid
-              , pbftSignKey  = SignKeyMockDSIGN nid
-              , pbftVerKey   = VerKeyMockDSIGN nid
-                -- For Mock PBFT, we use our key as the genesis key.
-              , pbftGenVerKey = VerKeyMockDSIGN nid
+              , pbftIsLeader = Just PBftIsLeader {
+                    pbftCoreNodeId = CoreNodeId nid
+                  , pbftSignKey    = SignKeyMockDSIGN nid
+                  , pbftVerKey     = VerKeyMockDSIGN nid
+                    -- For Mock PBFT, we use our key as the genesis key.
+                  , pbftGenVerKey  = VerKeyMockDSIGN nid
+                  }
               }
             , encNodeConfigExt = PBftLedgerView $
                 Bimap.fromList [ (VerKeyMockDSIGN n, VerKeyMockDSIGN n)

ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleContexts        #-}
 {-# LANGUAGE FlexibleInstances       #-}
 {-# LANGUAGE MultiParamTypeClasses   #-}
+{-# LANGUAGE NamedFieldPuns          #-}
 {-# LANGUAGE RecordWildCards         #-}
 {-# LANGUAGE ScopedTypeVariables     #-}
 {-# LANGUAGE StandaloneDeriving      #-}
@@ -17,6 +18,7 @@ module Ouroboros.Consensus.Protocol.PBFT (
   , PBftLedgerView(..)
   , PBftFields(..)
   , PBftParams(..)
+  , PBftIsLeader(..)
   , forgePBftFields
     -- * Classes
   , PBftCrypto(..)
@@ -50,7 +52,7 @@ import           Ouroboros.Network.Block
 import           Ouroboros.Network.Point (WithOrigin (..))
 
 import           Ouroboros.Consensus.Crypto.DSIGN.Cardano
-import           Ouroboros.Consensus.NodeId (NodeId (..))
+import           Ouroboros.Consensus.NodeId (CoreNodeId(..))
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Protocol.Signed
 import           Ouroboros.Consensus.Util.Condense
@@ -81,11 +83,11 @@ forgePBftFields :: ( MonadRandom m
                    , PBftCrypto c
                    , Signable (PBftDSIGN c) toSign
                    )
-                => NodeConfig (PBft c)
+                => IsLeader (PBft c)
                 -> (toSign -> Encoding)
                 -> toSign
                 -> m (PBftFields c toSign)
-forgePBftFields PBftNodeConfig{..} encodeToSign toSign = do
+forgePBftFields PBftIsLeader{..} encodeToSign toSign = do
     signature <- signedDSIGN encodeToSign toSign pbftSignKey
     return $ PBftFields {
         pbftIssuer    = pbftVerKey
@@ -135,16 +137,24 @@ data PBftParams = PBftParams {
     , pbftSignatureThreshold :: Double
     }
 
+-- | If we are a core node (i.e. a block producing node) we know which core
+-- node we are, and we have the operational key pair and delegation certificate.
+--
+data PBftIsLeader c = PBftIsLeader {
+      pbftCoreNodeId :: CoreNodeId
+    , pbftSignKey    :: SignKeyDSIGN (PBftDSIGN c)
+    , pbftVerKey     :: VerKeyDSIGN (PBftDSIGN c)
+      -- Verification key for the genesis stakeholder
+      -- This is unfortunately needed during the Byron era
+    , pbftGenVerKey  :: VerKeyDSIGN (PBftDSIGN c)
+      -- TODO: We should have a delegation certificate here.
+    }
+
 instance (PBftCrypto c, Typeable c) => OuroborosTag (PBft c) where
   -- | (Static) node configuration
   data NodeConfig (PBft c) = PBftNodeConfig {
         pbftParams   :: PBftParams
-      , pbftNodeId   :: NodeId
-      , pbftSignKey  :: SignKeyDSIGN (PBftDSIGN c)
-      , pbftVerKey   :: VerKeyDSIGN (PBftDSIGN c)
-        -- Verification key for the genesis stakeholder
-        -- This is unfortunately needed during the Byron era
-      , pbftGenVerKey :: VerKeyDSIGN (PBftDSIGN c)
+      , pbftIsLeader :: Maybe (PBftIsLeader c)
       }
 
   type ValidationErr   (PBft c) = PBftValidationErr c
@@ -157,7 +167,7 @@ instance (PBftCrypto c, Typeable c) => OuroborosTag (PBft c) where
   --   - The delegation map.
   type LedgerView     (PBft c) = PBftLedgerView c
 
-  type IsLeader       (PBft c) = ()
+  type IsLeader       (PBft c) = PBftIsLeader c
 
   -- | Chain state consists of two things:
   --   - a list of the last 'pbftSignatureWindow' signatures.
@@ -167,14 +177,15 @@ instance (PBftCrypto c, Typeable c) => OuroborosTag (PBft c) where
 
   protocolSecurityParam = pbftSecurityParam . pbftParams
 
-  checkIsLeader PBftNodeConfig{..} (SlotNo n) _l _cs = do
-      return $ case pbftNodeId of
-                 RelayId _ -> Nothing -- relays are never leaders
-                 CoreId  i -> if n `mod` pbftNumNodes == fromIntegral i
-                                then Just ()
-                                else Nothing
-    where
-      PBftParams{..}  = pbftParams
+  checkIsLeader PBftNodeConfig{pbftIsLeader, pbftParams} (SlotNo n) _l _cs =
+      case pbftIsLeader of
+        Nothing                                    -> return Nothing
+        Just credentials
+          | n `mod` pbftNumNodes == fromIntegral i -> return (Just credentials)
+          | otherwise                              -> return Nothing
+          where
+            PBftIsLeader{pbftCoreNodeId = CoreNodeId i} = credentials
+            PBftParams{pbftNumNodes}                    = pbftParams
 
   applyChainState cfg@PBftNodeConfig{..} lv@(PBftLedgerView dms) (b :: hdr) chainState = do
       -- Check that the issuer signature verifies, and that it's a delegate of a