Display error message when http download fails.

* Display error message when http download fails.

  There's nothing in the http-client library to nicely format a http
  exception, so in some cases it has to fall back to using show on it.
  Seems better than just saying "it failed" or only showing the http
  status code.

* Avoid forward retry when 0 bytes were received.

  forwardRetry was comparing Nothing to Just 0, and so thought there had
  been progress made when 0 bytes were received.

This commit was supported by the NSF-funded DataLad project.

Annex/Transfer.hs

@@ -199,7 +199,8 @@ stdRetry = combineRetryDeciders forwardRetry configuredRetry
 {- Retries a transfer when it fails, as long as the failed transfer managed
  - to send some data. -}
 forwardRetry :: RetryDecider
-forwardRetry = pure $ \old new -> pure $ bytesComplete old < bytesComplete new
+forwardRetry = pure $ \old new -> pure $
+	fromMaybe 0 (bytesComplete old) < fromMaybe 0 (bytesComplete new)
 
 {- Retries a number of times with growing delays in between when enabled
  - by git configuration. -}

CHANGELOG

@@ -12,6 +12,8 @@ git-annex (6.20180428) UNRELEASED; urgency=medium
   * Fix bug in last release that prevented the webapp opening on
     non-Linux systems.
   * Support building with hinotify-0.3.10.
+  * Display error message when http download fails.
+  * Avoid forward retry when 0 bytes were received.
 
  -- Joey Hess <id@joeyh.name>  Tue, 08 May 2018 13:51:37 -0400
 

Utility/Url.hs

@@ -250,9 +250,13 @@ headRequest r = r
  - By default, conduit is used for the download, except for file: urls,
  - which are copied. If the url scheme is not supported by conduit, falls
  - back to using curl.
+ -
+ - Displays error message on stderr when download failed.
  -}
 download :: MeterUpdate -> URLString -> FilePath -> UrlOptions -> IO Bool
-download meterupdate url file uo = go `catchNonAsync` (const $ return False)
+download meterupdate url file uo =
+	catchJust matchHttpException go showhttpexception
+		`catchNonAsync` showerr
   where
 	go = case parseURIRelaxed url of
 		Just u -> case (urlDownloader uo, parseUrlConduit (show u)) of
@@ -277,7 +281,7 @@ download meterupdate url file uo = go `catchNonAsync` (const $ return False)
 			resp <- http req (httpManager uo)
 			if responseStatus resp == ok200
 				then store zeroBytesProcessed WriteMode resp
-				else return False
+				else showrespfailure resp
 		Just sz -> resumeconduit req sz
 	
 	alreadydownloaded sz s h = s == requestedRangeNotSatisfiable416 
@@ -302,7 +306,32 @@ download meterupdate url file uo = go `catchNonAsync` (const $ return False)
 				then store (BytesProcessed sz) AppendMode resp
 				else if responseStatus resp == ok200
 					then store zeroBytesProcessed WriteMode resp
-					else return False
+					else showrespfailure resp
+	
+	showrespfailure resp = liftIO $ do
+		hPutStrLn stderr $ B8.toString $
+			statusMessage $ responseStatus resp
+		hFlush stderr
+		return False
+	showhttpexception he = do
+#if MIN_VERSION_http_client(0,5,0)
+		let msg = case he of
+			HttpExceptionRequest _ (StatusCodeException _ msgb) ->
+				B8.toString msgb
+			HttpExceptionRequest _ other -> show other
+			_ -> show he
+#else
+		let msg = case he of
+			StatusCodeException status _ _ -> statusMessage status
+			_ -> show he
+#endif
+		hPutStrLn stderr $ "download failed: " ++ msg
+		hFlush stderr
+		return False
+	showerr e = do
+		hPutStrLn stderr (show e)
+		hFlush stderr
+		return False
 	
 	store initialp mode resp = do
 		sinkResponseFile meterupdate initialp file mode resp
@@ -442,6 +471,13 @@ matchStatusCodeHeadersException want e@(StatusCodeException s r _)
 matchStatusCodeHeadersException _ _ = Nothing
 #endif
 
+{- Use with eg: 
+ -
+ - > catchJust matchHttpException
+ -}
+matchHttpException :: HttpException -> Maybe HttpException
+matchHttpException = Just
+
 #if MIN_VERSION_http_client(0,5,0)
 matchHttpExceptionContent :: (HttpExceptionContent -> Bool) -> HttpException -> Maybe HttpException
 matchHttpExceptionContent want e@(HttpExceptionRequest _ hec)

doc/bugs/get_from_the_web_remote_fails___40__redirect__63____41___-_lack_of_further_debug_info.mdwn

@@ -82,3 +82,12 @@ git annex get --debug --from=web sub-01.html
 
 
 [[!meta author=yoh]]
+
+> This does not involve redirects. It's hitting the url a
+> couple of times on failure, thus the multiple "from web".
+> That was due to a bug in the forward retry code; `Just 0 > Nothing`.
+> Fixed.
+> 
+> I added a display of the error message from the web server.
+> 
+> [[fixed|done]] --[[Joey]]