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:
parent
b50ee9cd0c
commit
c1cd402081
34 changed files with 214 additions and 197 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue