From 89400efefaac72712382c5b08c41979eea6a78d7 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Wed, 27 Mar 2024 09:59:05 +0300
Subject: [PATCH] wip

---
 .../lib/HBS2/Git/Oracle/Facts.hs              |  2 ++
 .../lib/HBS2/Git/Oracle/Run.hs                | 19 +++++++++++++------
 .../lib/HBS2/Git/Oracle/State.hs              |  8 +++++++-
 3 files changed, 22 insertions(+), 7 deletions(-)

diff --git a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Facts.hs b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Facts.hs
index 73e0e3e5..dc57f992 100644
--- a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Facts.hs
+++ b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Facts.hs
@@ -1,6 +1,7 @@
 module HBS2.Git.Oracle.Facts where
 
 import HBS2.Git.Oracle.Prelude
+import HBS2.Hash
 import Data.Word
 import Codec.Serialise
 
@@ -63,3 +64,4 @@ instance Pretty GitRepoHeadFact where
 instance Pretty GitRepoHeadVersionFact where
   pretty (GitRepoHeadVersionFact1 v) = pretty v
 
+
diff --git a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs
index 942179ac..002993e4 100644
--- a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs
+++ b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs
@@ -84,8 +84,9 @@ runOracleIndex auPk = do
 
                     Right hxs -> do
                       for_ hxs $ \htx -> void $ runMaybeT do
-                        done <- liftIO $ withDB db (isTxProcessed (HashVal htx))
-                        guard (not done)
+                        done  <- liftIO $ withDB db (isTxProcessed (HashVal htx))
+                        done1 <- liftIO $ withDB db (isTxProcessed (processedRepoTx (gitLwwRef,htx)))
+                        guard (not done && not done1)
                         getBlock sto (fromHashRef htx) >>= toMPlus
                            <&> deserialiseOrFail @(RefLogUpdate L4Proto)
                            >>= toMPlus
@@ -139,7 +140,7 @@ runOracleIndex auPk = do
     debug $ "posted tx" <+> pretty (hashObject @HbSync (serialise f))
 
   -- FIXME: ASAP-wait-refchan-actually-updated
-  pause @'Seconds 0.25
+  -- pause @'Seconds 0.25
 
   updateState
 
@@ -294,6 +295,7 @@ updateState = do
   chan  <- asks _refchanId
   rchanAPI <- asks _refchanAPI
   sto  <- asks  _storage
+  db   <- asks _db
 
   void $ runMaybeT do
 
@@ -306,6 +308,8 @@ updateState = do
         Right txs -> do
           -- FIXME: skip-already-processed-blocks
           for_ txs $ \htx -> void $ runMaybeT do
+            done <- liftIO $ withDB db (isTxProcessed (HashVal htx))
+            guard (not done)
             getBlock sto (fromHashRef htx)
              >>= toMPlus
              <&> deserialiseOrFail @(RefChanUpdate L4Proto)
@@ -320,7 +324,7 @@ updateState = do
              <&> snd
              <&> deserialiseOrFail @GitRepoFacts . LBS.fromStrict
              >>= toMPlus
-             >>= lift . S.yield
+             >>= lift . S.yield . (htx,)
 
     let rf  = [ (HashRef (hashObject $ serialise f), f)
               | f@GitRepoFact1{} <-  universeBi facts
@@ -338,8 +342,11 @@ updateState = do
 
       transactional do
 
-        for_ done $ \(r,t) -> do
-          debug $ red "DONE" <+> pretty (r,t)
+        for_ done $ \w -> do
+          insertTxProcessed (processedRepoTx w)
+
+        for_  facts $ \(t,_) -> do
+          insertTxProcessed (HashVal t)
 
         for_ (HM.toList rf) $ \(k, GitRepoFact1{..}) -> do
 
diff --git a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/State.hs b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/State.hs
index f37748df..62d74e3f 100644
--- a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/State.hs
+++ b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/State.hs
@@ -1,12 +1,16 @@
 module HBS2.Git.Oracle.State where
 
 import HBS2.Git.Oracle.Prelude
+import HBS2.Hash
 import DBPipe.SQLite
 
 import Data.Coerce
 import Text.InterpolatedString.Perl6 (qc)
 import Data.Word
 
+processedRepoTx :: (LWWRefKey HBS2Basic, HashRef) -> HashVal
+processedRepoTx w = HashVal $ HashRef $ hashObject @HbSync (serialise w)
+
 evolveDB :: MonadUnliftIO m => DBPipeM m ()
 evolveDB = do
   debug $ yellow "evolveDB"
@@ -124,8 +128,10 @@ insertTxProcessed hash = do
 isTxProcessed :: MonadUnliftIO m => HashVal -> DBPipeM m Bool
 isTxProcessed hash = do
   results <- select [qc|
-    select 1 from txprocessed where hash = ?
+    select 1 from txprocessed where hash = ? limit 1
   |] (Only hash)
   pure $ not $ null (results :: [Only Int])
 
 
+
+