wip

2025-01-22 06:17:59 +03:00 · 2025-01-22 06:17:59 +03:00 · f2027bb19e
parent d9cd91398a
commit f2027bb19e
12 changed files with 218 additions and 166 deletions
--- a/3
+++ b/3
@ -64,7 +64,8 @@ symlinks: $(BIN_DIR)
 >		path=`find dist-newstyle -type f -name $$bin -path "*$(GHC_VERSION)*" | head -n 1`; \
 >		if [ -n "$$path" ]; then \
 >			echo "Creating symlink for $$bin"; \
->			ln -sf $$PWD/$$path $(BIN_DIR)/$$bin; \
+>			ln -sfn $$PWD/$$path $(BIN_DIR)/$$bin; \
+#>			cp $$PWD/$$path $(BIN_DIR)/$$bin; \
 >		else \
 >			echo "Binary $$bin for GHC $(GHC_VERSION) not found"; \
 >		fi; \
--- a/flake.lock
+++ b/flake.lock
@ -18,6 +18,24 @@
        "type": "github"
      }
    },
+    "flake-utils_2": {
+      "inputs": {
+        "systems": "systems_2"
+      },
+      "locked": {
+        "lastModified": 1731533236,
+        "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
    "haskell-flake-utils": {
      "inputs": {
        "flake-utils": [
@ -62,6 +80,27 @@
        "type": "github"
      }
    },
+    "nixbwrap": {
+      "inputs": {
+        "flake-utils": "flake-utils_2",
+        "nixpkgs": [
+          "nixpkgs"
+        ]
+      },
+      "locked": {
+        "lastModified": 1667333413,
+        "narHash": "sha256-QGR6Src6UNXac3fgoe9PW40bAOYy0f05DGcRD2ae2S4=",
+        "ref": "refs/heads/master",
+        "rev": "a24e9553ee84d01aa2f9b35f30c75728864dfa52",
+        "revCount": 28,
+        "type": "git",
+        "url": "https://git.sr.ht/~fgaz/nix-bubblewrap"
+      },
+      "original": {
+        "type": "git",
+        "url": "https://git.sr.ht/~fgaz/nix-bubblewrap"
+      }
+    },
    "nixpkgs": {
      "locked": {
        "lastModified": 1727089097,
@ -83,6 +122,7 @@
        "flake-utils": "flake-utils",
        "haskell-flake-utils": "haskell-flake-utils",
        "hspup": "hspup",
+        "nixbwrap": "nixbwrap",
        "nixpkgs": "nixpkgs"
      }
    },
@ -100,6 +140,21 @@
        "repo": "default",
        "type": "github"
      }
+    },
+    "systems_2": {
+      "locked": {
+        "lastModified": 1681028828,
+        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+        "owner": "nix-systems",
+        "repo": "default",
+        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nix-systems",
+        "repo": "default",
+        "type": "github"
+      }
    }
  },
  "root": "root",
--- a/flake.nix
+++ b/flake.nix
@ -14,6 +14,9 @@ inputs = {
    hspup.inputs.nixpkgs.follows = "nixpkgs";
    hspup.inputs.haskell-flake-utils.follows = "haskell-flake-utils";

+    nixbwrap.url = "git+https://git.sr.ht/~fgaz/nix-bubblewrap";
+    nixbwrap.inputs.nixpkgs.follows = "nixpkgs";
+
 };

 outputs = { self, nixpkgs, flake-utils, ... }@inputs:
@ -159,6 +162,8 @@ outputs = { self, nixpkgs, flake-utils, ... }@inputs:
          pkgs.icu72
          pkgs.openssl
          weeder
+          pkgs.iptables
+          pkgs.bridge-utils
        ]
        ++
        [ pkgs.pkg-config
@ -166,6 +171,7 @@ outputs = { self, nixpkgs, flake-utils, ... }@inputs:
          pkgs.file
          pkgs.zlib
          inputs.hspup.packages.${pkgs.system}.default
+          inputs.nixbwrap.packages.${pkgs.system}.default
        ]
      );

--- a/hbs2-git3/app/GitRemoteHelper.hs
+++ b/hbs2-git3/app/GitRemoteHelper.hs
@ -114,13 +114,9 @@ localDict DeferredOps{..} = makeDict @C do

      t0 <- getTimeCoarse

