make --json-error-messages capture url download errors

Convert Utility.Url to return Either String so the error message can be
displated in the annex monad and so captured.

(When curl is used, its errors are still not caught.)

Remote/BitTorrent.hs

@@ -206,7 +206,7 @@ downloadTorrentFile u = do
 					withTmpFileIn othertmp "torrent" $ \f h -> do
 						liftIO $ hClose h
 						ok <- Url.withUrlOptions $ 
-							liftIO . Url.download nullMeterUpdate u f
+							Url.download nullMeterUpdate u f
 						when ok $
 							liftIO $ renameFile f torrent
 						return ok

Remote/External.hs

@@ -716,7 +716,7 @@ checkKeyUrl :: Git.Repo -> CheckPresent
 checkKeyUrl r k = do
 	showChecking r
 	us <- getWebUrls k
-	anyM (\u -> withUrlOptions $ liftIO . checkBoth u (keySize k)) us
+	anyM (\u -> withUrlOptions $ checkBoth u (keySize k)) us
 
 getWebUrls :: Key -> Annex [URLString]
 getWebUrls key = filter supported <$> getUrls key

Remote/Git.hs

@@ -352,11 +352,10 @@ inAnnex' repo rmt (State connpool duc _ _) key
 	checkhttp = do
 		showChecking repo
 		gc <- Annex.getGitConfig
-		ifM (Url.withUrlOptions $ \uo -> liftIO $
-			anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls gc repo rmt key))
-				( return True
-				, giveup "not found"
-				)
+		ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls gc repo rmt key))
+			( return True
+			, giveup "not found"
+			)
 	checkremote = 
 		let fallback = Ssh.inAnnex repo key
 		in P2PHelper.checkpresent (Ssh.runProto rmt connpool (cantCheck rmt) fallback) key

Remote/S3.hs

@@ -58,11 +58,10 @@ import Logs.Web
 import Logs.MetaData
 import Types.MetaData
 import Utility.Metered
-import qualified Annex.Url as Url
 import Utility.DataUnits
 import Annex.Content
-import Annex.Url (getUrlOptions, withUrlOptions)
-import Utility.Url (checkBoth, UrlOptions(..))
+import qualified Annex.Url as Url
+import Annex.Url (getUrlOptions, withUrlOptions, UrlOptions(..))
 import Utility.Env
 
 type BucketName = String
@@ -348,7 +347,7 @@ checkKey hv r rs c info k = withS3Handle hv $ \case
 			Right us -> do
 				showChecking r
 				let check u = withUrlOptions $ 
-					liftIO . checkBoth u (keySize k)
+					Url.checkBoth u (keySize k)
 				anyM check us
 
 checkKeyHelper :: S3Info -> S3Handle -> (Either S3.Object S3VersionID) -> Annex Bool
@@ -397,7 +396,7 @@ retrieveExportS3 hv r info _k loc f p =
 				warning $ needS3Creds (uuid r)
 				return False
 			Just geturl -> Url.withUrlOptions $ 
-				liftIO . Url.download p (geturl exportloc) f
+				Url.download p (geturl exportloc) f
 	exportloc = bucketExportLocation info loc
 
 removeExportS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Key -> ExportLocation -> Annex Bool
@@ -417,8 +416,8 @@ checkPresentExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation
 checkPresentExportS3 hv r info k loc = withS3Handle hv $ \case
 	Just h -> checkKeyHelper info h (Left (T.pack $ bucketExportLocation info loc))
 	Nothing -> case getPublicUrlMaker info of
-		Just geturl -> withUrlOptions $ liftIO . 
-			checkBoth (geturl $ bucketExportLocation info loc) (keySize k)
+		Just geturl -> withUrlOptions $
+			Url.checkBoth (geturl $ bucketExportLocation info loc) (keySize k)
 		Nothing -> do
 			warning $ needS3Creds (uuid r)
 			giveup "No S3 credentials configured"

Remote/Web.hs

@@ -116,9 +116,8 @@ checkKey' key us = firsthit us (Right False) $ \u -> do
 	showChecking u'
 	case downloader of
 		YoutubeDownloader -> youtubeDlCheck u'
-		_ -> do
-			Url.withUrlOptions $ liftIO . catchMsgIO .
-				Url.checkBoth u' (keySize key)
+		_ -> catchMsgIO $
+			Url.withUrlOptions $ Url.checkBoth u' (keySize key)
   where
 	firsthit [] miss _ = return miss
 	firsthit (u:rest) _ a = do