wip, waitForRepo fixed

hbs2-git3/app/GitRemoteHelper.hs

@@ -190,10 +190,9 @@ main =  flip runContT pure do
 
     cli <- parseCLI
 
-
     case cli of
       [ ListVal [_, RepoURL url ] ] -> do
-        debug $ "FUCKING REMOTE" <+> pretty (AsBase58 url)
+        notice $ "FUCKING REMOTE" <+> pretty (AsBase58 url)
         setGitRepoKey url
 
       _ -> none
@@ -202,8 +201,6 @@ main =  flip runContT pure do
 
     recover $ connectedDo do
 
-      waitRepo
-
       flip fix Plain $ \next -> \case
         Plain -> do
 

hbs2-git3/lib/HBS2/Git3/Repo.hs

@@ -43,78 +43,6 @@ data CInit =
   | CreateRepoDefBlock GitRepoKey
 
 
-data ReflogWaitTimeout =
-  ReflogWaitTimeout
-  deriving stock (Show,Typeable)
-
-instance Exception ReflogWaitTimeout
-
-waitRepo :: forall m . HBS2GitPerks m => Git3 m ()
-waitRepo = do
-  repoKey <- getGitRepoKey >>= orThrow GitRepoRefNotSet
-
-  lwwAPI   <- getClientAPI @LWWRefAPI @UNIX
-  peerAPI  <- getClientAPI @PeerAPI @UNIX
-  reflogAPI <- getClientAPI @RefLogAPI @UNIX
-
-  env <- ask
-
-  callRpcWaitMay @RpcLWWRefFetch (TimeoutSec 1) lwwAPI (LWWRefKey repoKey)
-    >>= orThrowUser "rpc timeout while subscribing to LWWRef"
-
-  let maxTimeout = ceiling 30e9 -- Максимальное время ожидания (30 секунд)
-  startTime <- getTimeCoarse
-
-  flip runContT pure do
-
-    let periodicFetch reflog = forever $ do
-          callRpcWaitMay @RpcRefLogFetch (TimeoutSec 1) reflogAPI reflog
-            >>= orThrowUser "rpc timeout while fetching reflog"
-          pause @'Seconds 10 -- Засыпаем на 10 секунд
-
-    let waitForReflog till reflog = do
-          now <- getTimeCoarse
-
-          if now > till
-            then throwIO ReflogWaitTimeout
-            else do
-              mhead <- callRpcWaitMay @RpcRefLogGet (TimeoutSec 1) reflogAPI (coerce reflog)
-              case mhead of
-                Just headVal -> do
-                  debug $ "waitRepo: Reflog data arrived" <+> pretty headVal
-
-                Nothing -> pause  @'Seconds 1 >> waitForReflog till reflog
-
-    let waitForLWWRef till = liftIO $ withGit3Env env do
-          now <- getTimeCoarse
-
-          if now > till
-            then throwIO RpcTimeout
-            else do
-              rv <- getRepoRefMaybe
-              maybe1 rv (pause @'Seconds 1 >> waitForLWWRef till) $ \LWWRef{..} -> do
-                debug $ "waitRepo: LWWRef arrived" <+> pretty lwwValue
-
-                -- Парсим манифест репозитория
-                repo <- getRepoManifest
-
-                -- Достаём `reflog`
-                reflog <- [ x | ListVal [SymbolVal "reflog", SignPubKeyLike x] <- repo ]
-                            & headMay
-                            & orThrowUser "malformed repo manifest"
-
-                -- Подписываемся на `reflog`
-                callRpcWaitMay @RpcPollAdd (TimeoutSec 1) peerAPI (reflog, "reflog", 17)
-                  >>= orThrowUser "rpc timeout while subscribing to reflog"
-
-                debug $ "waitRepo: Subscribed to reflog" <+> pretty (AsBase58 reflog)
-
-                -- Запускаем асинхронную задачу для периодического вызова RpcRefLogFetch
-                withAsync (periodicFetch reflog) $ \_ -> do
-                  -- Ждём появления значений в `reflog`
-                  waitForReflog till reflog
-
-    liftIO $ withGit3Env env $ waitForLWWRef (startTime + fromNanoSecs maxTimeout)
 
 initRepo :: forall m . HBS2GitPerks m => [Syntax C] -> Git3 m ()
 initRepo syn = do

hbs2-git3/lib/HBS2/Git3/State/Internal/Types.hs

@@ -346,14 +346,17 @@ recover m = fix \again -> do
         notice $ yellow $ "REPOKEY" <+> pretty (AsBase58 rk)
 
         connected <- Git3Connected soname sto peer refLogAPI lwwAPI
-                        <$> newTVarIO Nothing
+                        <$> newTVarIO (Just rk)
                         <*> newTVarIO Nothing
                         <*> newTVarIO defSegmentSize
                         <*> newTVarIO defCompressionLevel
                         <*> newTVarIO defIndexBlockSize
 
+
         liftIO $ withGit3Env connected do
 
+          waitRepo
+
           updateRepoKey rk
 
           ref <- getGitRemoteKey >>= orThrow GitRepoManifestMalformed
@@ -365,3 +368,80 @@ recover m = fix \again -> do
 
     e -> throwIO e
 
+data ReflogWaitTimeout =
+  ReflogWaitTimeout
+  deriving stock (Show,Typeable)
+
+instance Exception ReflogWaitTimeout
+
+waitRepo :: forall m . HBS2GitPerks m => Git3 m ()
+waitRepo = do
+  repoKey <- getGitRepoKey >>= orThrow GitRepoRefNotSet
+
+  lwwAPI   <- getClientAPI @LWWRefAPI @UNIX
+  peerAPI  <- getClientAPI @PeerAPI @UNIX
+  reflogAPI <- getClientAPI @RefLogAPI @UNIX
+
+  env <- ask
+
+  callRpcWaitMay @RpcPollAdd (TimeoutSec 1) peerAPI (repoKey, "lwwref", 31)
+    >>= orThrowUser "rpc timeout while subscribing to reflog"
+
+  callRpcWaitMay @RpcLWWRefFetch (TimeoutSec 1) lwwAPI (LWWRefKey repoKey)
+    >>= orThrowUser "rpc timeout while subscribing to LWWRef"
+
+  let maxTimeout = ceiling 30e9 -- Максимальное время ожидания (30 секунд)
+  startTime <- getTimeCoarse
+
+  flip runContT pure do
+
+    let periodicFetch reflog = forever $ do
+          callRpcWaitMay @RpcRefLogFetch (TimeoutSec 1) reflogAPI reflog
+            >>= orThrowUser "rpc timeout while fetching reflog"
+          pause @'Seconds 10 -- Засыпаем на 10 секунд
+
+    let waitForReflog till reflog = do
+          now <- getTimeCoarse
+
+          if now > till
+            then throwIO ReflogWaitTimeout
+            else do
+              mhead <- callRpcWaitMay @RpcRefLogGet (TimeoutSec 1) reflogAPI (coerce reflog)
+              case mhead of
+                Just headVal -> do
+                  debug $ "waitRepo: Reflog data arrived" <+> pretty headVal
+
+                Nothing -> pause  @'Seconds 1 >> waitForReflog till reflog
+
+    let waitForLWWRef till = liftIO $ withGit3Env env do
+          now <- getTimeCoarse
+
+          if now > till
+            then throwIO RpcTimeout
+            else do
+              rv <- getRepoRefMaybe
+              maybe1 rv (pause @'Seconds 1 >> waitForLWWRef till) $ \LWWRef{..} -> do
+                debug $ "waitRepo: LWWRef arrived" <+> pretty lwwValue
+
+                -- Парсим манифест репозитория
+                repo <- getRepoManifest
+
+                -- Достаём `reflog`
+                reflog <- [ x | ListVal [SymbolVal "reflog", SignPubKeyLike x] <- repo ]
+                            & headMay
+                            & orThrowUser "malformed repo manifest"
+
+                -- Подписываемся на `reflog`
+                callRpcWaitMay @RpcPollAdd (TimeoutSec 1) peerAPI (reflog, "reflog", 17)
+                  >>= orThrowUser "rpc timeout while subscribing to reflog"
+
+                debug $ "waitRepo: Subscribed to reflog" <+> pretty (AsBase58 reflog)
+
+                -- Запускаем асинхронную задачу для периодического вызова RpcRefLogFetch
+                withAsync (periodicFetch reflog) $ \_ -> do
+                  -- Ждём появления значений в `reflog`
+                  waitForReflog till reflog
+
+    liftIO $ withGit3Env env $ waitForLWWRef (startTime + fromNanoSecs maxTimeout)
+
+