add per-remote-type info

Now `git annex info $remote` shows info specific to the type of the remote,
for example, it shows the rsync url.

Remote types that support encryption or chunking also include that in their
info.

This commit was sponsored by Ævar Arnfjörð Bjarmason.

20 files changed, 82 insertions, 29 deletions

diff --git a/Command/Info.hs b/Command/Info.hs
index 5cac2954a..96b7eb6d7 100644
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -125,7 +125,8 @@ fileInfo file k = showCustom (unwords ["info", file]) $ do
 
 remoteInfo :: Remote -> Annex ()
 remoteInfo r = showCustom (unwords ["info", Remote.name r]) $ do
-	evalStateT (mapM_ showStat (remote_stats r)) emptyStatInfo
+	info <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r
+	evalStateT (mapM_ showStat (remote_stats r ++ info)) emptyStatInfo
 	return True
 
 selStats :: [Stat] -> [Stat] -> Annex [Stat]
@@ -179,16 +180,21 @@ file_stats f k =
 	]
 
 remote_stats :: Remote -> [Stat]
-remote_stats r =
-	[ remote_name r
-	, remote_description r
-	, remote_uuid r
-	, remote_cost r
+remote_stats r = map (\s -> s r)
+	[ remote_name
+	, remote_description
+	, remote_uuid
+	, remote_cost
+	, remote_type
 	]
 
 stat :: String -> (String -> StatState String) -> Stat
 stat desc a = return $ Just (desc, a desc)
 
+-- The json simply contains the same string that is displayed.
+simpleStat :: String -> StatState String -> Stat
+simpleStat desc getval = stat desc $ json id getval
+
 nostat :: Stat
 nostat = return Nothing
 
@@ -209,7 +215,7 @@ showStat s = maybe noop calc =<< s
 		lift . showRaw =<< a
 
 repository_mode :: Stat
-repository_mode = stat "repository mode" $ json id $ lift $
+repository_mode = simpleStat "repository mode" $ lift $
 	ifM isDirect 
 		( return "direct", return "indirect" )
 
@@ -223,32 +229,36 @@ remote_list level = stat n $ nojson $ lift $ do
 	n = showTrustLevel level ++ " repositories"
 	
 dir_name :: FilePath -> Stat
-dir_name dir = stat "directory" $ json id $ pure dir
+dir_name dir = simpleStat "directory" $ pure dir
 
 file_name :: FilePath -> Stat
-file_name file = stat "file" $ json id $ pure file
+file_name file = simpleStat "file" $ pure file
 
 remote_name :: Remote -> Stat
-remote_name r = stat "remote" $ json id $ pure (Remote.name r)
+remote_name r = simpleStat "remote" $ pure (Remote.name r)
 
 remote_description :: Remote -> Stat
-remote_description r = stat "description" $ json id $ lift $
+remote_description r = simpleStat "description" $ lift $
 	Remote.prettyUUID (Remote.uuid r)
 
 remote_uuid :: Remote -> Stat
-remote_uuid r = stat "uuid" $ json id $ pure $
+remote_uuid r = simpleStat "uuid" $ pure $
 	fromUUID $ Remote.uuid r
 
 remote_cost :: Remote -> Stat
-remote_cost r = stat "cost" $ json id $ pure $
+remote_cost r = simpleStat "cost" $ pure $
 	show $ Remote.cost r
 
+remote_type :: Remote -> Stat
+remote_type r = simpleStat "type" $ pure $
+	Remote.typename $ Remote.remotetype r
+
 local_annex_keys :: Stat
 local_annex_keys = stat "local annex keys" $ json show $
 	countKeys <$> cachedPresentData
 
 local_annex_size :: Stat
-local_annex_size = stat "local annex size" $ json id $
+local_annex_size = simpleStat "local annex size" $
 	showSizeKeys <$> cachedPresentData
 
 known_annex_files :: Stat
@@ -256,7 +266,7 @@ known_annex_files = stat "annexed files in working tree" $ json show $
 	countKeys <$> cachedReferencedData
 
 known_annex_size :: Stat
-known_annex_size = stat "size of annexed files in working tree" $ json id $
+known_annex_size = simpleStat "size of annexed files in working tree" $
 	showSizeKeys <$> cachedReferencedData
 
 tmp_size :: Stat
@@ -266,13 +276,13 @@ bad_data_size :: Stat
 bad_data_size = staleSize "bad keys size" gitAnnexBadDir
 
 key_size :: Key -> Stat
-key_size k = stat "size" $ json id $ pure $ showSizeKeys $ foldKeys [k]
+key_size k = simpleStat "size" $ pure $ showSizeKeys $ foldKeys [k]
 
 key_name :: Key -> Stat
-key_name k = stat "key" $ json id $ pure $ key2file k
+key_name k = simpleStat "key" $ pure $ key2file k
 
 bloom_info :: Stat
-bloom_info = stat "bloom filter size" $ json id $ do
+bloom_info = simpleStat "bloom filter size" $ do
 	localkeys <- countKeys <$> cachedPresentData
 	capacity <- fromIntegral <$> lift Command.Unused.bloomCapacity
 	let note = aside $
@@ -305,7 +315,7 @@ transfer_list = stat "transfers in progress" $ nojson $ lift $ do
 		]
 
 disk_size :: Stat
