display actual download errors

Eg, when config prohibits accessing localhost, need to show that
message, not a generic "download failed".

Remote/HttpAlso.hs

@@ -118,26 +118,27 @@ retriveExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> FilePath ->
 retriveExportHttpAlso baseurl key loc dest p = 
 	downloadAction dest p key (exportLocationUrlAction baseurl loc)
 
-downloadAction :: FilePath -> MeterUpdate -> Key -> ((URLString -> Annex Bool) -> Annex Bool) -> Annex ()
+downloadAction :: FilePath -> MeterUpdate -> Key -> ((URLString -> Annex (Either String ())) -> Annex (Either String ())) -> Annex ()
 downloadAction dest p key run =
-	meteredFile dest (Just p) key $
+	Url.withUrlOptions $ \uo ->
-		unlessM (run downloader) $
+		meteredFile dest (Just p) key $
-			giveup "download failed"
+			run (\url -> Url.download' p url dest uo)
-  where
+				>>= either giveup (const (return ()))
-	downloader url = isRight
-		<$> Url.withUrlOptions (Url.download' p url dest)
 
 checkKey :: Maybe URLString -> LearnedLayout -> Remote -> Key -> Annex Bool
 checkKey baseurl ll r key = do
 	showChecking r
-	keyUrlAction baseurl ll key (checkKey' key)
+	isRight <$> keyUrlAction baseurl ll key (checkKey' key)
 
-checkKey' :: Key -> URLString -> Annex Bool
+checkKey' :: Key -> URLString -> Annex (Either String ())
-checkKey' key url = Url.withUrlOptions $ Url.checkBoth url (fromKey keySize key)
+checkKey' key url = ifM (Url.withUrlOptions $ Url.checkBoth url (fromKey keySize key))
+	( return (Right ())
+	, return (Left "content not found")
+	)
 
 checkPresentExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> Annex Bool
 checkPresentExportHttpAlso baseurl key loc =
-	exportLocationUrlAction baseurl loc (checkKey' key)
+	isRight <$> exportLocationUrlAction baseurl loc (checkKey' key)
 
 type LearnedLayout = TVar (Maybe [Key -> URLString])
 
@@ -147,28 +148,40 @@ newLearnedLayout = newTVarIO Nothing
 -- Learns which layout the special remote uses, so the once any
 -- action on an url succeeds, subsequent calls will continue to use that
 -- layout (or related layouts).
-keyUrlAction :: Maybe URLString -> LearnedLayout -> Key -> (URLString -> Annex Bool) -> Annex Bool
+keyUrlAction
-keyUrlAction (Just baseurl) ll key a = liftIO (readTVarIO ll) >>= \case
+	:: Maybe URLString
-	Just learned -> go False [learned]
+	-> LearnedLayout
-	Nothing -> go True (supportedLayouts baseurl)
+	-> Key
+	-> (URLString -> Annex (Either String ()))
+	-> Annex (Either String ())
+keyUrlAction (Just baseurl) ll key downloader =
+	liftIO (readTVarIO ll) >>= \case
+		Just learned -> go Nothing False [learned]
+		Nothing -> go Nothing True (supportedLayouts baseurl)
   where
-	go _learn [] = return False
+	go err learn [] = go' err learn [] []
-	go learn (layouts:rest) = go' learn layouts [] <||> go learn rest
+	go err learn (layouts:rest) = go' err learn layouts [] >>= \case
+		Right () -> return (Right ())
+		Left err' -> go (Just err') learn rest
 	
-	go' _ [] _ = return False
+	go' (Just err) _ [] _ = pure (Left err)
-	go' learn (layout:rest) prevs = 
+	go' Nothing _ [] _ = error "internal"
-		ifM (a (layout key))
+	go' _err learn (layout:rest) prevs = 
-			( do
+		downloader (layout key) >>= \case
+			Right () -> do
 				when learn $ do
 					let learned = layout:prevs++rest
 					liftIO $ atomically $
 						writeTVar ll (Just learned)
-				return True
+				return (Right ())
-			, go' learn rest (layout:prevs)
+			Left err -> go' (Just err) learn rest (layout:prevs)
-			)
 keyUrlAction Nothing _ _ _ = noBaseUrlError
 
-exportLocationUrlAction :: Maybe URLString -> ExportLocation -> (URLString -> Annex Bool) -> Annex Bool
+exportLocationUrlAction
+	:: Maybe URLString
+	-> ExportLocation
+	-> (URLString -> Annex (Either String ()))
+	-> Annex (Either String ())
 exportLocationUrlAction (Just baseurl) loc a =
 	a (baseurl P.</> fromRawFilePath (fromExportLocation loc))
 exportLocationUrlAction Nothing _ _ = noBaseUrlError