fixing-cpu-burning-and-further-optimizations

examples/refchan-qblf/app/RefChanQBLFMain.hs

@@ -241,10 +241,22 @@ instance (ForConsensus m)  => IsQBLF ConsensusQBLF (App m) where
     let sk = view peerSignSk creds
     let pk = view peerSignPk creds
 
-    -- let block = serialise (HashSet.toList $ HashSet.fromList txs)
+    -- основная проблема в том, что мы пересортировываем весь state
+    -- однако, если считать его уже отсортированным, то, может быть,
+    -- все будет не так уж плохо.
+    -- так-то мы можем вообще его на диске держать
 
+    root <- if List.null txs then do
+              pure h0
+            else do
               hashes <- liftIO $ mapM (putBlock sto . serialise) txs <&> catMaybes
 
+              current <- readLog (getBlock sto) h0
+
+              let new = HashSet.fromList ( current <> fmap HashRef hashes )
+
+              let pt = toPTree (MaxSize 256) (MaxNum 256) (HashSet.toList new)
+
               -- пробуем разослать бандлы с транзакциями
               runMaybeT do
                 ref <- MaybeT $ createBundle sto (fmap HashRef hashes)
@@ -252,19 +264,6 @@ instance (ForConsensus m)  => IsQBLF ConsensusQBLF (App m) where
                 r <- MaybeT $ liftIO $ putBlock sto (serialise refval)
                 lift $ request self (ActionRequest @UNIX chan (RefChanAnnounceBlock (HashRef r)))
 
-    current <- readLog (getBlock sto) h0
-
-    -- основная проблема в том, что мы пересортировываем весь state
-    -- однако, если считать его уже отсортированным, то, может быть,
-    -- все будет не так уж плохо.
-    -- так-то мы можем вообще его на диске держать
-    let new = HashSet.fromList ( current <> fmap HashRef hashes )
-
-    let pt = toPTree (MaxSize 256) (MaxNum 256) (HashSet.toList new)
-
-    root <- if List.null hashes then do
-              pure h0
-            else do
               r <- makeMerkle 0 pt $ \(hx,_,bs) -> do
                 th <- liftIO (enqueueBlock sto bs)
                 debug $ "WRITE TX" <+> pretty hx
@@ -320,9 +319,14 @@ instance (ForConsensus m)  => IsQBLF ConsensusQBLF (App m) where
     sto <- asks mySto
     let readFn = liftIO . getBlock sto
 
-    tx0 <- readLog readFn (fromDAppState s0) <&> HashSet.fromList
     tx1 <- mapM (readLog readFn) (fmap fromDAppState s1) <&> mconcat
+    tx0 <- readLog readFn (fromDAppState s0) <&> HashSet.fromList
 
+    let txNew = HashSet.fromList tx1 `HashSet.difference` tx0
+
+    if List.null txNew then do
+      pure s0
+    else do
       debug $ "READ TXS" <+> pretty s1 <+> pretty (length tx1)
 
       r <- forM tx1 $ \t -> runMaybeT do
@@ -478,7 +482,7 @@ fetchMissed env s = do
   when here do
     liftIO $ Cache.delete cache href
 
-  unless (here && not wip) do
+  unless (here || wip) do
     debug $ "We might be need to fetch" <+> pretty s
     liftIO $ Cache.insert cache href ()
     request @UNIX tube (ActionRequest @UNIX chan (RefChanFetch (fromDAppState s)))