Merge #1441

1441: Generalize forgeBlock r=edsko a=edsko

Make sure that block production gets the current ledger state as
argument, rather than just the previous block number.

Closes #1439.

Co-authored-by: Edsko de Vries <edsko@well-typed.com>

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

@@ -31,12 +31,14 @@ import           Cardano.Crypto.DSIGN
 import           Ouroboros.Network.Block
 
 import           Ouroboros.Consensus.Crypto.DSIGN.Cardano
+import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Byron.Auxiliary
 import           Ouroboros.Consensus.Ledger.Byron.Block
 import           Ouroboros.Consensus.Ledger.Byron.Config
 import           Ouroboros.Consensus.Ledger.Byron.ContainsGenesis
 import           Ouroboros.Consensus.Ledger.Byron.Mempool
 import           Ouroboros.Consensus.Ledger.Byron.PBFT
+import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Protocol.PBFT
 
@@ -48,7 +50,7 @@ forgeByronBlock
   => NodeConfig ByronConsensusProtocol
   -> SlotNo                          -- ^ Current slot
   -> BlockNo                         -- ^ Current block number
-  -> ChainHash ByronBlock            -- ^ Previous hash
+  -> ExtLedgerState ByronBlock       -- ^ Ledger
   -> [GenTx ByronBlock]              -- ^ Txs to add in the block
   -> PBftIsLeader PBftCardanoCrypto  -- ^ Leader proof ('IsLeader')
   -> m ByronBlock
@@ -130,11 +132,11 @@ forgeRegularBlock
   => NodeConfig ByronConsensusProtocol
   -> SlotNo                            -- ^ Current slot
   -> BlockNo                           -- ^ Current block number
-  -> ChainHash ByronBlock              -- ^ Previous hash
+  -> ExtLedgerState ByronBlock         -- ^ Ledger
   -> [GenTx ByronBlock]                -- ^ Txs to add in the block
   -> PBftIsLeader PBftCardanoCrypto    -- ^ Leader proof ('IsLeader')
   -> m ByronBlock
-forgeRegularBlock cfg curSlot curNo prevHash txs isLeader = do
+forgeRegularBlock cfg curSlot curNo extLedger txs isLeader = do
     ouroborosPayload <-
       forgePBftFields cfg isLeader (reAnnotate $ Annotated toSign ())
     return $ forge ouroborosPayload
@@ -189,7 +191,7 @@ forgeRegularBlock cfg curSlot curNo prevHash txs isLeader = do
     proof = CC.Block.mkProof body
 
     prevHeaderHash :: CC.Block.HeaderHash
-    prevHeaderHash = case prevHash of
+    prevHeaderHash = case ledgerTipHash (ledgerState extLedger) of
       GenesisHash             -> error
         "the first block on the Byron chain must be an EBB"
       BlockHash (ByronHash h) -> h

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

@@ -8,12 +8,16 @@ module Ouroboros.Consensus.Ledger.Mock.Forge (forgeSimple) where
 import           Codec.Serialise (Serialise (..), serialise)
 import           Crypto.Random (MonadRandom)
 import qualified Data.ByteString.Lazy as Lazy
+import           Data.Typeable (Typeable)
 import           Data.Word
 
 import           Cardano.Crypto.Hash
 
-import           Ouroboros.Network.Block (BlockNo, ChainHash, SlotNo)
+import           Ouroboros.Network.Block (BlockNo, SlotNo)
 
+import           Ouroboros.Consensus.Block
+import           Ouroboros.Consensus.Ledger.Abstract
+import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Ledger.Mock.Block
 import           Ouroboros.Consensus.Ledger.Mock.Run
 import           Ouroboros.Consensus.Protocol.Abstract
@@ -23,15 +27,17 @@ forgeSimple :: forall p c m ext.
                , MonadRandom m
                , SimpleCrypto c
                , RunMockBlock p c ext
