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.

diff --git a/CHANGELOG b/CHANGELOG
index 80138b8b797eb3d7ead3d5e2d88a8a925ecf83ce..d9b7e2df1c4e6207cf9a0d8bad63a986fc883048 100644 (file)
--- a/CHANGELOG
+++ b/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
 

diff --git a/P2P/Http/Client.hs b/P2P/Http/Client.hs
index fd693f1afa2dbd5f307ff8c0321ecba600b43509..069124394b879de8434a0e10c8a561c5bfcbb0a0 100644 (file)
--- a/P2P/Http/Client.hs
+++ b/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

diff --git a/doc/bugs/get_from_p2phttp_does_not_ask_for__47__use_credentials.mdwn b/doc/bugs/get_from_p2phttp_does_not_ask_for__47__use_credentials.mdwn
index 4f894c0ac986eaa8659d08eca04897141ecdff3a..819c58e97f987b8070be4701ccee47eacb895a71 100644 (file)
--- a/doc/bugs/get_from_p2phttp_does_not_ask_for__47__use_credentials.mdwn
+++ b/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]]