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:
Joey Hess 2014-08-06 13:45:19 -04:00
parent 781833b16f
commit b4cf22a388
24 changed files with 167 additions and 163 deletions

View file

@ -58,8 +58,8 @@ gen r u c gc = do
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap buprepo
, removeKey = remove buprepo
, hasKey = checkPresent r bupr'
, hasKeyCheap = bupLocal buprepo
, checkPresent = checkKey r bupr'
, checkPresentCheap = bupLocal buprepo
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
@ -163,14 +163,13 @@ remove buprepo k = do
- in a bup repository. One way it to check if the git repository has
- a branch matching the name (as created by bup split -n).
-}
checkPresent :: Git.Repo -> Git.Repo -> Key -> Annex (Either String Bool)
checkPresent r bupr k
checkKey :: Git.Repo -> Git.Repo -> Key -> Annex Bool
checkKey r bupr k
| Git.repoIsUrl bupr = do
showChecking r
ok <- onBupRemote bupr boolSystem "git" params
return $ Right ok
| otherwise = liftIO $ catchMsgIO $
boolSystem "git" $ Git.Command.gitCommandLine params bupr
onBupRemote bupr boolSystem "git" params
| otherwise = liftIO $ boolSystem "git" $
Git.Command.gitCommandLine params bupr
where
params =
[ Params "show-ref --quiet --verify"

View file

@ -54,8 +54,8 @@ gen r u c gc = do
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap
, removeKey = remove ddarrepo
, hasKey = checkPresent ddarrepo
, hasKeyCheap = ddarLocal ddarrepo
, checkPresent = checkKey ddarrepo
, checkPresentCheap = ddarLocal ddarrepo
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
@ -181,13 +181,14 @@ inDdarManifest ddarrepo k = do
where
k' = key2file k
checkPresent :: DdarRepo -> Key -> Annex (Either String Bool)
checkPresent ddarrepo key = do
checkKey :: DdarRepo -> Key -> Annex Bool
checkKey ddarrepo key = do
directoryExists <- ddarDirectoryExists ddarrepo
case directoryExists of
Left e -> return $ Left e
Right True -> inDdarManifest ddarrepo key
Right False -> return $ Right False
Left e -> error e
Right True -> either error return
=<< inDdarManifest ddarrepo key
Right False -> return False
ddarLocal :: DdarRepo -> Bool
ddarLocal = notElem ':'

View file

@ -52,8 +52,8 @@ gen r u c gc = do
retrieveKeyFile = retreiveKeyFileDummy,
retrieveKeyFileCheap = retrieveCheap dir chunkconfig,
removeKey = remove dir,
hasKey = checkPresent dir chunkconfig,
hasKeyCheap = True,
checkPresent = checkKey dir chunkconfig,
checkPresentCheap = True,
whereisKey = Nothing,
remoteFsck = Nothing,
repairRepo = Nothing,
@ -189,13 +189,10 @@ removeDirGeneric topdir dir = do
then return ok
else doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir)
checkPresent :: FilePath -> ChunkConfig -> Key -> Annex (Either String Bool)
checkPresent d (LegacyChunks _) k = Legacy.checkPresent d locations k
checkPresent d _ k = liftIO $ do
v <- catchMsgIO $ anyM doesFileExist (locations d k)
case v of
Right False -> ifM (doesDirectoryExist d)
( return v
, return $ Left $ "directory " ++ d ++ " is not accessible"
)
_ -> return v
checkKey :: FilePath -> ChunkConfig -> Key -> Annex Bool
checkKey d (LegacyChunks _) k = Legacy.checkKey d locations k
checkKey d _ k = liftIO $
ifM (anyM doesFileExist (locations d k))
( return True
, error $ "directory " ++ d ++ " is not accessible"
)

View file

@ -103,8 +103,7 @@ retrieve locations d basek a = do
liftIO $ nukeFile tmp
sink b
checkPresent :: FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> Annex (Either String Bool)
checkPresent d locations k = liftIO $ catchMsgIO $
withStoredFiles d locations k $
-- withStoredFiles checked that it exists
const $ return True
checkKey :: FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> Annex Bool
checkKey d locations k = liftIO $ withStoredFiles d locations k $
-- withStoredFiles checked that it exists
const $ return True

View file

