wip

hbs2-peer/lib/HBS2/Peer/RPC/Client/RefChan.hs

@@ -141,10 +141,11 @@ walkRefChanTx :: forall proto m . ( MonadIO m
                                   , HasProtocol proto (ServiceProto RefChanAPI proto)
                                   , HasStorage m
                                   )
-            => PubKey 'Sign 'HBS2Basic
-            -> (RefChanUpdateUnpacked L4Proto -> m ())
+            => (HashRef -> m Bool)
+            -> PubKey 'Sign 'HBS2Basic
+            -> (HashRef -> RefChanUpdateUnpacked L4Proto -> m ())
             -> m ()
-walkRefChanTx puk action = do
+walkRefChanTx filt puk action = do
   sto <- getStorage
   api <- getClientAPI @RefChanAPI @proto
 
@@ -162,6 +163,8 @@ walkRefChanTx puk action = do
 
       Right (hs :: [HashRef]) -> do
         for_ hs $ \h -> do
+          want <- lift (filt h)
+          when want do
             lbs' <- getBlock sto (coerce h)
             lbs  <- ContT $ maybe1 lbs' none
 
@@ -174,9 +177,9 @@ walkRefChanTx puk action = do
 
               Accept _ box  -> do
                 (_, txx) <- ContT $ maybe1 (unboxSignedBox0 box) none
-              lift $ action (A txx)
+                lift $ action h (A  txx)
 
               Propose _ box -> do
                 (_, txx) <- ContT $ maybe1 (unboxSignedBox0 box) none
-              lift $ action (P h txx)
+                lift $ action h (P h txx)
 

hbs2-sync/src/HBS2/Sync/Prelude.hs

@@ -857,7 +857,8 @@ getStateFromRefChan rchan = do
   outq <- newTQueueIO
   tss <- newTVarIO mempty
 
-  walkRefChanTx @UNIX rchan $ \case
+  -- FIXME: may-be-slow
+  walkRefChanTx @UNIX (const $ pure True) rchan $ \txh -> \case
     A (AcceptTran ts _ what) -> do
       -- debug $ red "ACCEPT" <+> pretty ts <+> pretty what
       for_ ts $ \w -> do