@@ -69,6 +69,7 @@ import GitHub
6969import GitHub.Data.Name
7070import Obelisk.Command.Nix
7171import System.Directory
72+import System.Exit
7273import System.FilePath
7374import System.IO.Error
7475import System.IO.Temp
@@ -188,7 +189,6 @@ getNixSha256ForUriUnpacked
188189 => GitUri
189190 -> m NixSha256
190191getNixSha256ForUriUnpacked uri =
191− --FIXME: this should be curled instead, and then added to the nix store
192192 withExitFailMessage ("nix-prefetch-url: Failed to determine sha256 hash of URL " <> gitUriToText uri) $ do
193193 [hash] <- fmap T.lines $ readProcessAndLogOutput (Debug, Debug) $
194194 proc "nix-prefetch-url" ["--unpack", "--type", "sha256", T.unpack $ gitUriToText uri]
@@ -852,7 +852,7 @@ getLatestRev os = do
852852uriThunkPtr :: MonadObelisk m => GitUri -> Maybe Text -> Maybe Text -> m ThunkPtr
853853uriThunkPtr uri mbranch mcommit = do
854854 commit <- case mcommit of
855− Nothing -> gitGetCommitBranch uri mbranch >>= return . snd --perhaps do io here instead of making uriToTHunkSource effectful ?
855+ Nothing -> gitGetCommitBranch uri mbranch >>= return . snd -- return . (\(_, y, _)->y) --perhaps do io here instead of making uriToTHunkSource effectful ?
856856 (Just c) -> return c
857857 (src, rev) <- uriToThunkSource uri mbranch >>= \case
858858 ThunkSource_GitHub s -> do
@@ -863,7 +863,6 @@ uriThunkPtr uri mbranch mcommit = do
863863 putLog Warning "\
864864\Failed to fetch archive from GitHub. This is probably a private repo. \
865865\Falling back on normal fetchgit. Original failure:"
866− --FIXME: right here is where we want to add the error handling
867866 errorToWarning e
868867 let s' = forgetGithub True s
869868 (,) (ThunkSource_Git s') <$> gitThunkRev s' commit
@@ -891,21 +890,35 @@ uriToThunkSource (GitUri u)
891890 s -> s `L.elem` [ "git", "https", "http" ] -- "http:" just redirects to "https:"
892891 && URI.unRText (URI.authHost uriAuth) == "github.com"
893892 , Just (_, owner :| [repoish]) <- URI.uriPath u
894− = \mbranch -> pure . ThunkSource_GitHub $ GitHubSource
895− { _gitHubSource_owner = N $ URI.unRText owner
896− , _gitHubSource_repo = N $ let
897− repoish' = URI.unRText repoish
898− in fromMaybe repoish' $ T.stripSuffix ".git" repoish'
899− , _gitHubSource_branch = N <$> mbranch
900− , _gitHubSource_private = False -- TODO: Can we try something to infer this?
901− }
893+ = \mbranch ->
894+ do
895+ unAuthenticatedExitCode <-
896+ fmap (\(x, _, _)->x)
897+ . readCreateProcessWithExitCode
898+ . isolateGitProc . gitProcNoRepo $
899+ ["ls-remote", "--exit-code", "--symref", show u]
900+ pure . ThunkSource_GitHub $ GitHubSource
901+ { _gitHubSource_owner = N $ URI.unRText owner
902+ , _gitHubSource_repo = N $ let
903+ repoish' = URI.unRText repoish
904+ in fromMaybe repoish' $ T.stripSuffix ".git" repoish'
905+ , _gitHubSource_branch = N <$> mbranch
906+ , _gitHubSource_private = unAuthenticatedExitCode /= ExitSuccess
907+ }
902908
903− | otherwise = \mbranch -> pure . ThunkSource_Git $ GitSource
904− { _gitSource_url = GitUri u
905− , _gitSource_branch = N <$> mbranch
906− , _gitSource_fetchSubmodules = False -- TODO: How do we determine if this should be true?
907− , _gitSource_private = False -- TODO: Can we try something to infer this?
908− }
909+ | otherwise = \mbranch ->
910+ do
911+ unAuthenticatedExitCode <-
912+ fmap (\(x, _, _)->x)
913+ . readCreateProcessWithExitCode
914+ . isolateGitProc . gitProcNoRepo $
915+ ["ls-remote", "--exit-code", "--symref", show u]
916+ pure . ThunkSource_Git $ GitSource
917+ { _gitSource_url = GitUri u
918+ , _gitSource_branch = N <$> mbranch
919+ , _gitSource_fetchSubmodules = False -- TODO: How do we determine if this should be true?
920+ , _gitSource_private = unAuthenticatedExitCode /= ExitSuccess
921+ }
909922
910923-- Funny signature indicates no effects depend on the optional branch name.
911924githubThunkRev
@@ -966,16 +979,13 @@ gitThunkRev s commit = do
966979-- If the branch name is passed in, it is returned exactly as-is. If it is not
967980-- passed it, the default branch of the repo is used instead.
968981
969−gitGetCommitBranch --FIXME:definitely encode the check to see if repo exists here
970− :: MonadObelisk m => GitUri -> Maybe Text -> m (Text, CommitId, Bool)
982+gitGetCommitBranch
983+ :: MonadObelisk m => GitUri -> Maybe Text -> m (Text, CommitId)
971984gitGetCommitBranch uri mbranch = withExitFailMessage ("Failure for git remote " <> uriMsg) $ do
972985 (_, bothMaps) <- gitLsRemote
973986 (T.unpack $ gitUriToText uri)
974987 (GitRef_Branch <$> mbranch)
975988 Nothing
976− unAuthenticatedExitCode <-
977− readCreateProcessWithExitCode . isolateGitProc . gitProcNoRepo $
978− ["ls-remote", "--exit-code", "--symref", repository]
979989 branch <- case mbranch of
980990 Nothing -> withExitFailMessage "Failed to find default branch" $ do
981991 b <- rethrowE $ gitLookupDefaultBranch bothMaps
@@ -986,7 +996,7 @@ gitGetCommitBranch uri mbranch = withExitFailMessage ("Failure for git remote "
986996 putLog Informational $ "Latest commit in branch " <> branch
987997 <> " from remote repo " <> uriMsg
988998 <> " is " <> commit
989− pure (branch, commit )-- , exitCode == ExitSuccess)
999+ pure (branch, commit)
9901000 where
9911001 rethrowE = either failWith pure
9921002 uriMsg = gitUriToText uri