mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

make storeKey throw exceptions

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

12
Remote/Glacier.hs
View file

@ -147,7 +147,7 @@ checkNonEmpty k
giveup "Cannot store empty files in Glacier."
| otherwise = return ()
store' :: Remote -> Key -> L.ByteString -> MeterUpdate -> Annex Bool
store' :: Remote -> Key -> L.ByteString -> MeterUpdate -> Annex ()
store' r k b p = go =<< glacierEnv c gc u
where
c = config r
@ -160,13 +160,11 @@ store' r k b p = go =<< glacierEnv c gc u
, Param $ getVault $ config r
, Param "-"
]
go Nothing = return False
go (Just e) = do
go Nothing = giveup "Glacier not usable."
go (Just e) = liftIO $ do
let cmd = (proc "glacier" (toCommand params)) { env = Just e }
liftIO $ catchBoolIO $
withHandle StdinHandle createProcessSuccess cmd $ \h -> do
meteredWrite p h b
return True
withHandle StdinHandle createProcessSuccess cmd $ \h ->
meteredWrite p h b
retrieve :: Remote -> Retriever
retrieve = byteRetriever . retrieve'