-      flip fix 0 $ \next i -> do
-        importGitRefLog >>= \case
-          Just{} -> none
-          Nothing -> do
-            notice "wait for data..."
-            pause @'Seconds 2.0
-            next (succ i)
+      -- waitRepo Nothing
+
+      importGitRefLog

      rrefs <- importedRefs

@ -198,16 +194,17 @@ main =  flip runContT pure do

    cli <- parseCLI

-    case cli of
-      [ ListVal [_, RepoURL url ] ] -> do
-        notice $ "FUCKING REMOTE" <+> pretty (AsBase58 url)
-        setGitRepoKey url
+    url <- case cli of
+      [ ListVal [_, RepoURL x ] ] -> do
+        notice $ "FUCKING REMOTE" <+> pretty (AsBase58 x)
+        setGitRepoKey x
+        pure $ Just x

-      _ -> none
+      _ -> pure Nothing

-    void $ run dict conf
-
-    recover $ connectedDo do
+    recover $ connectedDo $ withStateDo do
+      void $ run dict conf
+      for_ url updateRepoKey

      flip fix Plain $ \next -> \case
        Plain -> do
--- a/hbs2-git3/app/Main.hs
+++ b/hbs2-git3/app/Main.hs
@ -82,7 +82,6 @@ main = flip runContT pure do
  cli <- parseTop (unlines $ unwords <$> splitForms argz)
           & either  (error.show) pure

-
  env <- nullGit3Env

  void $ lift $ withGit3Env env do
--- a/hbs2-git3/lib/HBS2/Git3/Config/Local.hs
+++ b/hbs2-git3/lib/HBS2/Git3/Config/Local.hs
@ -6,43 +6,15 @@ import HBS2.System.Dir

 import HBS2.Git.Local.CLI

-import System.Directory
-
-import Data.Config.Suckless.Script
-
-import Data.Text.IO qualified as IO
+import Control.Monad.Trans.Maybe

 {- HLINT ignore "Functor law"-}

-getConfigPath :: MonadIO m => m FilePath
+getConfigPath :: MonadIO m => m (Maybe FilePath)
 getConfigPath = do
-
  let name = ".hbs2-git3"
-
-  gitDir
-    >>= orThrowUser ".git not found"
-    <&> (</> name) . takeDirectory
-
-
-getConfigRootFile :: MonadIO m => m FilePath
-getConfigRootFile = do
-
-  let name = ".hbs2-git3"
-
-  gitDir
-    >>= orThrowUser ".git not found"
-    <&> (</> name) . takeDirectory
-    <&> (</> "config")
-
-readLocalConf :: MonadIO m => m [Syntax C]
-readLocalConf = do
-
-  conf <- getConfigPath <&> (</> "config")
-
-  touch conf
-
-  liftIO (IO.readFile conf)
-    <&> parseTop
-    >>= either (const $ pure mempty) pure
+  runMaybeT do
+    gitDir
+      >>= toMPlus <&> (</> name) . takeDirectory


--- a/hbs2-git3/lib/HBS2/Git3/Export.hs
+++ b/hbs2-git3/lib/HBS2/Git3/Export.hs
@ -86,7 +86,7 @@ exportEntries prefix = do
    export (Just h) refs

 export :: forall m . HBS2GitPerks m => Maybe GitHash -> [(GitRef, GitHash)] -> Git3 m ()
-export mbh refs = do
+export mbh refs = withStateDo do
      tn <- getNumCapabilities

      updateReflogIndex
@ -281,9 +281,11 @@ export mbh refs = do
 where

   writeLogEntry e = do
-     path <- getConfigPath <&> (</> "log")
-     touch path
-     liftIO (IO.appendFile path (show $ e <> line))
+     path' <- getConfigPath
+     for_ path' $ \path -> do
+       let logPath = path </> "log"
+       touch path
+       liftIO (IO.appendFile logPath (show $ e <> line))

   writeRefSectionSome :: forall m1 . MonadIO m1 => TBQueue (Maybe LBS.ByteString) -> [(GitRef, GitHash)] -> m1 ()
   writeRefSectionSome sourceQ refsAndCommits = do
