pushed checkPresent exception handling out of Remote implementations
I tend to prefer moving toward explicit exception handling, not away from it, but in this case, I think there are good reasons to let checkPresent throw exceptions: 1. They can all be caught in one place (Remote.hasKey), and we know every possible exception is caught there now, which we didn't before. 2. It simplified the code of the Remotes. I think it makes sense for Remotes to be able to be implemented without needing to worry about catching exceptions inside them. (Mostly.) 3. Types.StoreRetrieve.Preparer can only work on things that return a Bool, which all the other relevant remote methods already did. I do not see a good way to generalize that type; my previous attempts failed miserably.
This commit is contained in:
parent
781833b16f
commit
b4cf22a388
24 changed files with 167 additions and 163 deletions
|
@ -52,8 +52,8 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
|
|||
retrieveKeyFile = retreiveKeyFileDummy,
|
||||
retrieveKeyFileCheap = retrieveCheap this,
|
||||
removeKey = remove this,
|
||||
hasKey = checkPresent this,
|
||||
hasKeyCheap = False,
|
||||
checkPresent = checkKey this,
|
||||
checkPresentCheap = False,
|
||||
whereisKey = Nothing,
|
||||
remoteFsck = Nothing,
|
||||
repairRepo = Nothing,
|
||||
|
@ -164,25 +164,21 @@ remove r k = glacierAction r
|
|||
, Param $ archive r k
|
||||
]
|
||||
|
||||
checkPresent :: Remote -> Key -> Annex (Either String Bool)
|
||||
checkPresent r k = do
|
||||
checkKey :: Remote -> Key -> Annex Bool
|
||||
checkKey r k = do
|
||||
showAction $ "checking " ++ name r
|
||||
go =<< glacierEnv (config r) (uuid r)
|
||||
where
|
||||
go Nothing = return $ Left "cannot check glacier"
|
||||
go Nothing = error "cannot check glacier"
|
||||
go (Just e) = do
|
||||
{- glacier checkpresent outputs the archive name to stdout if
|
||||
- it's present. -}
|
||||
v <- liftIO $ catchMsgIO $
|
||||
readProcessEnv "glacier" (toCommand params) (Just e)
|
||||
case v of
|
||||
Right s -> do
|
||||
let probablypresent = key2file k `elem` lines s
|
||||
if probablypresent
|
||||
then ifM (Annex.getFlag "trustglacier")
|
||||
( return $ Right True, untrusted )
|
||||
else return $ Right False
|
||||
Left err -> return $ Left err
|
||||
s <- liftIO $ readProcessEnv "glacier" (toCommand params) (Just e)
|
||||
let probablypresent = key2file k `elem` lines s
|
||||
if probablypresent
|
||||
then ifM (Annex.getFlag "trustglacier")
|
||||
( return True, error untrusted )
|
||||
else return False
|
||||
|
||||
params = glacierParams (config r)
|
||||
[ Param "archive"
|
||||
|
@ -192,7 +188,7 @@ checkPresent r k = do
|
|||
, Param $ archive r k
|
||||
]
|
||||
|
||||
untrusted = return $ Left $ unlines
|
||||
untrusted = unlines
|
||||
[ "Glacier's inventory says it has a copy."
|
||||
, "However, the inventory could be out of date, if it was recently removed."
|
||||
, "(Use --trust-glacier if you're sure it's still in Glacier.)"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue