testremote: Add testing of behavior when remote is not available

Added a mkUnavailable method, which a Remote can use to generate a version
of itself that is not available. Implemented for several, but not yet all
remotes.

This allows testing that checkPresent properly throws an exceptions when
it cannot check if a key is present or not. It also allows testing that the
other methods don't throw exceptions in these circumstances.

This immediately found several bugs, which this commit also fixes!

* git remotes using ssh accidentially had checkPresent return
  an exception, rather than throwing it
* The chunking code accidentially returned False rather than
  propigating an exception when there were no chunks and
  checkPresent threw an exception for the non-chunked key.

This commit was sponsored by Carlo Matteo Capocasa.

2 files changed, 10 insertions, 9 deletions

diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index 5e4ea111f..271978658 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -348,11 +348,12 @@ checkPresentChunks checker u chunkconfig encryptor basek
 		v <- check basek
 		case v of
 			Right True -> return True
+			Left e -> checklists (Just e) =<< chunkKeysOnly u basek
 			_ -> checklists Nothing =<< chunkKeysOnly u basek
 	| otherwise = checklists Nothing =<< chunkKeys u chunkconfig basek
   where
 	checklists Nothing [] = return False
-	checklists (Just deferrederror) [] = error deferrederror
+	checklists (Just deferrederror) [] = throwM deferrederror
 	checklists d (l:ls)
 		| not (null l) = do
 			v <- checkchunks l
@@ -362,14 +363,14 @@ checkPresentChunks checker u chunkconfig encryptor basek
 				Right False -> checklists Nothing ls
 		| otherwise = checklists d ls
 	
-	checkchunks :: [Key] -> Annex (Either String Bool)
+	checkchunks :: [Key] -> Annex (Either SomeException Bool)
 	checkchunks [] = return (Right True)
 	checkchunks (k:ks) = do
 		v <- check k
 		case v of
 			Right True -> checkchunks ks
 			Right False -> return $ Right False
-			Left e -> return $ Left $ show e
+			Left e -> return $ Left e
 
 	check = tryNonAsync . checker . encryptor
 
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index 42d77ea59..9f0a77178 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -69,7 +69,7 @@ git_annex_shell r command params fields
  - a specified error value. -}
 onRemote 
 	:: Git.Repo
-	-> (FilePath -> [CommandParam] -> IO a, a)
+	-> (FilePath -> [CommandParam] -> IO a, Annex a)
 	-> String
 	-> [CommandParam]
 	-> [(Field, String)]
@@ -78,7 +78,7 @@ onRemote r (with, errorval) command params fields = do
 	s <- git_annex_shell r command params fields
 	case s of
 		Just (c, ps) -> liftIO $ with c ps
-		Nothing -> return errorval
+		Nothing -> errorval
 
 {- Checks if a remote contains a key. -}
 inAnnex :: Git.Repo -> Key -> Annex Bool
@@ -86,14 +86,14 @@ 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 = True
-	dispatch (ExitFailure 1) = False
+	check c p = dispatch =<< safeSystem c p
+	dispatch ExitSuccess = return True
+	dispatch (ExitFailure 1) = return False
 	dispatch _ = cantCheck r
 
 {- Removes a key from a remote. -}
 dropKey :: Git.Repo -> Key -> Annex Bool
-dropKey r key = onRemote r (boolSystem, False) "dropkey"
+dropKey r key = onRemote r (boolSystem, return False) "dropkey"
 	[ Params "--quiet --force"
 	, Param $ key2file key
 	]