InMemory: reject writeEbBody for unregistered points

ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/InMemory.hs

@@ -22,6 +22,7 @@ import Control.Concurrent.Class.MonadSTM.Strict
   , newBroadcastTChan
   , newTVarIO
   , readTVar
+  , readTVarIO
   , writeTChan
   )
 import Data.ByteString (ByteString)
@@ -289,6 +290,11 @@ imInsertEbBody stateVar notificationChan point eb fills = do
       ebBytesSize = encodeLeiosEbSize eb
   when (null items) $
     throwLeiosDbException "writeEbBody: empty EB body (programmer error)"
+  -- As on SQLite: the point MUST already be present (inserted via
+  -- 'writeEbPoint' on the announcement path).
+  known <- Map.member point . imEbPoints <$> readTVarIO stateVar
+  when (not known) $
+    throwLeiosDbException "writeEbBody: point not registered (programmer error)"
   atomically $ do
     let entries =
           IntMap.fromList

ouroboros-consensus/test/consensus-test/Test/LeiosDemoDb.hs

@@ -126,6 +126,10 @@ tests =
              "orphanhood"
              [ testCase "dropping the handle does not kill its owner" test_droppingTheHandleSpreadsNoException
              ]
+         , -- InMemory only: on SQLite a failed ingest write also kills the
+           -- writer (see 'startWriter'), which is linked to the test thread.
+           testCase "InMemory: inserting a body for an unregistered point fails, as on SQLite" $
+             withFreshDb InMemory test_ebBodyWithoutPointFails
          ]
 
 -- | Database creation strategy for different implementations.
@@ -845,6 +849,18 @@ test_noReNotifyOnRelatedTxReinsert db = do
 -- per (slot, hash) when the closure completes, regardless of how many
 -- slots reference the same hash. Conflating the slots loses a
 -- notification.
+-- | A body can only be persisted for a point already registered (via
+-- 'writeEbPoint', on the announcement path).
+test_ebBodyWithoutPointFails :: LeiosDbHandle IO -> IO ()
+test_ebBodyWithoutPointFails db = withRW db $ \con -> do
+  result <- tryDb $ rwInsertEbBody con (mkTestPoint (SlotNo 1) 1) (mkTestEb 2)
+  case result of
+    Left _ -> pure ()
+    Right _ -> assertFailure "writeEbBody succeeded for a point that was never registered"
+ where
+  tryDb :: IO a -> IO (Either LeiosDbException a)
+  tryDb = try
+
 test_multipleSlotsSameHash :: LeiosDbHandle IO -> IO ()
 test_multipleSlotsSameHash db = do
   chan <- subscribeEbNotifications db

ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs

@@ -64,6 +64,7 @@ import LeiosDemoTypes
   , WhetherTxsClosureOffered (..)
   , demoLeiosFetchStaticEnv
   , emptyLeiosOutstanding
+  , encodeLeiosEbSize
   , focusElectionIfUnfocused
   , hashLeiosEb
   , hashLeiosTx
@@ -418,7 +419,10 @@ serveStoredBody n = do
   db <- newLeiosDBInMemory
   let body = MkLeiosEb $ V.generate n $ \i -> (hashLeiosTx (MkLeiosTx (BS8.pack (show i))), 100)
       bodyPoint = MkLeiosPoint (SlotNo 0) (hashLeiosEb body)
-  withWriter db $ \w -> void . await =<< writeEbBody w bodyPoint body []
+  -- The point first: a body can only be written for a registered point.
+  withWriter db $ \w -> do
+    void . await =<< writeEbPoint w bodyPoint (encodeLeiosEbSize body)
+    void . await =<< writeEbBody w bodyPoint body []
   withReader db $ \r -> do
     ctx <- newLeiosFetchContext r
     msgLeiosBlockRequest nullTracer ctx bodyPoint