+               , SupportedBlock (SimpleBlock c ext)
+               , Typeable ext
                )
             => NodeConfig p
-            -> SlotNo                         -- ^ Current slot
-            -> BlockNo                        -- ^ Current block number
-            -> ChainHash (SimpleBlock c ext)  -- ^ Previous hash
-            -> [GenTx (SimpleBlock c ext)]    -- ^ Txs to add in the block
-            -> IsLeader p                     -- ^ Proof we are slot leader
+            -> SlotNo                              -- ^ Current slot
+            -> BlockNo                             -- ^ Current block number
+            -> ExtLedgerState (SimpleBlock c ext)  -- ^ Previous hash
+            -> [GenTx (SimpleBlock c ext)]         -- ^ Txs to add in the block
+            -> IsLeader p                          -- ^ Proof we are slot leader
             -> m (SimpleBlock c ext)
-forgeSimple cfg curSlot curBlock prevHash txs proof = do
+forgeSimple cfg curSlot curBlock extLedger txs proof = do
     forgeExt cfg proof $ SimpleBlock {
         simpleHeader = mkSimpleHeader encode stdHeader ()
       , simpleBody   = body
@@ -42,7 +48,7 @@ forgeSimple cfg curSlot curBlock prevHash txs proof = do
 
     stdHeader :: SimpleStdHeader c ext
     stdHeader = SimpleStdHeader {
-          simplePrev      = prevHash
+          simplePrev      = ledgerTipHash (ledgerState extLedger)
         , simpleSlotNo    = curSlot
         , simpleBlockNo   = curBlock
         , simpleBodyHash  = hash body

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

@@ -40,8 +40,6 @@ import           Data.Time.Clock (secondsToDiffTime)
 
 import           Control.Monad.Class.MonadThrow
 
-import           Ouroboros.Network.Block
-import qualified Ouroboros.Network.Block as Block
 import           Ouroboros.Network.Diffusion
 import           Ouroboros.Network.Magic
 import           Ouroboros.Network.NodeToClient (DictVersion (..),
@@ -56,8 +54,8 @@ import           Ouroboros.Network.Socket (ConnectionId)
 import           Ouroboros.Consensus.Block (BlockProtocol, getHeader)
 import           Ouroboros.Consensus.BlockchainTime
 import           Ouroboros.Consensus.ChainSyncClient (ClockSkew (..))
-import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState)
-import           Ouroboros.Consensus.Mempool (GenTx, MempoolCapacityBytes (..))
+import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState (..))
+import           Ouroboros.Consensus.Mempool (MempoolCapacityBytes (..))
 import           Ouroboros.Consensus.Node.DbMarker
 import           Ouroboros.Consensus.Node.ErrorPolicy
 import           Ouroboros.Consensus.Node.ProtocolInfo
@@ -288,26 +286,6 @@ mkNodeArgs registry cfg initState tracers btime chainDB isProducer = NodeArgs
     blockProduction = case isProducer of
       IsNotProducer -> Nothing
       IsProducer    -> Just BlockProduction
-        { produceDRG   = drgNew
-        , produceBlock = produceBlock
-        }
-
-    produceBlock
-      :: IsLeader (BlockProtocol blk)  -- ^ Proof we are leader
-      -> ExtLedgerState blk            -- ^ Current ledger state
-      -> SlotNo                        -- ^ Current slot
-      -> Point blk                     -- ^ Previous point
-      -> BlockNo                       -- ^ Previous block number
-      -> [GenTx blk]                   -- ^ Contents of the mempool
-      -> ProtocolM blk IO blk
-    produceBlock proof _l slot prevPoint prevBlockNo txs =
-        -- The transactions we get are consistent; the only reason not to
-        -- include all of them would be maximum block size, which we ignore
-        -- for now.
-        nodeForgeBlock cfg slot curNo prevHash txs proof
-      where
-        curNo :: BlockNo
-        curNo = succ prevBlockNo
-
-        prevHash :: ChainHash blk
-        prevHash = castHash (Block.pointHash prevPoint)
+                         { produceDRG   = drgNew
+                         , produceBlock = nodeForgeBlock cfg
+                         }

ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Abstract.hs

@@ -18,15 +18,15 @@ import           Data.Word (Word32)
 
 import           Cardano.Crypto (ProtocolMagicId)
 
-import           Ouroboros.Network.Block (BlockNo, ChainHash (..), HeaderHash,
-                     SlotNo)
+import           Ouroboros.Network.Block (BlockNo, HeaderHash, SlotNo)
 import           Ouroboros.Network.BlockFetch (SizeInBytes)
 import           Ouroboros.Network.Magic (NetworkMagic)
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime (SystemStart)
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Byron
+import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Mempool
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Util.IOLike (IOLike)
@@ -39,10 +39,10 @@ class (ProtocolLedgerView blk, ApplyTx blk) => RunNode blk where
 
   nodeForgeBlock          :: (HasNodeState (BlockProtocol blk) m, MonadRandom m)
                           => NodeConfig (BlockProtocol blk)
-                          -> SlotNo         -- ^ Current slot
-                          -> BlockNo        -- ^ Current block number
-                          -> ChainHash blk  -- ^ Previous hash
-                          -> [GenTx blk]    -- ^ Txs to add in the block
+                          -> SlotNo              -- ^ Current slot
+                          -> BlockNo             -- ^ Current block number
+                          -> ExtLedgerState blk  -- ^ Current ledger
+                          -> [GenTx blk]         -- ^ Txs to add in the block
                           -> IsLeader (BlockProtocol blk)
                           -> m blk
 

ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs

@@ -108,12 +108,11 @@ data BlockProduction m blk = BlockProduction {
       -- (also provided as an argument) and with each other (when applied in
       -- order). In principle /all/ of them could be included in the block (up
       -- to maximum block size).
-      produceBlock :: IsLeader (BlockProtocol blk) -- Proof we are leader
+      produceBlock :: SlotNo             -- Current slot
+                   -> BlockNo            -- Current block number
                    -> ExtLedgerState blk -- Current ledger state
-                   -> SlotNo             -- Current slot
-                   -> Point blk          -- Previous point
-                   -> BlockNo            -- Previous block number
                    -> [GenTx blk]        -- Contents of the mempool
+                   -> IsLeader (BlockProtocol blk) -- Proof we are leader
                    -> ProtocolM blk m blk
 
       -- | Produce a random seed
@@ -391,12 +390,11 @@ forkBlockProduction maxBlockSizeOverride IS{..} BlockProduction{..} =
         -- Actually produce the block
         newBlock <- lift $ atomically $ runProtocol varDRG $
           produceBlock
-            proof
-            extLedger
             currentSlot
-            prevPoint
-            prevNo
+            (succ prevNo)
+            extLedger
             txs
+            proof
         trace $ TraceForgedBlock
                   currentSlot
                   newBlock

ouroboros-consensus/test-consensus/Test/ThreadNet/Network.hs

@@ -393,21 +393,8 @@ runThreadNetwork ThreadNetworkArgs
 
       let blockProduction :: BlockProduction m blk
           blockProduction = BlockProduction {
-              produceBlock = \proof _l slot prevPoint prevNo txs -> do
-                let curNo :: BlockNo
-                    curNo = succ prevNo
-
-                let prevHash :: ChainHash blk
-                    prevHash = castHash (pointHash prevPoint)
-
-                nodeForgeBlock pInfoConfig
-                               slot
-                               curNo
-                               prevHash
-                               txs
-                               proof
-
-            , produceDRG      = atomically $ simChaChaT varRNG id $ drgNew
+              produceBlock = nodeForgeBlock pInfoConfig
+            , produceDRG   = atomically $ simChaChaT varRNG id $ drgNew
             }
 
       (nodeInfo, readNodeInfo) <- newNodeInfo