@@ -158,16 +158,16 @@ getNixSha256ForUriUnpacked
158158 => URI
159159 -> m NixSha256
160160getNixSha256ForUriUnpacked uri =
161− withExitFailMessage ("nix-prefetch-url: Failed to determine sha256 hash of URL " <> T.pack (show uri)) $ do
162− withNixRemoteCheck $ readProcessAndLogStderr Debug $
163− proc "nix-prefetch-url" ["--unpack" , "--type" , "sha256" , show uri]
161+ withExitFailMessage ("nix-prefetch-url: Failed to determine sha256 hash of URL " <> render uri) $ do
162+ withNixRemoteCheck $ readProcessAndLogOutput (Debug, Debug) $
163+ proc "nix-prefetch-url" ["--unpack" , "--type" , "sha256" , T.unpack $ render uri]
164164
165165nixPrefetchGit :: MonadObelisk m => URI -> Text -> Bool -> m NixSha256
166166nixPrefetchGit uri rev fetchSubmodules =
167− withExitFailMessage ("nix-prefetch-git: Failed to determine sha256 hash of Git repo " <> T.pack (show uri) <> " at " <> rev) $ do
167+ withExitFailMessage ("nix-prefetch-git: Failed to determine sha256 hash of Git repo " <> render uri <> " at " <> rev) $ do
168168 out <- withNixRemoteCheck $ readProcessAndLogStderr Debug $
169169 proc "nix-prefetch-git" $ filter (/="")
170− [ "--url", show uri
170+ [ "--url", T.unpack $ render uri
171171 , "--rev", T.unpack rev
172172 , if fetchSubmodules then "--fetch-submodules" else ""
173173 , "--quiet"
@@ -578,7 +578,9 @@ unpackThunk' noTrail thunkDir = readThunk thunkDir >>= \case
578578 withSpinner' ("Fetching thunk " <> T.pack thunkName)
579579 (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkName) $ do
580580 let git = callProcessAndLogOutput (Notice, Notice) . gitProc tmpRepo
581− git ["clone", if _gitSource_fetchSubmodules s then "--recursive" else "", show (_gitSource_url s)]
581+ git $ [ "clone" ]
582+ ++ ("--recursive" <$ guard (_gitSource_fetchSubmodules s))
583+ ++ [ T.unpack $ render $ _gitSource_url s ]
582584 git ["reset", "--hard", Ref.toHexString $ _thunkRev_commit $ _thunkPtr_rev tptr]
583585 when (_gitSource_fetchSubmodules s) $
584586 git ["submodule", "update", "--recursive", "--init"]
@@ -632,23 +634,29 @@ getThunkPtr' checkClean thunkDir = do
632634 -- correspondents
633635 (headDump :: [Text]) <- T.lines <$> readGitProcess thunkDir
634636 [ "for-each-ref"
635− , "--format=%(refname:short) %(upstream:short)"
637+ , "--format=%(refname:short) %(upstream:short) %(upstream:remotename)"
636638 , "refs/heads/"
637639 ]
638− (headInfo :: Map Text (Maybe Text)) <- fmap Map.fromList $ forM headDump $ \line -> do
639− (branch : restOfLine) <- pure $ T.words line
640− mUpstream <- case restOfLine of
641− [] -> pure Nothing
642− [u] -> pure $ Just u
643− (_:_) -> failWith "git for-each-ref invalid output"
644− pure (branch, mUpstream)
640+
641+ (headInfo :: Map Text (Maybe (Text, Text)))
642+ <- fmap Map.fromList $ forM headDump $ \line -> do
643+ (branch : restOfLine) <- pure $ T.words line
644+ mUpstream <- case restOfLine of
645+ [] -> pure Nothing
646+ [u, r] -> pure $ Just (u, r)
647+ (_:_) -> failWith "git for-each-ref invalid output"
648+ pure (branch, mUpstream)
649+
650+ putLog Debug $ "branches: " <> T.pack (show headInfo)
645651
646652 let errorMap :: Map Text ()
647− headUpstream :: Map Text Text
653+ headUpstream :: Map Text (Text, Text)
648654 (errorMap, headUpstream) = flip Map.mapEither headInfo $ \case
649655 Nothing -> Left ()
650656 Just b -> Right b
651657
658+ putLog Debug $ "branches with upstream branch set: " <> T.pack (show headUpstream)
659+
652660 -- Check that every branch has a remote equivalent
653661 when checkClean $ do
654662 let untrackedBranches = Map.keys errorMap
@@ -670,7 +678,7 @@ getThunkPtr' checkClean thunkDir = do
670678 ]
671679
672680 -- loosely by https://stackoverflow.com/questions/7773939/show-git-ahead-and-behind-info-for-all-branches-including-remotes
673− stats <- iforM headUpstream $ \branch upstream -> do
681+ stats <- iforM headUpstream $ \branch (upstream, _remote) -> do
674682 (stat :: [Text]) <- T.lines <$> readGitProcess thunkDir
675683 [ "rev-list", "--left-right"
676684 , T.unpack branch <> "..." <> T.unpack upstream
@@ -695,13 +703,12 @@ getThunkPtr' checkClean thunkDir = do
695703
696704 -- We assume it's safe to pack the thunk at this point
697705
698− -- Get current branch `git rev-parse --abbrev-ref HEAD`
706+ -- Get current branch ``
699707 mCurrentBranch <- listToMaybe
700708 <$> T.lines
701709 <$> readGitProcess thunkDir ["rev-parse", "--abbrev-ref", "HEAD"]
702710
703− let remote = maybe "origin" id $
704− flip Map.lookup headUpstream =<< mCurrentBranch
711+ let remote = maybe "origin" snd $ flip Map.lookup headUpstream =<< mCurrentBranch
705712
706713 [remoteUri'] <- fmap T.lines $ readGitProcess thunkDir
707714 [ "config"
@@ -740,9 +747,10 @@ uriThunkPtr uri mbranch = do
740747 case rev of
741748 Right r -> pure (ThunkSource_GitHub s, r)
742749 Left e -> do
743− putLog Alert $ " \
744−\ Failed to fetch archive from GitHub. This is probably a private repo. \
745−\ Falling back on normal fetchgit. Original failure:\n\n" <> T.pack (show e)
750+ putLog Warning $ " \
751+\Failed to fetch archive from GitHub. This is probably a private repo. \
752+\Falling back on normal fetchgit. Original failure:\n\n"
753+ errorToWarning e
746754 let s' = forgetGithub s
747755 (,) (ThunkSource_Git s') <$> gitThunkRev s' commit
748756 ThunkSource_Git s -> (,) (ThunkSource_Git s) <$> gitThunkRev s commit
@@ -846,7 +854,9 @@ gitThunkRev s commit = do
846854gitGetCommitBranch
847855 :: MonadObelisk m => URI -> Maybe Text -> m (Text, CommitId)
848856gitGetCommitBranch uri mbranch = withExitFailMessage ("Failure for git remote " <> uriMsg) $ do
849− bothMaps <- rethrowE =<< liftIO (gitLsRemote (show uri) (GitRef_Branch <$> mbranch))
857+ bothMaps <- gitLsRemote
858+ (T.unpack $ render uri)
859+ (GitRef_Branch <$> mbranch)
850860 branch <- case mbranch of
851861 Nothing -> withExitFailMessage "Failed to find default branch" $ do
852862 b <- rethrowE $ gitLookupDefaultBranch bothMaps
@@ -860,10 +870,10 @@ gitGetCommitBranch uri mbranch = withExitFailMessage ("Failure for git remote "
860870 pure (branch, commit)
861871 where
862872 rethrowE = either failWith pure
863− uriMsg = T.pack $ show uri
873+ uriMsg = render uri
864874
865875parseGitUri :: Text -> Maybe URI
866−parseGitUri x = mkURI x <|> parseSshShorthand x
876+parseGitUri x = parseSshShorthand x <|> mkURI x
867877
868878parseSshShorthand :: Text -> Maybe URI
869879parseSshShorthand uri = do