-disk_size = stat "available local disk space" $ json id $ lift $
+disk_size = simpleStat "available local disk space" $ lift $
 	calcfree
 		<$> (annexDiskReserve <$> Annex.getGitConfig)
 		<*> inRepo (getDiskFree . gitAnnexDir)
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index cc64d6ff5..4f2ddf35a 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -73,6 +73,7 @@ gen r u c gc = do
 		, availability = if bupLocal buprepo then LocallyAvailable else GloballyAvailable
 		, readonly = False
 		, mkUnavailable = return Nothing
+		, getInfo = return [("repo", buprepo)]
 		}
 	return $ Just $ specialRemote' specialcfg c
 		(simplyPrepare $ store this buprepo)
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index 1db482b47..d73919bfd 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -70,6 +70,7 @@ gen r u c gc = do
 		, availability = if ddarLocal ddarrepo then LocallyAvailable else GloballyAvailable
 		, readonly = False
 		, mkUnavailable = return Nothing
+		, getInfo = return [("repo", ddarrepo)]
 		}
 	ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc
 	specialcfg = (specialRemoteCfg c)
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index fa4d027ae..2e9e013ab 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -67,7 +67,8 @@ gen r u c gc = do
 			availability = LocallyAvailable,
 			remotetype = remote,
 			mkUnavailable = gen r u c $
-				gc { remoteAnnexDirectory = Just "/dev/null" }
+				gc { remoteAnnexDirectory = Just "/dev/null" },
+			getInfo = return [("directory", dir)]
 		}
   where
 	dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc
diff --git a/Remote/External.hs b/Remote/External.hs
index d40972412..e907ab0cf 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -68,6 +68,7 @@ gen r u c gc = do
 			remotetype = remote,
 			mkUnavailable = gen r u c $
 				gc { remoteAnnexExternalType = Just "!dne!" }
+			, getInfo = return [("externaltype", externaltype)]
 		}
   where
 	externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index fc7718a2a..995c3e838 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -121,6 +121,7 @@ gen' r u c gc = do
 		, availability = availabilityCalc r
 		, remotetype = remote
 		, mkUnavailable = return Nothing
+		, getInfo = return $ gitRepoInfo r
 	}
 	return $ Just $ specialRemote' specialcfg c
 		(simplyPrepare $ store this rsyncopts)
diff --git a/Remote/Git.hs b/Remote/Git.hs
index a249f43b2..50c34a2bb 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -159,6 +159,7 @@ gen r u c gc
 			, availability = availabilityCalc r
 			, remotetype = remote
 			, mkUnavailable = unavailable r u c gc
+			, getInfo = return $ gitRepoInfo r
 			}
 
 unavailable :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 70bcec33f..0e2796da2 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -66,7 +66,8 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
 			readonly = False,
 			availability = GloballyAvailable,
 			remotetype = remote,