@ -53,8 +53,8 @@ gen r u c gc = do
retrieveKeyFile = retreiveKeyFileDummy,
retrieveKeyFileCheap = \_ _ -> return False,
removeKey = remove external,
hasKey = checkPresent external,
hasKeyCheap = False,
checkPresent = checkKey external,
checkPresentCheap = False,
whereisKey = Nothing,
remoteFsck = Nothing,
repairRepo = Nothing,
@ -121,8 +121,8 @@ remove external k = safely $
return False
_ -> Nothing
checkPresent :: External -> Key -> Annex (Either String Bool)
checkPresent external k = either (Left . show) id <$> tryAnnex go
checkKey :: External -> Key -> Annex Bool
checkKey external k = either error id <$> go
where
go = handleRequest external (CHECKPRESENT k) Nothing $ \resp ->
case resp of

View file

@ -46,7 +46,6 @@ import Utility.Tmp
import Logs.Remote
import Logs.Transfer
import Utility.Gpg
import Utility.FileMode
remote :: RemoteType
remote = RemoteType {
@ -109,8 +108,8 @@ gen' r u c gc = do
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = \_ _ -> return False
, removeKey = remove this rsyncopts
, hasKey = checkPresent this rsyncopts
, hasKeyCheap = repoCheap r
, checkPresent = checkKey this rsyncopts
, checkPresentCheap = repoCheap r
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
@ -342,16 +341,15 @@ remove r rsyncopts k
removersync = Remote.Rsync.remove rsyncopts k
removeshell = Ssh.dropKey (repo r) k
checkPresent :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex (Either String Bool)
checkPresent r rsyncopts k
checkKey :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex Bool
checkKey r rsyncopts k
| not $ Git.repoIsUrl (repo r) =
guardUsable (repo r) (cantCheck $ repo r) $
liftIO $ catchDefaultIO (cantCheck $ repo r) $
Right <$> doesFileExist (gCryptLocation r k)
liftIO $ doesFileExist (gCryptLocation r k)
| Git.repoIsSsh (repo r) = shellOrRsync r checkshell checkrsync
| otherwise = unsupportedUrl
where
checkrsync = Remote.Rsync.checkPresent (repo r) rsyncopts k
checkrsync = Remote.Rsync.checkKey (repo r) rsyncopts k
checkshell = Ssh.inAnnex (repo r) k
{- Annexed objects are hashed using lower-case directories for max

View file

@ -141,8 +141,8 @@ gen r u c gc
, retrieveKeyFile = copyFromRemote new
, retrieveKeyFileCheap = copyFromRemoteCheap new
, removeKey = dropKey new
, hasKey = inAnnex new
, hasKeyCheap = repoCheap r
, checkPresent = inAnnex new
, checkPresentCheap = repoCheap r
, whereisKey = Nothing
, remoteFsck = if Git.repoIsUrl r
then Nothing
@ -284,11 +284,8 @@ tryGitConfigRead r
void $ tryAnnex $ ensureInitialized
Annex.getState Annex.repo
{- Checks if a given remote has the content for a key inAnnex.
- If the remote cannot be accessed, or if it cannot determine
- whether it has the content, returns a Left error message.
-}
inAnnex :: Remote -> Key -> Annex (Either String Bool)
{- Checks if a given remote has the content for a key in its annex. -}
inAnnex :: Remote -> Key -> Annex Bool
inAnnex rmt key
| Git.repoIsHttp r = checkhttp
| Git.repoIsUrl r = checkremote
@ -298,17 +295,13 @@ inAnnex rmt key
checkhttp = do
showChecking r
ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls rmt key))
( return $ Right True
, return $ Left "not found"
( return True
, error "not found"
)
checkremote = Ssh.inAnnex r key
checklocal = guardUsable r (cantCheck r) $ dispatch <$> check
where
check = either (Left . show) Right
<$> tryAnnex (onLocal rmt $ Annex.Content.inAnnexSafe key)
dispatch (Left e) = Left e
dispatch (Right (Just b)) = Right b
dispatch (Right Nothing) = cantCheck r
checklocal = guardUsable r (cantCheck r) $
fromMaybe (cantCheck r)
<$> onLocal rmt (Annex.Content.inAnnexSafe key)
keyUrls :: Remote -> Key -> [String]
keyUrls r key = map tourl locs'

View file

@ -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.)"

View file

