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.

6 files changed, 39 insertions, 34 deletions

diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index 7ad790cb1..953c533b6 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -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
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 65a3ba284..c364a69e7 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -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)
diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs
index c3ff970c6..907400bd1 100644
--- a/Remote/Helper/Hooks.hs
+++ b/Remote/Helper/Hooks.hs
@@ -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
diff --git a/Remote/Helper/Messages.hs b/Remote/Helper/Messages.hs
index c4b1966dc..3088a9ab2 100644
--- a/Remote/Helper/Messages.hs
+++ b/Remote/Helper/Messages.hs
@@ -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
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 2bcb7d530..3c19f25eb 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -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
 
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index 05a98865f..42d77ea59 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -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. -}