-			mkUnavailable = return Nothing
+			mkUnavailable = return Nothing,
+			getInfo = return [("glacier vault", getVault c)]
 		}
 	specialcfg = (specialRemoteCfg c)
 		-- Disabled until jobList gets support for chunks.
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index eb5dbc793..806fab542 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -8,6 +8,7 @@
 module Remote.Helper.Chunked (
 	ChunkSize,
 	ChunkConfig(..),
+	describeChunkConfig,
 	getChunkConfig,
 	storeChunks,
 	removeChunks,
@@ -34,6 +35,14 @@ data ChunkConfig
 	| LegacyChunks ChunkSize
 	deriving (Show)
 
+describeChunkConfig :: ChunkConfig -> String
+describeChunkConfig NoChunks = "none"
+describeChunkConfig (UnpaddedChunks sz) = describeChunkSize sz ++ "chunks"
+describeChunkConfig (LegacyChunks sz) = describeChunkSize sz ++ " chunks (old style)"
+
+describeChunkSize :: ChunkSize -> String
+describeChunkSize sz = roughSize storageUnits False (fromIntegral sz)
+
 noChunks :: ChunkConfig -> Bool
 noChunks NoChunks = True
 noChunks _ = False
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 9a8e9ba5b..5e342803d 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -16,6 +16,7 @@ module Remote.Helper.Encryptable (
 	cipherKey,
 	storeCipher,
 	extractCipher,
+	describeEncryption,
 ) where
 
 import qualified Data.Map as M
@@ -157,3 +158,10 @@ extractCipher c = case (M.lookup "cipher" c,
 	_ -> Nothing
   where
 	readkeys = KeyIds . split ","
+
+describeEncryption :: RemoteConfig -> String
+describeEncryption c = case extractCipher c of
+	Nothing -> "not encrypted"
+	(Just (SharedCipher _)) -> "encrypted (encryption key stored in git repository)"
+	(Just (EncryptedCipher _ _ (KeyIds { keyIds = ks }))) ->
+		"encrypted (to gpg keys: " ++ unwords ks ++ ")"
diff --git a/Remote/Helper/Git.hs b/Remote/Helper/Git.hs
index b405fd358..156d7ac28 100644
--- a/Remote/Helper/Git.hs
+++ b/Remote/Helper/Git.hs
@@ -30,3 +30,8 @@ guardUsable :: Git.Repo -> Annex a -> Annex a -> Annex a
 guardUsable r fallback a
 	| Git.repoIsLocalUnknown r = fallback
 	| otherwise = a
+
+gitRepoInfo :: Git.Repo -> [(String, String)]
+gitRepoInfo r =
+	[ ("repository location", Git.repoLocation r)
+	]
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 4738180a8..181d7548f 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -168,6 +168,12 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 			(cost baser)
 			(const $ cost baser + encryptedRemoteCostAdj)
 			(extractCipher c)
+		, getInfo = do
+			l <- getInfo baser
+			return $ l ++
+				[ ("encryption", describeEncryption c)
+				, ("chunking", describeChunkConfig (chunkConfig cfg))
+				]
 		}
 	cip = cipherKey c
 	gpgopts = getGpgEncParams encr
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 707e2cb75..f7c428e99 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -60,7 +60,8 @@ gen r u c gc = do
 			availability = GloballyAvailable,
 			remotetype = remote,
 			mkUnavailable = gen r u c $
-				gc { remoteAnnexHookType = Just "!dne!" }
+				gc { remoteAnnexHookType = Just "!dne!" },
+			getInfo = return [("hooktype", hooktype)]
 		}
   where
 	hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 7a965aa9d..a87d05a33 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -83,6 +83,7 @@ gen r u c gc = do
 			, availability = if islocal then LocallyAvailable else GloballyAvailable
 			, remotetype = remote
 			, mkUnavailable = return Nothing
+			, getInfo = return [("url", url)]
 			}
   where
 	specialcfg = (specialRemoteCfg c)
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 4fc13f390..154fb1ed4 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -71,7 +71,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			readonly = False,
 			availability = GloballyAvailable,
 			remotetype = remote,
-			mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc
+			mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc,
+			getInfo = return [("bucket", fromMaybe "unknown" (getBucket c))]
 		}
 
 s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index 5c1729448..7dd231c06 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -84,7 +84,8 @@ gen r u c gc = do
 		readonly = False,
 		availability = GloballyAvailable,
 		remotetype = remote,
-		mkUnavailable = return Nothing
+		mkUnavailable = return Nothing,
+		getInfo = return []
 	}
 
 tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
diff --git a/Remote/Web.hs b/Remote/Web.hs
index ef7d2b39a..4d4b43c41 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -62,7 +62,8 @@ gen r _ c gc =
 		readonly = True,
 		availability = GloballyAvailable,
 		remotetype = remote,
-		mkUnavailable = return Nothing
+		mkUnavailable = return Nothing,
+		getInfo = return []
 	}
 
 downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index d90686608..0981c4373 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -71,7 +71,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			readonly = False,
 			availability = GloballyAvailable,
 			remotetype = remote,
-			mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc
+			mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc,
+			getInfo = return [("url", fromMaybe "unknown" (M.lookup "url" c))]
 		}
 		chunkconfig = getChunkConfig c
 
diff --git a/Types/Remote.hs b/Types/Remote.hs
index e166d7090..795121763 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -98,7 +98,9 @@ data RemoteA a = Remote {
 	remotetype :: RemoteTypeA a,
 	-- For testing, makes a version of this remote that is not
 	-- available for use. All its actions should fail.
-	mkUnavailable :: a (Maybe (RemoteA a))
+	mkUnavailable :: a (Maybe (RemoteA a)),
+	-- Information about the remote, for git annex info to display.
+	getInfo :: a [(String, String)]
 }
 
 instance Show (RemoteA a) where
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 7df4ecb3f..b22ff3881 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -679,8 +679,8 @@ subdirectories).
 * `info [directory|file|remote ...]`
 
   Displays statistics and other information for the specified item,
-  which can be a directory, or a file, or a remote (specified by name or
-  UUID). When no item is specified, displays statistics and information
+  which can be a directory, or a file, or a remote.
+  When no item is specified, displays statistics and information
   for the repository as a whole.
 
   When a directory is specified, the file matching options can be used