From a205b8a093cd791e024d33c6f3ab7f2ed3db5b49 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Thu, 21 Sep 2023 12:52:29 +0300
Subject: [PATCH] refchan-qblf example: balance caching fix

---
 examples/refchan-qblf/app/RefChanQBLFMain.hs |  1 +
 hbs2-core/lib/HBS2/Data/Detect.hs            | 20 ++++++++++++++++++--
 2 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/examples/refchan-qblf/app/RefChanQBLFMain.hs b/examples/refchan-qblf/app/RefChanQBLFMain.hs
index 2f204176..938920c0 100644
--- a/examples/refchan-qblf/app/RefChanQBLFMain.hs
+++ b/examples/refchan-qblf/app/RefChanQBLFMain.hs
@@ -446,6 +446,7 @@ balances root = do
       let val = catMaybes r & mconcat & HashMap.fromListWith (+)
 
       runMaybeT do
+        checkComplete sto root >>= guard
         rv <- MaybeT $ liftIO $ putBlock sto (serialise val)
         liftIO $ updateRef sto pk rv
 
diff --git a/hbs2-core/lib/HBS2/Data/Detect.hs b/hbs2-core/lib/HBS2/Data/Detect.hs
index a85b0677..86538142 100644
--- a/hbs2-core/lib/HBS2/Data/Detect.hs
+++ b/hbs2-core/lib/HBS2/Data/Detect.hs
@@ -4,6 +4,7 @@ import HBS2.Prelude.Plated
 import HBS2.Hash
 import HBS2.Data.Types
 import HBS2.Merkle
+import HBS2.Storage
 
 import HBS2.System.Logger.Simple
 
@@ -20,6 +21,7 @@ import Data.Maybe
 import Control.Concurrent.STM
 import Data.HashMap.Strict qualified as HashMap
 import Data.HashMap.Strict (HashMap)
+import Data.List qualified as List
 
 import Streaming.Prelude qualified as S
 import Streaming qualified as S
@@ -148,11 +150,25 @@ readLog :: forall m . ( MonadIO m )
         => ( Hash HbSync -> IO (Maybe ByteString) )
         -> HashRef
         -> m [HashRef]
-readLog getBlock (HashRef h)  =
+readLog getBlk (HashRef h)  =
   S.toList_ $ do
-    walkMerkle h (liftIO . getBlock) $ \hr -> do
+    walkMerkle h (liftIO . getBlk) $ \hr -> do
       case hr of
         Left{} -> pure ()
         Right (hrr :: [HashRef]) -> S.each hrr
 
 
+-- FIXME: make-it-stop-after-first-missed-block
+checkComplete :: forall sto m . (MonadIO m, Storage sto HbSync ByteString IO)
+              => sto
+              -> HashRef
+              -> m Bool
+checkComplete sto hr = do
+
+  result <- S.toList_ $
+              deepScan ScanDeep (const $ S.yield Nothing) (fromHashRef hr) (liftIO . getBlock sto) $ \ha -> do
+                here <- liftIO $ hasBlock sto ha
+                S.yield here
+
+  pure $ maybe False (not . List.null)  $ sequence result
+