wip, log merging, debug-26

hbs2-peer/app/RefChan.hs

@@ -88,7 +88,7 @@ refChanWorkerEnv _ de = liftIO $ RefChanWorkerEnv @e de <$> newTQueueIO
                                                         <*> newTQueueIO
 
 
-refChanOnHeadFn :: MonadIO m => RefChanWorkerEnv e -> RefChanId e -> RefChanHeadBlockTran e -> m ()
+refChanOnHeadFn :: forall e m . (ForRefChans e, MonadIO m) => RefChanWorkerEnv e -> RefChanId e -> RefChanHeadBlockTran e -> m ()
 refChanOnHeadFn env chan tran = do
   atomically $ writeTQueue (view refChanWorkerEnvHeadQ env) (chan, tran)
 
@@ -439,7 +439,7 @@ logMergeProcess env q = do
       here <- liftIO $ hasBlock sto (fromHashRef h) <&> isJust
 
       unless here do
-        debug $ "head is missed:" <+> pretty h
+        warn $ "refchan. head is missed:" <+> pretty h
         pure ()
 
       case hd of
@@ -450,7 +450,18 @@ logMergeProcess env q = do
           atomically $ modifyTVar (mergeHeads e) (HashMap.insert h headblk)
           pure headblk
 
-    logMergeChan menv sto (chan, logs) = void $ runMaybeT do
+    downloadMissedHead :: AnyStorage -> RefChanId e -> HashRef -> m ()
+    downloadMissedHead sto chan headRef = do
+      penv <- ask
+      here <- liftIO $ hasBlock sto (fromHashRef headRef) <&> isJust
+      unless here do
+        refChanAddDownload env chan headRef (withPeerM penv . refChanOnHeadFn env chan . RefChanHeadBlockTran)
+
+    logMergeChan menv sto (chan, logs) = do
+
+      penv <- ask
+
+      void $ runMaybeT do
 
         let chanKey = RefChanLogKey @s chan
 
@@ -485,9 +496,8 @@ logMergeProcess env q = do
         -- если какие-то транзакции отсутствуют - пытаемся их скачать
         -- и надеемся на лучшее (лог сойдется в следующий раз)
         forM_ mergeSet $ \href -> do
-         here <- liftIO $ hasBlock sto (fromHashRef href) <&> isJust
+           mblk <- liftIO $ getBlock sto (fromHashRef href)
-         unless here do
+           maybe1 mblk (lift $ refChanAddDownload env chan href dontHandle) dontHandle
-           lift $ refChanAddDownload env chan href dontHandle
 
         r <- forM mergeSet $ \href -> runMaybeT do
 
@@ -500,13 +510,20 @@ logMergeProcess env q = do
                   Propose _ box -> do
                     (pk, ProposeTran headRef box) <- MaybeT $ pure $ unboxSignedBox0 box
                     (ak, _) <- MaybeT $ pure $ unboxSignedBox0 box
+
+                    lift $ lift $ downloadMissedHead sto chan headRef
+
                     hd <- MaybeT $ lift $ getHead menv headRef
+
                     let quo = view refChanHeadQuorum hd & fromIntegral
                     guard $ checkACL hd pk ak
                     pure [(href, (quo,mempty))]
 
                   Accept  _ box -> do
                     (pk, AcceptTran headRef hashRef) <- MaybeT $ pure $ unboxSignedBox0 box
+
+                    lift $ lift $ downloadMissedHead sto chan headRef
+
                     hd <- MaybeT $ lift $ getHead menv headRef
                     let quo = view refChanHeadQuorum hd & fromIntegral
                     guard $ HashMap.member pk (view refChanHeadPeers hd)
@@ -542,3 +559,5 @@ logMergeProcess env q = do
             updateRef sto chanKey nref
 
 
+
+