@ -12,7 +12,7 @@ module Remote.Helper.Chunked (
storeChunks,
removeChunks,
retrieveChunks,
hasKeyChunks,
checkPresentChunks,
) where
import Common.Annex
@ -94,8 +94,8 @@ storeChunks
-> Key
-> FilePath
-> MeterUpdate
-> (Key -> ContentSource -> MeterUpdate -> Annex Bool)
-> (Key -> Annex (Either String Bool))
-> Storer
-> CheckPresent
-> Annex Bool
storeChunks u chunkconfig k f p storer checker =
case chunkconfig of
@ -158,7 +158,7 @@ storeChunks u chunkconfig k f p storer checker =
seekResume
:: Handle
-> ChunkKeyStream
-> (Key -> Annex (Either String Bool))
-> CheckPresent
-> Annex (ChunkKeyStream, BytesProcessed)
seekResume h chunkkeys checker = do
sz <- liftIO (hFileSize h)
@ -172,7 +172,7 @@ seekResume h chunkkeys checker = do
liftIO $ hSeek h AbsoluteSeek sz
return (cks, toBytesProcessed sz)
| otherwise = do
v <- checker k
v <- tryNonAsyncAnnex (checker k)
case v of
Right True ->
check pos' cks' sz
@ -331,43 +331,48 @@ setupResume ls currsize = map dropunneeded ls
{- Checks if a key is present in a remote. This requires any one
- of the lists of options returned by chunkKeys to all check out
- as being present using the checker action.
-
- Throws an exception if the remote is not accessible.
-}
hasKeyChunks
:: (Key -> Annex (Either String Bool))
checkPresentChunks
:: CheckPresent
-> UUID
-> ChunkConfig
-> EncKey
-> Key
-> Annex (Either String Bool)
hasKeyChunks checker u chunkconfig encryptor basek
| noChunks chunkconfig =
-> Annex Bool
checkPresentChunks checker u chunkconfig encryptor basek
| noChunks chunkconfig = do
-- Optimisation: Try the unchunked key first, to avoid
-- looking in the git-annex branch for chunk counts
-- that are likely not there.
ifM ((Right True ==) <$> checker (encryptor basek))
( return (Right True)
, checklists Nothing =<< chunkKeysOnly u basek
)
v <- check basek
case v of
Right True -> return True
_ -> checklists Nothing =<< chunkKeysOnly u basek
| otherwise = checklists Nothing =<< chunkKeys u chunkconfig basek
where
checklists Nothing [] = return (Right False)
checklists (Just deferrederror) [] = return (Left deferrederror)
checklists Nothing [] = return False
checklists (Just deferrederror) [] = error deferrederror
checklists d (l:ls)
| not (null l) = do
v <- checkchunks l
case v of
Left e -> checklists (Just e) ls
Right True -> return (Right True)
Right True -> return True
Right False -> checklists Nothing ls
| otherwise = checklists d ls
checkchunks :: [Key] -> Annex (Either String Bool)
checkchunks [] = return (Right True)
checkchunks (k:ks) = do
v <- checker (encryptor k)
if v == Right True
then checkchunks ks
else return v
v <- check k
case v of
Right True -> checkchunks ks
Right False -> return $ Right False
Left e -> return $ Left $ show e
check = tryNonAsyncAnnex . checker . encryptor
{- A key can be stored in a remote unchunked, or as a list of chunked keys.
- This can be the case whether or not the remote is currently configured

View file

@ -91,9 +91,9 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r = r
, removeKey = \k -> cip k >>= maybe
(removeKey r k)
(\(_, enckey) -> removeKey r enckey)
, hasKey = \k -> cip k >>= maybe
(hasKey r k)
(\(_, enckey) -> hasKey r enckey)
, checkPresent = \k -> cip k >>= maybe
(checkPresent r k)
(\(_, enckey) -> checkPresent r enckey)
, cost = maybe
(cost r)
(const $ cost r + encryptedRemoteCostAdj)

View file

@ -39,7 +39,7 @@ addHooks' r starthook stophook = r'
, retrieveKeyFile = \k f d p -> wrapper $ retrieveKeyFile r k f d p
, retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f
, removeKey = wrapper . removeKey r
, hasKey = wrapper . hasKey r
, checkPresent = wrapper . checkPresent r
}
where
wrapper = runHooks r' starthook stophook

View file

@ -13,5 +13,5 @@ import qualified Git
showChecking :: Git.Repo -> Annex ()
showChecking r = showAction $ "checking " ++ Git.repoDescribe r
cantCheck :: Git.Repo -> Either String Bool
cantCheck r = Left $ "unable to check " ++ Git.repoDescribe r
cantCheck :: Git.Repo -> a
cantCheck r = error $ "unable to check " ++ Git.repoDescribe r

View file

