From baed40f7c682a7197bc272b3930d82d593f6265a Mon Sep 17 00:00:00 2001
From: voidlizard <dzuikov@gmail.com>
Date: Fri, 24 Jan 2025 07:01:00 +0300
Subject: [PATCH] wip

---
 hbs2-git3/app/GitRemoteHelper.hs | 36 --------------------------------
 hbs2-git3/lib/HBS2/Git3/Repo.hs  | 20 ++++++++++++++++--
 2 files changed, 18 insertions(+), 38 deletions(-)

diff --git a/hbs2-git3/app/GitRemoteHelper.hs b/hbs2-git3/app/GitRemoteHelper.hs
index 8e27f1c2..6f319904 100644
--- a/hbs2-git3/app/GitRemoteHelper.hs
+++ b/hbs2-git3/app/GitRemoteHelper.hs
@@ -48,27 +48,6 @@ parseCLI = do
   parseTop (unlines $ unwords <$> splitForms argz)
            & either  (error.show) pure
 
--- parseURL :: String -> Maybe (LWWRefKey 'HBS2Basic)
--- parseURL s = eitherToMaybe $ Atto.parseOnly p (BS8.pack s)
---   where
---     p = do
---       void $ string "hbs21://" <|> string "hbs2://"
-
---       Atto.takeWhile1 (`elem` getAlphabet)
---        <&> BS8.unpack
---        <&> fromStringMay @(LWWRefKey 'HBS2Basic)
---        >>= maybe (fail "invalid reflog key") pure
-
--- parsePush :: String -> Maybe (Maybe GitRef, GitRef)
--- parsePush s = eitherToMaybe $ Atto.parseOnly p (BS8.pack s)
---   where
---     gitref = fromString @GitRef . BS8.unpack
---     p = do
---       a <- optional (Atto.takeWhile1 (/= ':')) <&> fmap gitref
---       char ':'
---       b <- Atto.takeWhile1 (const True) <&> gitref
---       pure (a,b)
-
 data S =
     Plain
   | Push
@@ -81,23 +60,8 @@ data DeferredOps =
   { exportQ :: TQueue (GitRef, Maybe GitHash)
   }
 
-pattern RepoURL :: GitRemoteKey -> Syntax C
-pattern RepoURL x <- (isRepoURL -> Just x)
-
-isRepoURL :: Syntax C -> Maybe GitRemoteKey
-isRepoURL = \case
-  TextLike xs -> case mkStr @C <$> headMay (drop 1  (Text.splitOn "://" xs)) of
-    Just (SignPubKeyLike puk) -> Just puk
-    _ -> Nothing
-
-  _ -> Nothing
-
 
 localDict  :: forall m . ( HBS2GitPerks m
-                      -- , HasClientAPI PeerAPI UNIX m
-                      -- , HasStorage m
-                      -- , HasGitRemoteKey m
-                      -- , HasStateDB m
                       )
             => DeferredOps -> Dict C (Git3 m)
 
diff --git a/hbs2-git3/lib/HBS2/Git3/Repo.hs b/hbs2-git3/lib/HBS2/Git3/Repo.hs
index 2e7c2f98..9cbaca75 100644
--- a/hbs2-git3/lib/HBS2/Git3/Repo.hs
+++ b/hbs2-git3/lib/HBS2/Git3/Repo.hs
@@ -1,9 +1,12 @@
 {-# Language UndecidableInstances #-}
 {-# Language AllowAmbiguousTypes #-}
+{-# Language PatternSynonyms #-}
+{-# Language ViewPatterns #-}
 module HBS2.Git3.Repo ( initRepo, waitRepo
                       , getRepoRefMaybe
                       , getRepoManifest
                       , HasGitRemoteKey(..)
+                      , pattern RepoURL
                       ) where
 
 import HBS2.Git3.Prelude
@@ -12,13 +15,13 @@ import HBS2.Git3.State
 import HBS2.CLI.Run.MetaData
 import HBS2.Net.Auth.Credentials
 
-import HBS2.Git3.Config.Local
-
 import HBS2.KeyMan.Keys.Direct
 
 import Data.Config.Suckless.Script
 import Data.Config.Suckless.Almost.RPC
 
+import Data.HashSet qualified as HS
+import Data.Text qualified as Text
 import Data.ByteString.Lazy.Char8 qualified as LBS8
 import Data.Word
 import Lens.Micro.Platform
@@ -36,6 +39,19 @@ data CInit =
   | CreateRepoDefBlock GitRepoKey
 
 
+pattern RepoURL :: GitRemoteKey -> Syntax C
+pattern RepoURL x <- (isRepoURL -> Just x)
+
+isRepoURL :: Syntax C -> Maybe GitRemoteKey
+isRepoURL = \case
+  TextLike xs -> case mkList @C (fmap mkStr (Text.splitOn "://" xs)) of
+    ListVal [TextLike pref, SignPubKeyLike puk] | pref `HS.member` prefixes -> Just puk
+    _ -> Nothing
+
+  _ -> Nothing
+
+  where
+    prefixes = HS.fromList [ "hbs2", "hbs23" ]
 
 initRepo :: forall m . HBS2GitPerks m => [Syntax C] -> Git3 m ()
 initRepo syn = do