handle git-credential prompt in -J mode

If git-credential has it cached and does not prompt, this will
unfortunately result in a brief flicker, as the displayed console
regions are hidden while running it and then re-displayed. Better than a
corrupted display.

Actually, I tried it and don't see a visible flicker, so probably only
over a slow ssh will it be apparent.

Annex/Url.hs

@@ -133,12 +133,15 @@ withUrlOptionsPromptingCreds :: (U.UrlOptions -> Annex a) -> Annex a
 withUrlOptionsPromptingCreds a = do
 	g <- Annex.gitRepo
 	uo <- getUrlOptions
+	prompter <- mkPrompter
 	a $ uo
-		{ U.getBasicAuth = getBasicAuthFromCredential g
+		{ U.getBasicAuth = \u -> prompter $
+			getBasicAuthFromCredential g u
 		-- Can't download with curl and handle basic auth,
-		-- so avoid using curl.
+		-- so make sure it uses conduit.
 		, U.urlDownloader = case U.urlDownloader uo of
-			U.DownloadWithCurl _ -> U.DownloadWithConduit $ U.DownloadWithCurlRestricted mempty
+			U.DownloadWithCurl _ -> U.DownloadWithConduit $
+				U.DownloadWithCurlRestricted mempty
 			v -> v
 		}
 

Messages.hs

@@ -1,6 +1,6 @@
 {- git-annex output messages
  -
- - Copyright 2010-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -48,6 +48,7 @@ module Messages (
 	outputMessage,
 	withMessageState,
 	prompt,
+	mkPrompter,
 ) where
 
 import System.Log.Logger
@@ -55,6 +56,7 @@ import System.Log.Formatter
 import System.Log.Handler (setFormatter)
 import System.Log.Handler.Simple
 import Control.Concurrent
+import Control.Monad.IO.Class
 import qualified Data.ByteString as S
 
 import Common
@@ -290,14 +292,21 @@ commandProgressDisabled = withMessageState $ \s -> return $
  - the user.
  -}
 prompt :: Annex a -> Annex a
-prompt a = debugLocks $ Annex.getState Annex.concurrency >>= \case
+prompt a = do
-	NonConcurrent -> a
+	p <- mkPrompter
+	p a
+
+{- Like prompt, but for a non-annex action that prompts. -}
+mkPrompter :: (MonadMask m, MonadIO m) => Annex (m a -> m a)
+mkPrompter = Annex.getState Annex.concurrency >>= \case
+	NonConcurrent -> return id
 	(Concurrent _) -> goconcurrent
 	ConcurrentPerCpu -> goconcurrent
   where
 	goconcurrent = withMessageState $ \s -> do
 		let l = promptLock s
-		bracketIO
+		return $ \a ->
-			(takeMVar l)
+			debugLocks $ bracketIO
-			(putMVar l)
+				(takeMVar l)
-			(const $ hideRegionsWhile s a)
+				(putMVar l)
+				(const $ hideRegionsWhile s a)

Messages/Concurrent.hs

@@ -18,6 +18,7 @@ import Common
 import qualified System.Console.Concurrent as Console
 import qualified System.Console.Regions as Regions
 import Control.Concurrent.STM
+import Control.Monad.IO.Class
 import qualified Data.Text as T
 #ifndef mingw32_HOST_OS
 import GHC.IO.Encoding
@@ -120,13 +121,14 @@ concurrentOutputSupported = return True -- Windows is always unicode
 
 {- Hide any currently displayed console regions while running the action,
  - so that the action can use the console itself. -}
-hideRegionsWhile :: MessageState -> Annex a -> Annex a
+hideRegionsWhile :: (MonadIO m, Monad m, MonadMask m) => MessageState -> m a -> m a
-hideRegionsWhile s a 
+hideRegionsWhile s a
-	| concurrentOutputEnabled s = bracketIO setup cleanup go
+	| concurrentOutputEnabled s = bracket setup cleanup go
 	| otherwise = a
   where
-	setup = Regions.waitDisplayChange $ swapTMVar Regions.regionList []
+	setup = liftIO $ 
-	cleanup = void . atomically . swapTMVar Regions.regionList
+		Regions.waitDisplayChange $ swapTMVar Regions.regionList []
+	cleanup = liftIO . void . atomically . swapTMVar Regions.regionList
 	go _ = do
 		liftIO $ hFlush stdout
 		a

Utility/Url.hs

@@ -510,7 +510,7 @@ downloadConduit meterupdate req file uo =
 		case r of
 			Right () -> signalsuccess True
 			Left e -> do
-				signalsuccess False
+				() <- signalsuccess False
 				throwM e
 	
 {- Sinks a Response's body to a file. The file can either be opened in