@ -148,7 +148,7 @@ specialRemote' cfg c preparestorer prepareretriever baser = encr
(retrieveKeyFileCheap baser k d)
(\_ -> return False)
, removeKey = \k -> cip >>= removeKeyGen k
, hasKey = \k -> cip >>= hasKeyGen k
, checkPresent = \k -> cip >>= checkPresentGen k
, cost = maybe
(cost baser)
(const $ cost baser + encryptedRemoteCostAdj)
@ -167,7 +167,7 @@ specialRemote' cfg c preparestorer prepareretriever baser = encr
displayprogress p k $ \p' ->
storeChunks (uuid baser) chunkconfig k src p'
(storechunk enc storer)
(hasKey baser)
(checkPresent baser)
go Nothing = return False
rollback = void $ removeKey encr k
@ -193,10 +193,10 @@ specialRemote' cfg c preparestorer prepareretriever baser = encr
enck = maybe id snd enc
remover = removeKey baser
hasKeyGen k enc = hasKeyChunks checker (uuid baser) chunkconfig enck k
checkPresentGen k enc = checkPresentChunks checker (uuid baser) chunkconfig enck k
where
enck = maybe id snd enc
checker = hasKey baser
checker = checkPresent baser
chunkconfig = chunkConfig cfg

View file

@ -81,14 +81,14 @@ onRemote r (with, errorval) command params fields = do
Nothing -> return errorval
{- Checks if a remote contains a key. -}
inAnnex :: Git.Repo -> Key -> Annex (Either String Bool)
inAnnex :: Git.Repo -> Key -> Annex Bool
inAnnex r k = do
showChecking r
onRemote r (check, cantCheck r) "inannex" [Param $ key2file k] []
where
check c p = dispatch <$> safeSystem c p
dispatch ExitSuccess = Right True
dispatch (ExitFailure 1) = Right False
dispatch ExitSuccess = True
dispatch (ExitFailure 1) = False
dispatch _ = cantCheck r
{- Removes a key from a remote. -}

View file

@ -45,8 +45,8 @@ gen r u c gc = do
retrieveKeyFile = retreiveKeyFileDummy,
retrieveKeyFileCheap = retrieveCheap hooktype,
removeKey = remove hooktype,
hasKey = checkPresent r hooktype,
hasKeyCheap = False,
checkPresent = checkKey r hooktype,
checkPresentCheap = False,
whereisKey = Nothing,
remoteFsck = Nothing,
repairRepo = Nothing,
@ -128,11 +128,11 @@ retrieveCheap _ _ _ = return False
remove :: HookName -> Key -> Annex Bool
remove h k = runHook h "remove" k Nothing $ return True
checkPresent :: Git.Repo -> HookName -> Key -> Annex (Either String Bool)
checkPresent r h k = do
checkKey :: Git.Repo -> HookName -> Key -> Annex Bool
checkKey r h k = do
showAction $ "checking " ++ Git.repoDescribe r
v <- lookupHook h action
liftIO $ catchMsgIO $ check v
liftIO $ check v
where
action = "checkpresent"
findkey s = key2file k `elem` lines s

View file

@ -12,7 +12,7 @@ module Remote.Rsync (
store,
retrieve,
remove,
checkPresent,
checkKey,
withRsyncScratchDir,
genRsyncOpts,
RsyncOpts
@ -66,8 +66,8 @@ gen r u c gc = do
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap o
, removeKey = remove o
, hasKey = checkPresent r o
, hasKeyCheap = False
, checkPresent = checkKey r o
, checkPresentCheap = False
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
@ -214,14 +214,12 @@ remove o k = do
, dir </> keyFile k </> "***"
]
checkPresent :: Git.Repo -> RsyncOpts -> Key -> Annex (Either String Bool)
checkPresent r o k = do
checkKey :: Git.Repo -> RsyncOpts -> Key -> Annex Bool
checkKey r o k = do
showAction $ "checking " ++ Git.repoDescribe r
-- note: Does not currently differentiate between rsync failing
-- to connect, and the file not being present.
Right <$> check
where
check = untilTrue (rsyncUrls o k) $ \u ->
untilTrue (rsyncUrls o k) $ \u ->
liftIO $ catchBoolIO $ do
withQuietOutput createProcessSuccess $
proc "rsync" $ toCommand $

View file

