make storeKey throw exceptions

When storing content on remote fails, always display a reason why.

Since the Storer used by special remotes already did, this mostly affects
git remotes, but not entirely. For example, if git-lfs failed to connect to
the endpoint, it used to silently return False.
This commit is contained in:
Joey Hess 2020-05-13 14:03:00 -04:00
parent b50ee9cd0c
commit c1cd402081
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
34 changed files with 214 additions and 197 deletions

View file

@ -222,14 +222,14 @@ checkExportSupported' external = go `catchNonAsync` (const (return False))
_ -> Nothing
storeKeyM :: External -> Storer
storeKeyM external = fileStorer $ \k f p ->
handleRequestKey external (\sk -> TRANSFER Upload sk f) k (Just p) $ \resp ->
storeKeyM external = fileStorer $ \k f p -> either giveup return =<< go k f p
where
go k f p = handleRequestKey external (\sk -> TRANSFER Upload sk f) k (Just p) $ \resp ->
case resp of
TRANSFER_SUCCESS Upload k' | k == k' -> result True
TRANSFER_SUCCESS Upload k' | k == k' ->
result (Right ())
TRANSFER_FAILURE Upload k' errmsg | k == k' ->
Just $ do
warning $ respErrorMessage "TRANSFER" errmsg
return (Result False)
result (Left (respErrorMessage "TRANSFER" errmsg))
_ -> Nothing
retrieveKeyFileM :: External -> Retriever