wip, about to remove repo:ref

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

@@ -2,6 +2,7 @@ module HBS2.Git3.Repo.Fork (forkEntries) where
 
 import HBS2.Git3.Prelude
 import HBS2.Git3.State
+import HBS2.Git3.Import
 import HBS2.Git3.Repo.Init
 import HBS2.Git3.Git
 import HBS2.Data.Detect
@@ -65,8 +66,8 @@ hbs2-git repo:fork EvP3kskPVuKuKVMUc3LnfdW7GcFYjz6f5fFU1EGzrdgk
         [ SignPubKeyLike forked ] -> lift do
 
           connectedDo do
-            setGitRepoKey forked
-            waitRepo Nothing
+            waitRepo Nothing forked
+            importGitRefLog
 
           -- hereGit <- gitDir
 

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

@@ -409,7 +409,7 @@ compression      ;  prints compression level
 
         entry $ bindMatch "reflog:tx:list" $ nil_ $ \syn -> lift $ connectedDo do
 
-          waitRepo Nothing
+          waitRepo Nothing =<< getGitRepoKeyThrow
 
           let (opts, _) = splitOpts [ ("--checkpoints",0)
                                     , ("--segments",0)
@@ -433,21 +433,29 @@ compression      ;  prints compression level
             forM_ decoded print
 
         entry $ bindMatch "reflog:refs" $ nil_ $ \syn -> lift $ connectedDo do
-          waitRepo Nothing
+
+          waitRepo Nothing =<< getGitRepoKeyThrow
+
           rrefs <- importedRefs
           for_  rrefs $ \(r,h) -> do
             liftIO $ print $ fill 20  (pretty h) <+> pretty r
 
         entry $ bindMatch "reflog:refs:raw" $ nil_ $ \syn -> lift $ connectedDo do
-          waitRepo Nothing
+
+          waitRepo Nothing =<< getGitRepoKeyThrow
+
           refsFiles >>= readRefsRaw >>= liftIO . mapM_ (print . pretty)
 
         entry $ bindMatch "repo:wait" $ nil_ $ \syn -> lift $ connectedDo do
           let (_,argz) = splitOpts [] syn
+
           let t = headMay [ realToFrac x | LitIntVal x <- argz ]
-          waitRepo t
+
+          waitRepo t =<< getGitRepoKeyThrow
+
           getRepoManifest >>= liftIO . print . pretty . mkForm "manifest" . coerce
 
+
         entry $ bindMatch "reflog:imported" $ nil_ $ \syn -> lift $ connectedDo do
           p <- importedCheckpoint
           liftIO $ print $ pretty p
@@ -469,7 +477,9 @@ compression      ;  prints compression level
             liftIO $ print $ pretty (AsBase58 reflog)
 
         entry $ bindMatch "repo:credentials" $ nil_ $ const $ lift $ connectedDo $ do
-          waitRepo (Just 10)
+
+          waitRepo (Just 10) =<< getGitRepoKeyThrow
+
           (p,_) <- getRepoRefLogCredentials
           liftIO $ print $ pretty $ mkForm @C "matched" [mkSym (show $ pretty ( AsBase58 p) )]
 
@@ -501,7 +511,8 @@ repo:ref ; shows current repo key
         entry $ bindMatch "repo:relay-only" $ nil_ $ \case
           [ SignPubKeyLike repo ] -> lift $ connectedDo do
             setGitRepoKey repo
-            waitRepo (Just 2)
+
+            waitRepo (Just 2) =<< getGitRepoKeyThrow
 
           _ -> throwIO (BadFormException @C nil)
 

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

@@ -144,7 +144,9 @@ runGit3 env action = withGit3Env env action
 
 withStateDo :: MonadUnliftIO m => Git3 m a -> Git3 m a
 withStateDo action = do
-  waitRepo Nothing
+
+  waitRepo Nothing =<< getGitRepoKeyThrow
+
   getStatePathM >>= mkdir
   action
 
@@ -216,11 +218,13 @@ data CWRepo =
   | CAborted
 
 
-waitRepo :: forall m . HBS2GitPerks m => Maybe (Timeout 'Seconds) -> Git3 m ()
-waitRepo timeout = do
-  repoKey <- getGitRepoKey >>= orThrow GitRepoRefNotSet
+waitRepo :: forall m . HBS2GitPerks m
+         => Maybe (Timeout 'Seconds)
+         -> GitRepoKey
+         -> Git3 m ()
+waitRepo timeout repoKey = do
 
-  notice $ yellow "waitRepo"
+  notice $ yellow "waitRepo" <+> pretty (AsBase58 repoKey)
 
   ask >>= \case
     Git3Disconnected{} -> throwIO Git3PeerNotConnected
@@ -263,6 +267,8 @@ waitRepo timeout = do
                            Just (Just x)  -> pure x
                            _              -> wait 2 next ()
 
+        setGitRepoKey repoKey
+
         notice $ "lwwref value" <+> pretty (lwwValue lww)
 
         mf <- flip fix () $ \next _ -> do

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

@@ -165,6 +165,9 @@ instance (MonadIO m) => HasGitRemoteKey (Git3 m) where
     e <- ask
     liftIO $ atomically $ writeTVar (gitRepoKey e) (Just k)
 
+getGitRepoKeyThrow :: (MonadIO m, HasGitRemoteKey m) => m GitRepoKey
+getGitRepoKeyThrow = getGitRepoKey >>= orThrow GitRepoRefNotSet
+
 instance (MonadIO m, HasGitRemoteKey (Git3 m)) => HasGitRemoteKey (ContT whatever (Git3 m)) where
   getGitRemoteKey = lift getGitRemoteKey
   getGitRepoKey = lift getGitRepoKey