wip

hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/DashBoard/State.hs

@@ -154,6 +154,8 @@ newtype RepoHeadTx = RepoHeadTx HashRef
                      deriving stock (Generic)
                      deriving newtype (ToField,FromField,Pretty)
 
+instance Serialise RepoHeadTx
+
 newtype RepoName = RepoName Text
                    deriving stock (Eq,Show,Generic)
                    deriving newtype (ToField,FromField,ToHtml,IsString,Pretty)
@@ -191,6 +193,8 @@ newtype RepoHeadRef = RepoHeadRef HashRef
                       deriving stock (Generic)
                       deriving newtype (ToField,FromField)
 
+instance Serialise RepoHeadRef
+
 
 newtype RepoHeadSeq = RepoHeadSeq Word64
                       deriving stock (Generic)
@@ -591,7 +595,7 @@ createRepoCommitTable  = do
   |]
 
 
-isProcessed :: (DashBoardPerks m) => HashRef -> DBPipeM m Bool
+isProcessed :: (MonadIO m) => HashRef -> DBPipeM m Bool
 isProcessed href = do
   select @(Only Int) [qc|select 1 from processed where hash = ? limit 1|] (Only href)
     <&> not . List.null

hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/DashBoard/State/Index/Peer.hs

@@ -7,6 +7,8 @@ import HBS2.Git.DashBoard.Manifest
 import HBS2.Git.Data.LWWBlock
 import HBS2.Git.Data.Tx.Git
 
+import HBS2.Hash
+
 import HBS2.System.Dir
 
 import Streaming.Prelude qualified as S
@@ -38,6 +40,7 @@ updateFixmeFor (RepoLww lw) f = do
 
   void $ runProcess cmd
 
+
 updateIndexFromPeer :: (DashBoardPerks m, MonadReader DashBoardEnv m) => m ()
 updateIndexFromPeer = do
   debug "updateIndexFromPeer"
@@ -77,9 +80,13 @@ updateIndexFromPeer = do
 
                   Right hxs -> do
                     for_ hxs $ \htx -> void $ runMaybeT do
-                      -- done  <- liftIO $ withDB db (isTxProcessed (HashVal htx))
-                      -- done1 <- liftIO $ withDB db (isTxProcessed (processedRepoTx (gitLwwRef,htx)))
-                      -- guard (not done && not done1)
+
+                      done <- lift $ withState $ isProcessed (HashRef $ hashObject @HbSync (serialise (lw,htx)))
+
+                      guard (not done)
+
+                      debug $ red "AAAAAAA" <+> pretty htx
+
                       getBlock sto (fromHashRef htx) >>= toMPlus
                          <&> deserialiseOrFail @(RefLogUpdate L4Proto)
                          >>= toMPlus
@@ -100,6 +107,8 @@ updateIndexFromPeer = do
           let rlwwseq = RepoLwwSeq (fromIntegral $ lwwSeq wv)
           insertRepoHead l rlwwseq (RepoRefLog rk) tx rh rhead
 
+          insertProcessed (HashRef $ hashObject @HbSync (serialise (l,coerce @_ @HashRef tx)))
+
           for_ fme $ \f -> do
             insertRepoFixme l rlwwseq f