testremote: New command to test uploads/downloads to a remote.

This only performs some basic tests so far; no testing of chunking or
resuming. Also, the existing encryption type of the remote is used; it
would be good later to derive an encrypted and a non-encrypted version of
the remote and test them both.

This commit was sponsored by Joseph Liu.

1 files changed, 27 insertions, 11 deletions

diff --git a/Backend/Hash.hs b/Backend/Hash.hs
index 91267ed67..62d0a0fca 100644
--- a/Backend/Hash.hs
+++ b/Backend/Hash.hs
@@ -7,7 +7,10 @@
 
 {-# LANGUAGE CPP #-}
 
-module Backend.Hash (backends) where
+module Backend.Hash (
+	backends,
+	testKeyBackend,
+) where
 
 import Common.Annex
 import qualified Annex
@@ -36,10 +39,10 @@ hashes = concat
 
 {- The SHA256E backend is the default, so genBackendE comes first. -}
 backends :: [Backend]
-backends = catMaybes $ map genBackendE hashes ++ map genBackend hashes
+backends = map genBackendE hashes ++ map genBackend hashes
 
-genBackend :: Hash -> Maybe Backend
-genBackend hash = Just Backend
+genBackend :: Hash -> Backend
+genBackend hash = Backend
 	{ name = hashName hash
 	, getKey = keyValue hash
 	, fsckKey = Just $ checkKeyChecksum hash
@@ -48,13 +51,11 @@ genBackend hash = Just Backend
 	, isStableKey = const True
 	}
 
-genBackendE :: Hash -> Maybe Backend
-genBackendE hash = do
-	b <- genBackend hash
-	return $ b 
-		{ name = hashNameE hash
-		, getKey = keyValueE hash
-		}
+genBackendE :: Hash -> Backend
+genBackendE hash = (genBackend hash)
+	{ name = hashNameE hash
+	, getKey = keyValueE hash
+	}
 
 hashName :: Hash -> String
 hashName (SHAHash size) = "SHA" ++ show size
@@ -176,3 +177,18 @@ skeinHasher hashsize
 	| hashsize == 512 = show . skein512
 #endif
 	| otherwise = error $ "unsupported skein size " ++ show hashsize
+
+{- A varient of the SHA256E backend, for testing that needs special keys
+ - that cannot collide with legitimate keys in the repository.
+ -
+ - This is accomplished by appending a special extension to the key,
+ - that is not one that selectExtension would select (due to being too
+ - long).
+ -}
+testKeyBackend :: Backend
+testKeyBackend = 
+	let b = genBackendE (SHAHash 256)
+	in b { getKey = (fmap addE) <$$> getKey b } 
+  where
+	addE k = k { keyName = keyName k ++ longext }
+	longext = ".this-is-a-test-key"