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, 31 insertions, 6 deletions

diff --git a/Command/Map.hs b/Command/Map.hs
index a62c3e1ad..b1d28113b 100644
--- a/Command/Map.hs
+++ b/Command/Map.hs
@@ -200,7 +200,7 @@ tryScan r
 	  where
 		p = proc cmd $ toCommand params
 
-	configlist = Ssh.onRemote r (pipedconfig, Nothing) "configlist" [] []
+	configlist = Ssh.onRemote r (pipedconfig, return Nothing) "configlist" [] []
 	manualconfiglist = do
 		gc <- Annex.getRemoteGitConfig r
 		sshparams <- Ssh.toRepo r gc [Param sshcmd]
diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index cb36b66ba..3e1933d21 100644
--- a/Command/TestRemote.hs
+++ b/Command/TestRemote.hs
@@ -62,13 +62,16 @@ start basesz ws = do
 	ks <- mapM randKey (keySizes basesz fast)
 	rs <- catMaybes <$> mapM (adjustChunkSize r) (chunkSizes basesz fast)
 	rs' <- concat <$> mapM encryptionVariants rs
-	next $ perform rs' ks
+	unavailrs  <- catMaybes <$> mapM Remote.mkUnavailable [r]
+	next $ perform rs' unavailrs ks
 
-perform :: [Remote] -> [Key] -> CommandPerform
-perform rs ks = do
+perform :: [Remote] -> [Remote] -> [Key] -> CommandPerform
+perform rs unavailrs ks = do
 	st <- Annex.getState id
-	let tests = testGroup "Remote Tests" $
-		[ testGroup (desc r k) (test st r k) | k <- ks, r <- rs ]
+	let tests = testGroup "Remote Tests" $ concat
+		[ [ testGroup "unavailable remote" (testUnavailable st r (Prelude.head ks)) | r <- unavailrs ]
+		, [ testGroup (desc r k) (test st r k) | k <- ks, r <- rs ]
+		]
 	ok <- case tryIngredients [consoleTestReporter] mempty tests of
 		Nothing -> error "No tests found!?"
 		Just act -> liftIO act
@@ -155,6 +158,28 @@ test st r k =
 	store = Remote.storeKey r k Nothing nullMeterUpdate
 	remove = Remote.removeKey r k
 
+testUnavailable :: Annex.AnnexState -> Remote -> Key -> [TestTree]
+testUnavailable st r k =
+	[ check (== Right False) "removeKey" $
+		Remote.removeKey r k
+	, check (== Right False) "storeKey" $
+		Remote.storeKey r k Nothing nullMeterUpdate
+	, check (`notElem` [Right True, Right False]) "checkPresent" $
+		Remote.checkPresent r k
+	, check (== Right False) "retrieveKeyFile" $
+		getViaTmp k $ \dest ->
+			Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate
+	, check (== Right False) "retrieveKeyFileCheap" $
+		getViaTmp k $ \dest ->
+			Remote.retrieveKeyFileCheap r k dest
+	]
+  where
+	check checkval desc a = testCase desc $ do
+		v <- Annex.eval st $ do
+			Annex.setOutput QuietOutput
+			either (Left  . show) Right <$> tryNonAsync a
+		checkval v  @? ("(got: " ++ show v ++ ")")
+
 cleanup :: [Remote] -> [Key] -> Bool -> CommandCleanup
 cleanup rs ks ok = do
 	forM_ rs $ \r -> forM_ ks (Remote.removeKey r)