make storeExport throw exceptions

This commit is contained in:
Joey Hess 2020-05-15 12:17:15 -04:00
parent dc7dc1e179
commit 4814b444dd
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
11 changed files with 99 additions and 105 deletions

View file

@ -279,19 +279,16 @@ whereisKeyM external k = handleRequestKey external WHEREIS k Nothing $ \resp ->
UNSUPPORTED_REQUEST -> result []
_ -> Nothing
storeExportM :: External -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
storeExportM external f k loc p = safely $
handleRequestExport external loc req k (Just p) $ \resp -> case resp of
TRANSFER_SUCCESS Upload k' | k == k' -> result True
TRANSFER_FAILURE Upload k' errmsg | k == k' ->
Just $ do
warning $ respErrorMessage "TRANSFER" errmsg
return (Result False)
UNSUPPORTED_REQUEST -> Just $ do
warning "TRANSFEREXPORT not implemented by external special remote"
return (Result False)
_ -> Nothing
storeExportM :: External -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
storeExportM external f k loc p = either giveup return =<< go
where
go = handleRequestExport external loc req k (Just p) $ \resp -> case resp of
TRANSFER_SUCCESS Upload k' | k == k' -> result $ Right ()
TRANSFER_FAILURE Upload k' errmsg | k == k' ->
result $ Left $ respErrorMessage "TRANSFER" errmsg
UNSUPPORTED_REQUEST ->
result $ Left "TRANSFEREXPORT not implemented by external special remote"
_ -> Nothing
req sk = TRANSFEREXPORT Upload sk f
retrieveExportM :: External -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool