catch ClientError from withClientM

When getting from a P2P HTTP remote, prompt for credentials when required,
instead of failing.

This feels like it might be a bug in servant-client. withClientM's type
suggests it would not throw a ClientError. But it does in this case.

CHANGELOG

@@ -4,6 +4,8 @@ git-annex (10.20240732) UNRELEASED; urgency=medium
     last version.
   * When proxying an upload to a special remote, verify the hash.
   * Avoid loading cluster log at startup.
+  * When getting from a P2P HTTP remote, prompt for credentials when
+    required, instead of failing.
 
  -- Joey Hess <id@joeyh.name>  Wed, 31 Jul 2024 15:52:03 -0400
 

P2P/Http/Client.hs

@@ -9,6 +9,7 @@
 
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds, TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE CPP #-}
 
 module P2P.Http.Client (
@@ -99,7 +100,7 @@ p2pHttpClientVersions allowedversion rmt fallback clientaction =
 	versions = filter allowedversion allProtocolVersions
 	go clientenv mcred credcached mauth (v:vs) = do
 		myuuid <- getUUID
-		res <- clientaction clientenv v
+		res <- catchclienterror $ clientaction clientenv v
 			(B64UUID (uuid rmt))
 			(B64UUID myuuid)
 			[]
@@ -126,6 +127,8 @@ p2pHttpClientVersions allowedversion rmt fallback clientaction =
 					("git-annex HTTP API server returned an unexpected response: " ++ show clienterror)
 	go _ _ _ _ [] = return Nothing
 
+	catchclienterror a = a `catch` \(ex :: ClientError) -> pure (Left ex)
+
 	authrequired clientenv vs = do
 		cred <- prompt $ 
 			inRepo $ Git.getUrlCredential credentialbaseurl

doc/bugs/get_from_p2phttp_does_not_ask_for__47__use_credentials.mdwn

@@ -56,3 +56,5 @@ On Ubuntu 22.04
 ### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)
 
 I am currently experimenting with supporting the p2phttp protocol in forgejo-aneksajo. So far I have a prototype working with public repositories and it was surprisingly straightforward, but private repositories do not work yet due to this bug.
+
+> [[fixed|done]] --[[Joey]]