wip

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)
 

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