@ -57,8 +57,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
retrieveKeyFile = retreiveKeyFileDummy,
retrieveKeyFileCheap = retrieveCheap this,
removeKey = remove this c,
hasKey = checkPresent this,
hasKeyCheap = False,
checkPresent = checkKey this,
checkPresentCheap = False,
whereisKey = Nothing,
remoteFsck = Nothing,
repairRepo = Nothing,
@ -167,16 +167,16 @@ remove' :: Remote -> Key -> Annex Bool
remove' r k = s3Action r False $ \(conn, bucket) ->
s3Bool =<< liftIO (deleteObject conn $ bucketKey r bucket k)
checkPresent :: Remote -> Key -> Annex (Either String Bool)
checkPresent r k = s3Action r noconn $ \(conn, bucket) -> do
checkKey :: Remote -> Key -> Annex Bool
checkKey r k = s3Action r noconn $ \(conn, bucket) -> do
showAction $ "checking " ++ name r
res <- liftIO $ getObjectInfo conn $ bucketKey r bucket k
case res of
Right _ -> return $ Right True
Left (AWSError _ _) -> return $ Right False
Left e -> return $ Left (s3Error e)
Right _ -> return True
Left (AWSError _ _) -> return False
Left e -> s3Error e
where
noconn = Left $ error "S3 not configured"
noconn = error "S3 not configured"
s3Warning :: ReqError -> Annex Bool
s3Warning e = do

View file

@ -72,8 +72,8 @@ gen r u c gc = do
retrieveKeyFile = retrieve u hdl,
retrieveKeyFileCheap = \_ _ -> return False,
removeKey = remove,
hasKey = checkPresent u hdl,
hasKeyCheap = False,
checkPresent = checkKey u hdl,
checkPresentCheap = False,
whereisKey = Nothing,
remoteFsck = Nothing,
repairRepo = Nothing,
@ -123,14 +123,16 @@ remove _k = do
warning "content cannot be removed from tahoe remote"
return False
checkPresent :: UUID -> TahoeHandle -> Key -> Annex (Either String Bool)
checkPresent u hdl k = go =<< getCapability u k
checkKey :: UUID -> TahoeHandle -> Key -> Annex Bool
checkKey u hdl k = go =<< getCapability u k
where
go Nothing = return (Right False)
go (Just cap) = liftIO $ parseCheck <$> readTahoe hdl "check"
[ Param "--raw"
, Param cap
]
go Nothing = return False
go (Just cap) = liftIO $ do
v <- parseCheck <$> readTahoe hdl "check"
[ Param "--raw"
, Param cap
]
either error return v
defaultTahoeConfigDir :: UUID -> IO TahoeConfigDir
defaultTahoeConfigDir u = do

View file

@ -50,8 +50,8 @@ gen r _ c gc =
retrieveKeyFile = downloadKey,
retrieveKeyFileCheap = downloadKeyCheap,
removeKey = dropKey,
hasKey = checkKey,
hasKeyCheap = False,
checkPresent = checkKey,
checkPresentCheap = False,
whereisKey = Just getUrls,
remoteFsck = Nothing,
repairRepo = Nothing,
@ -98,12 +98,12 @@ dropKey k = do
mapM_ (setUrlMissing k) =<< getUrls k
return True
checkKey :: Key -> Annex (Either String Bool)
checkKey :: Key -> Annex Bool
checkKey key = do
us <- getUrls key
if null us
then return $ Right False
else return =<< checkKey' key us
then return False
else either error return =<< checkKey' key us
checkKey' :: Key -> [URLString] -> Annex (Either String Bool)
checkKey' key us = firsthit us (Right False) $ \u -> do
let (u', downloader) = getDownloader u

View file

@ -63,8 +63,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
retrieveKeyFile = retrieve this,
retrieveKeyFileCheap = retrieveCheap this,
removeKey = remove this,
hasKey = checkPresent this,
hasKeyCheap = False,
checkPresent = checkKey this,
checkPresentCheap = False,
whereisKey = Nothing,
remoteFsck = Nothing,
repairRepo = Nothing,
@ -170,10 +170,10 @@ remove r k = davAction r False $ \(baseurl, user, pass) -> liftIO $ do
let url = davLocation baseurl k
isJust . eitherToMaybe <$> tryNonAsync (deleteDAV url user pass)
checkPresent :: Remote -> Key -> Annex (Either String Bool)
checkPresent r k = davAction r noconn go
checkKey :: Remote -> Key -> Annex Bool
checkKey r k = davAction r noconn (either error id <$$> go)
where
noconn = Left $ error $ name r ++ " not configured"
noconn = error $ name r ++ " not configured"
go (baseurl, user, pass) = do
showAction $ "checking " ++ name r