--- a/hbs2-git3/lib/HBS2/Git3/Import.hs
+++ b/hbs2-git3/lib/HBS2/Git3/Import.hs
@ -106,15 +106,15 @@ writeAsGitPack dir href = do


 importGitRefLog :: forall m . ( HBS2GitPerks m
-                              , HasStorage m
-                              , HasClientAPI PeerAPI UNIX m
-                              , HasClientAPI RefLogAPI UNIX m
-                              , HasGitRemoteKey m
-                              , MonadReader Git3Env m
+                              -- , HasStorage m
+                              -- , HasClientAPI PeerAPI UNIX m
+                              -- , HasClientAPI RefLogAPI UNIX m
+                              -- , HasGitRemoteKey m
+                              -- , MonadReader Git3Env m
                              )
-             => m (Maybe HashRef)
+             => Git3 m (Maybe HashRef)

-importGitRefLog = do
+importGitRefLog = withStateDo do

  updateReflogIndex

--- a/hbs2-git3/lib/HBS2/Git3/Run.hs
+++ b/hbs2-git3/lib/HBS2/Git3/Run.hs
@ -55,7 +55,7 @@ theDict = do

  where

-    myEntries = hidePrefix "test:" do
+    myEntries =  do
        entry $ bindMatch "--help" $ nil_ $ \case
          HelpEntryBound what -> do
            helpEntry what
@ -432,34 +432,6 @@ compression      ;  prints compression level
        entry $ bindMatch "reflog:refs:raw" $ nil_ $ \syn -> lift $ connectedDo do
          refsFiles >>= readRefsRaw >>= liftIO . mapM_ (print . pretty)

-        -- entry $ bindMatch "reflog:refs:trimmed" $ nil_ $ \syn -> lift $ connectedDo do
-        --   txi <- txImported
-        --   raw <- readRefsRaw =<< refsFiles
-
-        --   ni_  <- newTQueueIO
-        --   imp_ <- newTVarIO ( mempty :: HashMap Text (Integer, GitHash, HashRef) )
-
-        --   for_ raw $ \case
-        --     ListVal [ SymbolVal "R", HashLike seg, LitIntVal r, GitHashLike v, TextLike n ] -> do
-
-        --       atomically do
-        --         if not (HS.member seg txi) then
-        --           writeTQueue ni_ (n, (r, v, seg))
-        --         else do
-        --           let x = (r, v, seg)
-        --           let fn = HM.insertWith (\a b -> if view _1 a > view _1 b then a else b) n x
-        --           modifyTVar imp_ fn
-
-        --     _ -> none
-
-        --   result <- atomically do
-        --         a <- STM.flushTQueue ni_
-        --         b <- readTVar imp_ <&> HM.toList
-        --         pure (a <> b)
-
-        --   for_ result $ \(n, (r, h, v)) -> do
-        --     liftIO $ print $ "R" <+> pretty h <+> pretty r <+> pretty v <+> pretty n
-
        entry $ bindMatch "reflog:wait" $ nil_ $ \syn -> lift $ connectedDo do
          let (_,argz) = splitOpts [] syn
          let t = headMay [ realToFrac x | LitIntVal x <- argz ]
