Parse share handles separate from name segments (#3704)

* Parse share handles with `-` in them

parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs

@@ -26,6 +26,9 @@ data ShareCodeserver
   | CustomCodeserver CodeserverURI
   deriving stock (Eq, Ord, Show)
 
+newtype ShareUserHandle = ShareUserHandle {shareUserHandleToText :: Text}
+  deriving stock (Eq, Ord, Show)
+
 -- |
 -- >>> :set -XOverloadedLists
 -- >>> import Data.Maybe (fromJust)
@@ -36,12 +39,12 @@ data ShareCodeserver
 -- "share"
 -- >>> displayShareCodeserver (CustomCodeserver . fromJust $ parseURI "https://share-next.unison-lang.org/api" >>= codeserverFromURI ) "unison" ["base", "List"]
 -- "share(https://share-next.unison-lang.org:443/api).unison.base.List"
-displayShareCodeserver :: ShareCodeserver -> Text -> Path -> Text
-displayShareCodeserver cs repo path =
+displayShareCodeserver :: ShareCodeserver -> ShareUserHandle -> Path -> Text
+displayShareCodeserver cs shareUser path =
   let shareServer = case cs of
         DefaultCodeserver -> ""
         CustomCodeserver cu -> "share(" <> tShow cu <> ")."
-   in shareServer <> repo <> maybePrintPath path
+   in shareServer <> shareUserHandleToText shareUser <> maybePrintPath path
 
 data ReadGitRepo = ReadGitRepo {url :: Text, ref :: Maybe Text}
   deriving stock (Eq, Ord, Show)
@@ -117,7 +120,7 @@ data ReadGitRemoteNamespace = ReadGitRemoteNamespace
 
 data ReadShareRemoteNamespace = ReadShareRemoteNamespace
   { server :: ShareCodeserver,
-    repo :: Text,
+    repo :: ShareUserHandle,
     -- sch :: Maybe ShortCausalHash, -- maybe later
     path :: Path
   }
@@ -153,7 +156,7 @@ data WriteGitRemotePath = WriteGitRemotePath
 
 data WriteShareRemotePath = WriteShareRemotePath
   { server :: ShareCodeserver,
-    repo :: Text,
+    repo :: ShareUserHandle,
     path :: Path
   }
   deriving stock (Eq, Show)

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -91,6 +91,7 @@ import Unison.Codebase.Editor.RemoteRepo
   ( ReadGitRemoteNamespace (..),
     ReadRemoteNamespace (..),
     ReadShareRemoteNamespace (..),
+    ShareUserHandle (..),
     WriteGitRemotePath (..),
     WriteGitRepo,
     WriteRemotePath (..),
@@ -179,7 +180,7 @@ import Unison.Share.Types (codeserverBaseURL)
 import qualified Unison.ShortHash as SH
 import qualified Unison.Sqlite as Sqlite
 import Unison.Symbol (Symbol)
-import qualified Unison.Sync.Types as Share (Path (..), hashJWTHash)
+import qualified Unison.Sync.Types as Share
 import qualified Unison.Syntax.HashQualified as HQ (fromString, toString, toText, unsafeFromString)
 import qualified Unison.Syntax.Lexer as L
 import qualified Unison.Syntax.Name as Name (toString, toVar, unsafeFromString, unsafeFromVar)
@@ -1985,7 +1986,7 @@ handlePushToUnisonShare :: WriteShareRemotePath -> Path.Absolute -> PushBehavior
 handlePushToUnisonShare remote@WriteShareRemotePath {server, repo, path = remotePath} localPath behavior = do
   let codeserver = Codeserver.resolveCodeserver server
   let baseURL = codeserverBaseURL codeserver
-  let sharePath = Share.Path (repo Nel.:| pathToSegments remotePath)
+  let sharePath = Share.Path (shareUserHandleToText repo Nel.:| pathToSegments remotePath)
   ensureAuthenticatedWithCodeserver codeserver
 
   -- doesn't handle the case where a non-existent path is supplied
@@ -2288,7 +2289,7 @@ importRemoteShareBranch rrn@(ReadShareRemoteNamespace {server, repo, path}) = do
   let baseURL = codeserverBaseURL codeserver
   -- Auto-login to share if pulling from a non-public path
   when (not $ RemoteRepo.isPublic rrn) $ ensureAuthenticatedWithCodeserver codeserver
-  let shareFlavoredPath = Share.Path (repo Nel.:| coerce @[NameSegment] @[Text] (Path.toList path))
+  let shareFlavoredPath = Share.Path (shareUserHandleToText repo Nel.:| coerce @[NameSegment] @[Text] (Path.toList path))
   Cli.Env {codebase} <- ask
   causalHash <-
     Cli.with withEntitiesDownloadedProgressCallback \downloadedCallback ->
@@ -2644,7 +2645,7 @@ doFetchCompiler =
     ns =
       ReadShareRemoteNamespace
         { server = RemoteRepo.DefaultCodeserver,
-          repo = "dolio",
+          repo = ShareUserHandle "dolio",
           path =
             Path.fromList $ NameSegment <$> ["public", "internal", "trunk"]
         }

unison-cli/src/Unison/Codebase/Editor/UriParser.hs

@@ -22,6 +22,7 @@ import Unison.Codebase.Editor.RemoteRepo
     ReadRemoteNamespace (..),
     ReadShareRemoteNamespace (..),
     ShareCodeserver (DefaultCodeserver),
+    ShareUserHandle (..),
     WriteGitRemotePath (..),
     WriteGitRepo (..),
     WriteRemotePath (..),
@@ -31,7 +32,6 @@ import Unison.Codebase.Path (Path (..))
 import qualified Unison.Codebase.Path as Path
 import Unison.Codebase.ShortCausalHash (ShortCausalHash (..))
 import Unison.NameSegment (NameSegment (..))
-import qualified Unison.NameSegment as NameSegment
 import Unison.Prelude
 import qualified Unison.Syntax.Lexer
 import qualified Unison.Util.Pretty as P
@@ -89,7 +89,7 @@ writeShareRemotePath =
   P.label "write share remote path" $
     WriteShareRemotePath
       <$> pure DefaultCodeserver
-      <*> (NameSegment.toText <$> nameSegment)
+      <*> shareUserHandle
       <*> (Path.fromList <$> P.many (C.char '.' *> nameSegment))
 
 -- >>> P.parseMaybe readShareRemoteNamespace ".unisonweb.base._releases.M4"
@@ -102,9 +102,21 @@ readShareRemoteNamespace = do
     ReadShareRemoteNamespace
       <$> pure DefaultCodeserver
       -- <*> sch <- P.optional shortBranchHash
-      <*> (NameSegment.toText <$> nameSegment)
+      <*> shareUserHandle
       <*> (Path.fromList <$> P.many (C.char '.' *> nameSegment))
 
+-- | We're lax in our share user rules here, Share is the source of truth
+-- for this stuff and can provide better error messages if required.
+--
+-- >>> P.parseMaybe shareUserHandle "unison"
+-- Just (ShareUserHandle {shareUserHandleToText = "unison"})
+--
+-- >>> P.parseMaybe shareUserHandle "unison-1337"
+-- Just (ShareUserHandle {shareUserHandleToText = "unison-1337"})
+shareUserHandle :: P ShareUserHandle
+shareUserHandle = do
+  ShareUserHandle . Text.pack <$> P.some (P.satisfy \c -> isAlphaNum c || c == '-' || c == '_')
+
 -- >>> P.parseMaybe readGitRemoteNamespace "git(user@server:project.git:branch)#asdf"
 -- >>> P.parseMaybe readGitRemoteNamespace "git(user@server:project.git:branch)#asdf."
 -- >>> P.parseMaybe readGitRemoteNamespace "git(user@server:project.git:branch)"

unison-cli/src/Unison/Codebase/Editor/VersionParser.hs

@@ -42,6 +42,6 @@ defaultBaseLib = fmap makeNS $ release <|> unknown
     makeNS t =
       ReadShareRemoteNamespace
         { server = DefaultCodeserver,
-          repo = "unison",
+          repo = ShareUserHandle "unison",
           path = "public" Path.:< "base" Path.:< Path.fromText t
         }

unison-cli/src/Unison/CommandLine/OutputMessages.hs

@@ -55,9 +55,11 @@ import qualified Unison.Codebase.Editor.Output.PushPull as PushPull
 import Unison.Codebase.Editor.RemoteRepo
   ( ReadGitRepo,
     ReadRemoteNamespace,
+    ShareUserHandle (..),
     WriteGitRepo,
     WriteRemotePath (..),
     WriteShareRemotePath (..),
+    shareUserHandleToText,
   )
 import qualified Unison.Codebase.Editor.RemoteRepo as RemoteRepo
 import qualified Unison.Codebase.Editor.SlurpResult as SlurpResult
@@ -1872,7 +1874,7 @@ notifyUser dir o = case o of
       ( WriteRemotePathShare
           WriteShareRemotePath
             { server = RemoteRepo.DefaultCodeserver,
-              repo = Share.unRepoName (Share.pathRepoName sharePath),
+              repo = ShareUserHandle $ Share.unRepoName (Share.pathRepoName sharePath),
               path = Path.fromList (coerce @[Text] @[NameSegment] (Share.pathCodebasePath sharePath))
             }
       )
@@ -1913,7 +1915,7 @@ prettyShareLink WriteShareRemotePath {repo, path} =
         Path.toList path
           & fmap (URI.encodeText . NameSegment.toText)
           & Text.intercalate "/"
-   in P.green . P.text $ shareOrigin <> "/@" <> repo <> "/p/code/latest/namespaces/" <> encodedPath
+   in P.green . P.text $ shareOrigin <> "/@" <> shareUserHandleToText repo <> "/p/code/latest/namespaces/" <> encodedPath
 
 prettyFilePath :: FilePath -> Pretty
 prettyFilePath fp =

unison-cli/tests/Unison/Test/UriParser.hs

@@ -9,13 +9,7 @@ import Data.Text (Text)
 import qualified Data.Text as Text
 import EasyTest
 import qualified Text.Megaparsec as P
-import Unison.Codebase.Editor.RemoteRepo
-  ( ReadGitRepo (..),
-    ReadRemoteNamespace (..),
-    ShareCodeserver(..),
-    pattern ReadGitRemoteNamespace,
-    pattern ReadShareRemoteNamespace,
-  )
+import Unison.Codebase.Editor.RemoteRepo (ReadGitRepo (..), ReadRemoteNamespace (..), ShareCodeserver (..), ShareUserHandle (..), pattern ReadGitRemoteNamespace, pattern ReadShareRemoteNamespace)
 import qualified Unison.Codebase.Editor.UriParser as UriParser
 import Unison.Codebase.Path (Path (..))
 import qualified Unison.Codebase.Path as Path
@@ -33,7 +27,7 @@ testShare =
   scope "share" . tests $
     [ parseAugmented
         ( "unisonweb.base._releases.M4",
-          ReadRemoteNamespaceShare (ReadShareRemoteNamespace DefaultCodeserver "unisonweb" (path ["base", "_releases", "M4"]))
+          ReadRemoteNamespaceShare (ReadShareRemoteNamespace DefaultCodeserver (ShareUserHandle "unisonweb") (path ["base", "_releases", "M4"]))
         ),
       expectParseFailure ".unisonweb.base"
     ]

unison-cli/tests/Unison/Test/VersionParser.hs

@@ -30,7 +30,7 @@ makeTest (version, path) =
       ( Just
           ( ReadShareRemoteNamespace
               { server = DefaultCodeserver,
-                repo = "unison",
+                repo = ShareUserHandle "unison",
                 path = Path.fromList ["public", "base"] <> Path.fromText path
               }
           )