[wip] wait for block with stm

Author: geo2a

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
 -- | Queries
@@ -305,14 +306,18 @@ getPerasCertSnapshot CDB{..} = PerasCertDB.getCertSnapshot cdbPerasCertDB
 --   - ones the immutable tip is older than the slot of the target point:
 --     * returns the block at the target slot if it is occupied;n
 --     * otherwise, returns the block from the next occupied slot.
-waitForImmutableBlock :: IOLike m => ChainDbEnv m blk -> RealPoint blk -> m (Maybe (RealPoint blk))
+waitForImmutableBlock ::
+  forall blk m. IOLike m => ChainDbEnv m blk -> RealPoint blk -> m (Maybe (RealPoint blk))
 waitForImmutableBlock CDB{cdbImmutableDB} targetRealPoint = do
-  atomically (ImmutableDB.getTip cdbImmutableDB) >>= \case
-    Origin -> pure Nothing
-    At tip ->
-      if ImmutableDB.tipSlotNo tip >= realPointSlot targetRealPoint
-        then ImmutableDB.getBlockAtOrAfterPoint cdbImmutableDB targetRealPoint
-        else pure Nothing
+  -- first, wait until the target slot is older than the immutable tip
+  _ <- atomically $ do
+    ImmutableDB.getTip cdbImmutableDB >>= \case
+      Origin -> retry
+      At tip -> do
+        check (ImmutableDB.tipSlotNo tip >= realPointSlot targetRealPoint)
+        pure (ImmutableDB.tipToRealPoint tip)
+  -- then, query the DB for a point at or directly following the target slot
+  ImmutableDB.getBlockAtOrAfterPoint cdbImmutableDB targetRealPoint
 
 {-------------------------------------------------------------------------------
   Unifying interface over the immutable DB and volatile DB, but independent