consensus: do not assume the anchor point is genesis in prevPointAndB…

…lockNo

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

@@ -359,8 +359,10 @@ forkBlockProduction maxBlockSizeOverride IS{..} BlockProduction{..} =
         -- Normally this will be the current block at the tip, but it may
         -- be the /previous/ block, if there were multiple slot leaders
         (prevPoint, prevNo) <- do
-          mPrev <- lift $ atomically $ prevPointAndBlockNo currentSlot <$>
-                     ChainDB.getCurrentChain chainDB
+          (cc, cBno) <- lift $ atomically $
+            (,) <$> ChainDB.getCurrentChain chainDB
+                <*> ChainDB.getTipBlockNo chainDB
+          let mPrev = prevPointAndBlockNo currentSlot cBno cc
           case mPrev of
             Right prev       -> return prev
             Left  futureSlot -> do
@@ -498,10 +500,11 @@ forkBlockProduction maxBlockSizeOverride IS{..} BlockProduction{..} =
     -- another node was also elected leader and managed to produce a block
     -- before us, the header right before the one at the tip of the chain.
     prevPointAndBlockNo :: SlotNo
+                        -> BlockNo
                         -> AnchoredFragment (Header blk)
                         -> Either SlotNo (Point blk, BlockNo)
-    prevPointAndBlockNo slot c = case c of
-        Empty _   -> Right (genesisPoint, genesisBlockNo)
+    prevPointAndBlockNo slot bno c = case c of
+        Empty p   -> Right $ mkPredecessor p bno
         c' :> hdr -> case blockSlot hdr `compare` slot of
 
           -- The block at the tip of our chain has a slot number /before/ the
@@ -538,11 +541,22 @@ forkBlockProduction maxBlockSizeOverride IS{..} BlockProduction{..} =
                -- We allow forging a block that is the successor of an EBB in
                -- the same slot.
              -> Right (headerPoint hdr, blockNo hdr)
-             | _ :> hdr' <- c'
-             -> Right (headerPoint hdr', blockNo hdr')
              | otherwise
-               -- If there is no block before it, so use genesis.
-             -> Right (genesisPoint, genesisBlockNo)
+             -> Right $ case c' of
+               _ :> hdr' -> (headerPoint hdr', blockNo hdr')
+               Empty p   -> mkPredecessor p (blockNo hdr)
+
+    mkPredecessor
+      :: Point (Header blk)
+         -- ^ point of predecessor of block @b@
+      -> BlockNo
+         -- ^ block number of @b@ (NOTE not of the predecessor)
+      -> (Point blk, BlockNo)
+         -- ^ point and block number of predecessor of @b@
+    mkPredecessor prevP bno
+        -- There is no block before it, so use genesis.
+      | 0 == bno  = (genesisPoint, genesisBlockNo)
+      | otherwise = (castPoint prevP, pred bno)
 
     runProtocol :: StrictTVar m PRNG -> ProtocolM blk m a -> STM m a
     runProtocol varDRG = simOuroborosStateT varState