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.

1 files changed, 18 insertions, 3 deletions

diff --git a/Remote/Git.hs b/Remote/Git.hs
index 20955ff5b..5416a5cda 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -55,6 +55,7 @@ import Creds
 import Control.Concurrent
 import Control.Concurrent.MSampleVar
 import qualified Data.Map as M
+import Network.URI
 
 remote :: RemoteType
 remote = RemoteType {
@@ -156,8 +157,22 @@ gen r u c gc
 			, readonly = Git.repoIsHttp r
 			, availability = availabilityCalc r
 			, remotetype = remote
+			, mkUnavailable = unavailable r u c gc
 			}
 
+unavailable :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
+unavailable r u c gc = gen r' u c gc
+  where
+	r' = case Git.location r of
+		Git.Local { Git.gitdir = d } ->
+			r { Git.location = Git.LocalUnknown d }
+		Git.Url url -> case uriAuthority url of
+			Just auth -> 
+				let auth' = auth { uriRegName = "!dne!" }
+				in r { Git.location = Git.Url (url { uriAuthority = Just auth' })}
+			Nothing -> r { Git.location = Git.Unknown }
+		_ -> r -- already unavailable
+
 {- Checks relatively inexpensively if a repository is available for use. -}
 repoAvail :: Git.Repo -> Annex Bool
 repoAvail r 
@@ -180,7 +195,7 @@ tryGitConfigRead :: Git.Repo -> Annex Git.Repo
 tryGitConfigRead r 
 	| haveconfig r = return r -- already read
 	| Git.repoIsSsh r = store $ do
-		v <- Ssh.onRemote r (pipedconfig, Left undefined) "configlist" [] []
+		v <- Ssh.onRemote r (pipedconfig, return (Left undefined)) "configlist" [] []
 		case v of
 			Right r'
 				| haveconfig r' -> return r'
@@ -298,8 +313,8 @@ inAnnex rmt key
 			)
 	checkremote = Ssh.inAnnex r key
 	checklocal = guardUsable r (cantCheck r) $
-		fromMaybe (cantCheck r)
-			<$> onLocal rmt (Annex.Content.inAnnexSafe key)
+		maybe (cantCheck r) return
+			=<< onLocal rmt (Annex.Content.inAnnexSafe key)
 
 keyUrls :: Remote -> Key -> [String]
 keyUrls r key = map tourl locs'