--- a/hbs2-git3/lib/HBS2/Git3/State.hs
+++ b/hbs2-git3/lib/HBS2/Git3/State.hs
@ -53,6 +53,8 @@ getRefLog mf = lastMay [ x
 updateRepoKey :: forall m . HBS2GitPerks m => GitRepoKey -> Git3 m ()
 updateRepoKey key = do

+  notice $ "updateRepoKey" <+> pretty (AsBase58 key)
+
  setGitRepoKey key

  reflog <- getRepoManifest <&> getRefLog
@ -137,6 +139,11 @@ withGit3Env env a = runReaderT (fromGit3 a) env
 runGit3 :: Git3Perks m => Git3Env -> Git3 m b -> m b
 runGit3 env action = withGit3Env env action

+withStateDo :: MonadUnliftIO m => Git3 m a -> Git3 m a
+withStateDo action = do
+  waitRepo Nothing
+  getStatePathM >>= mkdir
+  action

 recover :: Git3 IO a -> Git3 IO a
 recover m = fix \again -> do
@ -170,12 +177,13 @@ recover m = fix \again -> do

        let sto = AnyStorage (StorageClient storageAPI)

-        rk <- lift $ getGitRepoKey >>= orThrow GitRepoRefNotSet
+        rk <- lift $ getGitRepoKey

-        notice $ yellow $ "REPOKEY" <+> pretty (AsBase58 rk)
+        -- debug $ yellow $ "REPOKEY" <+> pretty (AsBase58 rk)

        connected <- Git3Connected soname sto peer refLogAPI lwwAPI
-                        <$> newTVarIO (Just rk)
+                        <$> newTVarIO rk
+                        <*> newTVarIO Nothing
                        <*> newTVarIO Nothing
                        <*> newTVarIO defSegmentSize
                        <*> newTVarIO defCompressionLevel
@ -183,14 +191,10 @@ recover m = fix \again -> do


        liftIO $ withGit3Env connected do
-
-          updateRepoKey rk
-
-          ref <- getGitRemoteKey >>= orThrow GitRepoManifestMalformed
-
-          state <- getStatePath (AsBase58 ref)
-          mkdir state
-
+          -- updateRepoKey rk
+          -- ref <- getGitRemoteKey >>= orThrow GitRepoManifestMalformed
+          -- state <- getStatePathM
+          -- mkdir state
          again

    e -> throwIO e
@ -212,69 +216,89 @@ waitRepo :: forall m . HBS2GitPerks m => Maybe (Timeout 'Seconds) -> Git3 m ()
 waitRepo timeout = do
  repoKey <- getGitRepoKey >>= orThrow GitRepoRefNotSet

-  lwwAPI   <- getClientAPI @LWWRefAPI @UNIX
-  peerAPI  <- getClientAPI @PeerAPI @UNIX
-  reflogAPI <- getClientAPI @RefLogAPI @UNIX
-  sto <- getStorage
+  notice $ yellow "waitRepo"

-  env <- ask
+  ask >>= \case
+    Git3Disconnected{} -> throwIO Git3PeerNotConnected
+    Git3Connected{..} -> do

-  flip runContT pure do
+      sto <- getStorage

-    let wait w what x = pause @'Seconds w >> what x
+      flip runContT pure $ callCC \done -> do

-    callCC \forPeer -> do
+        rlv <- readTVarIO gitRefLogVal <&> isJust
+        rlog <- readTVarIO gitRefLog <&> isJust

-      notice "wait for peer"
+        when (rlv && rlog) $ done ()

-      lift (callRpcWaitMay @RpcPollAdd (TimeoutSec 1) peerAPI (repoKey, "lwwref", 31))
-               >>= maybe (wait 1 forPeer ()) (const none)
+        reflog_ <- newEmptyTMVarIO

-    pFetch <- ContT $ withAsync $ forever do
-                void  (callRpcWaitMay @RpcLWWRefFetch (TimeoutSec 1) lwwAPI (LWWRefKey repoKey))
-                pause @'Seconds 10
+        let wait w what x = pause @'Seconds w >> what x

-    lww <- flip fix () \next _ -> do
-              notice $ "wait for" <+> pretty (AsBase58 repoKey)
-              lift (callRpcWaitMay @RpcLWWRefGet (TimeoutSec 1) lwwAPI (LWWRefKey repoKey))
-                >>= \case
-                       Just (Just x)  -> pure x
-                       _              -> wait 2 next ()
+        callCC \forPeer -> do

-    notice $ "lwwref value" <+> pretty (lwwValue lww)
+          notice "wait for peer"

-    error "stop"
+          lift (callRpcWaitMay @RpcPollAdd (TimeoutSec 1) peerAPI (repoKey, "lwwref", 31))
+                   >>= maybe (wait 1 forPeer ()) (const none)

-    mf <- flip fix () $ \next _ -> do
-              notice $ "wait for manifest"
-              lift (try @_ @WalkMerkleError getRepoManifest) >>= \case
-                Left{}  -> wait 1 next ()
-                Right x -> pure x
+        pFetch <- ContT $ withAsync $ forever do
+                    void  (callRpcWaitMay @RpcLWWRefFetch (TimeoutSec 1) lwwAPI (LWWRefKey repoKey))
+                    pause @'Seconds 10

-    reflog <- getRefLog mf & orThrow GitRepoManifestMalformed
+        pFetchRefLog <- ContT $ withAsync do
+                         r <- atomically $ takeTMVar reflog_
+                         forever do
+                           void  (callRpcWaitMay @RpcRefLogFetch (TimeoutSec 1) reflogAPI r)
+                           pause @'Seconds 10

-    lift $ setGitRepoKey reflog
+        lww <- flip fix () \next _ -> do
+                  notice $ "wait for" <+> pretty (AsBase58 repoKey)
+                  lift (callRpcWaitMay @RpcLWWRefGet (TimeoutSec 1) lwwAPI (LWWRefKey repoKey))
+                    >>= \case
+                           Just (Just x)  -> pure x
+                           _              -> wait 2 next ()

-    rv <- flip fix () \next _ -> do
-              notice $ "wait for data" <+> pretty (AsBase58 reflog)
-              lift (callRpcWaitMay @RpcRefLogGet (TimeoutSec 1) reflogAPI reflog)
-                >>= \case
-                       Just (Just x)  -> pure x
-                       _              -> wait 2 next ()
+        notice $ "lwwref value" <+> pretty (lwwValue lww)

-    okay <- newEmptyTMVarIO
+        mf <- flip fix () $ \next _ -> do
+                  notice $ "wait for manifest"
+                  lift (try @_ @WalkMerkleError getRepoManifest) >>= \case
+                    Left{}  -> wait 1 next ()
+                    Right x -> pure x

-    flip fix () $ \next _ -> do
-       notice $ "wait for data (2)" <+> pretty (AsBase58 reflog)
-       missed <- findMissedBlocks sto rv
-       unless (L.null missed) $ wait 2 next ()
-       atomically $ writeTMVar okay True
-
-    pWait <- ContT $ withAsync $ race ( pause (fromMaybe 300 timeout) ) do
-               void $ atomically $ takeTMVar okay
-
-    waitAnyCatchCancel [pWait, pFetch]
-
-    liftIO $ print $ "reflog" <+> pretty (AsBase58 reflog) <+> pretty rv
+        reflog <- getRefLog mf & orThrow GitRepoManifestMalformed
+
+
+        atomically $ writeTMVar reflog_ reflog
+
+        lift (callRpcWaitMay @RpcPollAdd (TimeoutSec 1) peerAPI (reflog, "reflog", 11))
+                 >>= orThrow RpcTimeout
+
+        rv <- flip fix () \next _ -> do
+                  notice $ "wait for data" <+> pretty (AsBase58 reflog)
+                  lift (callRpcWaitMay @RpcRefLogGet (TimeoutSec 1) reflogAPI reflog)
+                    >>= \case
+                           Just (Just x)  -> pure x
+                           _              -> wait 2 next ()
+
+        atomically $ writeTVar gitRefLogVal (Just rv)
+
+        okay <- newEmptyTMVarIO
+
+        flip fix () $ \next _ -> do
+           notice $ "wait for data (2)" <+> pretty (AsBase58 reflog)
+           missed <- findMissedBlocks sto rv
+           unless (L.null missed) $ wait 2 next ()
+           atomically $ writeTMVar okay True
+
+        pWait <- ContT $ withAsync $ race ( pause (fromMaybe 300 timeout) ) do
+                   void $ atomically $ takeTMVar okay
+
+        waitAnyCatchCancel [pWait, pFetch, pFetchRefLog]
+
+        lift $ updateRepoKey repoKey
+
+        liftIO $ print $ "reflog" <+> pretty (AsBase58 reflog) <+> pretty rv


--- a/hbs2-git3/lib/HBS2/Git3/State/Internal/Index.hs
+++ b/hbs2-git3/lib/HBS2/Git3/State/Internal/Index.hs
@ -73,9 +73,8 @@ indexPath :: forall m . ( Git3Perks m
                        , MonadReader Git3Env m
                        , HasGitRemoteKey m
                        ) => m FilePath
-indexPath = do
-  reflog <- getGitRemoteKey >>= orThrow Git3ReflogNotSet
-  getStatePath (AsBase58 reflog)
+
+indexPath = getStatePathM

 data IndexEntry =
  IndexEntry
@ -129,8 +128,7 @@ mergeSortedFilesN getKey inputFiles outFile = do

 compactIndex :: forall m . (Git3Perks m, HasGitRemoteKey m, MonadReader Git3Env m) => Natural -> m ()
 compactIndex maxSize = do
-  reflog <- getGitRemoteKey >>= orThrowUser "reflog not set"
-  idxPath <- getStatePath (AsBase58 reflog)
+  idxPath <- getStatePathM
  mkdir idxPath
  files <- listObjectIndexFiles <&> L.sortOn snd

--- a/hbs2-git3/lib/HBS2/Git3/State/Internal/Types.hs
+++ b/hbs2-git3/lib/HBS2/Git3/State/Internal/Types.hs
@ -9,23 +9,49 @@ import HBS2.Git3.Prelude
 import HBS2.Git3.Config.Local
 import HBS2.System.Dir

+import Data.Config.Suckless.Script
+
 import Data.Kind
 import Data.HashSet (HashSet)
 import Data.HashSet qualified as HS
+import Data.Maybe
+import Data.Text.IO qualified as IO
+import Control.Exception qualified as E

 unit :: FilePath
 unit = "hbs2-git"

-getStatePath :: (MonadIO m, Pretty ref) => ref -> m FilePath
-getStatePath p = do
-  d <- getConfigPath
+getStatePath :: (MonadIO m, Pretty ref) => ref -> m (Maybe FilePath)
+getStatePath p = runMaybeT do
+  d <- getConfigPath >>= toMPlus
  pure $ d </> show (pretty p)

+getConfigRootFile :: MonadIO m => m FilePath
+getConfigRootFile = do
+  getConfigPath
+    >>= orThrow StateDirNotDefined
+    <&> (</> "config")
+
+readLocalConf :: MonadIO m => m [Syntax C]
+readLocalConf = do
+
+  fromMaybe mempty <$> runMaybeT do
+
+    conf <- liftIO (E.try @SomeException getConfigRootFile)
+              >>= toMPlus
+
+    lift $ touch conf
+
+    liftIO (IO.readFile conf)
+      <&> parseTop
+      >>= either (const $ pure mempty) pure
+
 data HBS2GitExcepion =
    RefLogNotSet
  | GitRepoRefNotSet
  | GitRepoRefEmpty
  | GitRepoManifestMalformed
+  | StateDirNotDefined
  | RefLogCredentialsNotMatched
  | RefLogNotReady
  | RpcTimeout
@ -76,13 +102,14 @@ data Git3Env =
    , gitRepoKey           :: TVar (Maybe GitRepoKey)
    }
  | Git3Connected
-    { peerSocket  :: FilePath
-    , peerStorage :: AnyStorage
-    , peerAPI     :: ServiceCaller PeerAPI UNIX
-    , reflogAPI   :: ServiceCaller RefLogAPI UNIX
-    , lwwAPI      :: ServiceCaller LWWRefAPI UNIX
-    , gitRepoKey  :: TVar (Maybe GitRepoKey)
-    , gitRefLog   :: TVar (Maybe GitRemoteKey)
+    { peerSocket   :: FilePath
+    , peerStorage  :: AnyStorage
+    , peerAPI      :: ServiceCaller PeerAPI UNIX
+    , reflogAPI    :: ServiceCaller RefLogAPI UNIX
+    , lwwAPI       :: ServiceCaller LWWRefAPI UNIX
+    , gitRepoKey   :: TVar (Maybe GitRepoKey)
+    , gitRefLog    :: TVar (Maybe GitRemoteKey)
+    , gitRefLogVal :: TVar (Maybe HashRef)
    , gitPackedSegmentSize :: TVar Int
    , gitCompressionLevel  :: TVar Int
    , gitIndexBlockSize :: TVar Natural
@ -178,9 +205,8 @@ instance (MonadUnliftIO m) => HasClientAPI LWWRefAPI UNIX (Git3 m) where
       Git3Disconnected{} -> throwIO Git3PeerNotConnected
       Git3Connected{..} -> pure lwwAPI

-
 getStatePathM :: forall m . (HBS2GitPerks m, HasGitRemoteKey m) => m FilePath
 getStatePathM = do
  k <- getGitRemoteKey >>= orThrow RefLogNotSet
-  getStatePath (AsBase58 k)
+  getStatePath (AsBase58 k) >>= orThrow StateDirNotDefined