@@ -890,41 +890,45 @@ uriToThunkSource (GitUri u)
890890 s -> s `L.elem` [ "git", "https", "http" ] -- "http:" just redirects to "https:"
891891 && URI.unRText (URI.authHost uriAuth) == "github.com"
892892 , Just (_, owner :| [repoish]) <- URI.uriPath u
893− = \mbranch ->
894− do
895− unAuthenticatedExitCode <-
896− fmap (\(x, _, _)->x)
897− . readCreateProcessWithExitCode
898− . isolateGitProc . gitProcNoRepo $
899− ["ls-remote"
900− , "--exit-code"
901− , "--symref"
902− , show $ u
903− { URI.uriScheme=URI.mkScheme "https"
904− , URI.uriAuthority=Left True}]
905− pure . ThunkSource_GitHub $ GitHubSource
893+ = \mbranch -> do
894+ isPrivate <- guessGitRepoIsPrivate $ GitUri u
895+ pure $ ThunkSource_GitHub $ GitHubSource
906896 { _gitHubSource_owner = N $ URI.unRText owner
907897 , _gitHubSource_repo = N $ let
908898 repoish' = URI.unRText repoish
909899 in fromMaybe repoish' $ T.stripSuffix ".git" repoish'
910900 , _gitHubSource_branch = N <$> mbranch
911− , _gitHubSource_private = unAuthenticatedExitCode /= ExitSuccess
901+ , _gitHubSource_private = isPrivate
912902 }
913903
914− | otherwise = \mbranch ->
915− do
916− unAuthenticatedExitCode <-
917− fmap (\(x, _, _)->x)
918− . readCreateProcessWithExitCode
919− . isolateGitProc . gitProcNoRepo $
920− ["ls-remote", "--exit-code", "--symref", show u]
921− pure . ThunkSource_Git $ GitSource
904+ | otherwise = \mbranch -> do
905+ isPrivate <- guessGitRepoIsPrivate $ GitUri u
906+ pure $ ThunkSource_Git $ GitSource
922907 { _gitSource_url = GitUri u
923908 , _gitSource_branch = N <$> mbranch
924909 , _gitSource_fetchSubmodules = False -- TODO: How do we determine if this should be true?
925− , _gitSource_private = unAuthenticatedExitCode /= ExitSuccess
910+ , _gitSource_private = isPrivate
926911 }
927912
913+guessGitRepoIsPrivate :: MonadObelisk m => GitUri -> m Bool
914+guessGitRepoIsPrivate uri = flip fix urisToTry $ \loop -> \case
915+ [] -> pure True
916+ uriAttempt:xs -> do
917+ readCreateProcessWithExitCode (isolateGitProc $ gitProcNoRepo
918+ [ "ls-remote"
919+ , "--exit-code"
920+ , "--symref"
921+ , T.unpack $ gitUriToText uriAttempt
922+ ]) >>= \case
923+ (ExitSuccess, _, _) -> pure False -- Must be a public repo
924+ _ -> loop xs
925+ where
926+ urisToTry = [uri, changeScheme "https" uri, changeScheme "http" uri, changeScheme "git" uri]
927+ changeScheme scheme (GitUri u) = GitUri $ u
928+ { URI.uriScheme = URI.mkScheme scheme
929+ , URI.uriAuthority = Left True
930+ }
931+
928932-- Funny signature indicates no effects depend on the optional branch name.
929933githubThunkRev
930934 :: forall m