@@ -121,7 +121,7 @@ data GitHubSource = GitHubSource
121121 }
122122 deriving (Show, Eq, Ord)
123123
124−newtype GitUri = GitUri URI.URI deriving (Eq, Ord, Show)
124+newtype GitUri = GitUri { unGitUri :: URI.URI } deriving (Eq, Ord, Show)
125125
126126gitUriToText :: GitUri -> Text
127127gitUriToText (GitUri uri)
@@ -915,19 +915,26 @@ guessGitRepoIsPrivate :: MonadObelisk m => GitUri -> m Bool
915915guessGitRepoIsPrivate uri = flip fix urisToTry $ \loop -> \case
916916 [] -> pure True
917917 uriAttempt:xs -> do
918− readCreateProcessWithExitCode (isolateGitProc $ gitProcNoRepo
919− [ "ls-remote"
920− , "--exit-code"
921− , "--symref"
922− , T.unpack $ gitUriToText uriAttempt
923− ]) >>= \case
924− (ExitSuccess, _, _) -> pure False -- Must be a public repo
925− _ -> loop xs
918+ result <- readCreateProcessWithExitCode $
919+ isolateGitProc $
920+ gitProcNoRepo
921+ [ "ls-remote"
922+ , "--quiet"
923+ , "--exit-code"
924+ , "--symref"
925+ , T.unpack $ gitUriToText uriAttempt
926+ ]
927+ case result of
928+ (ExitSuccess, _, _) -> pure False -- Must be a public repo
929+ _ -> loop xs
926930 where
927− urisToTry = nubOrd [uri, changeScheme "https" uri, changeScheme "http" uri, changeScheme "git" uri]
931+ urisToTry = nubOrd $
932+ -- Include the original URI if it isn't using SSH because SSH will certainly fail.
933+ [uri | fmap URI.unRText (URI.uriScheme (unGitUri uri)) /= Just "ssh"] <>
934+ [changeScheme "https" uri, changeScheme "http" uri, changeScheme "git" uri]
928935 changeScheme scheme (GitUri u) = GitUri $ u
929936 { URI.uriScheme = URI.mkScheme scheme
930− , URI.uriAuthority = Left True
937+ , URI.uriAuthority = (\x -> x { URI.authUserInfo = Nothing }) <$> URI.uriAuthority u
931938 }
932939
933940-- Funny signature indicates no effects depend on the optional branch name.