webapp: Show encryption information when editing a remote.

Assistant/WebApp/Configurators/Edit.hs

@@ -11,6 +11,7 @@ module Assistant.WebApp.Configurators.Edit where
 
 import Assistant.WebApp.Common
 import Assistant.WebApp.Utility
+import Assistant.WebApp.Gpg
 import Assistant.DaemonStatus
 import Assistant.MakeRemote (uniqueRemoteName)
 import Assistant.WebApp.Configurators.XMPP (xmppNeeded)
@@ -33,6 +34,9 @@ import qualified Git.Command
 import qualified Git.Config
 import qualified Annex
 import Git.Remote
+import Remote.Helper.Encryptable (extractCipher)
+import Types.Crypto
+import Utility.Gpg
 
 import qualified Data.Text as T
 import qualified Data.Map as M
@@ -187,8 +191,9 @@ editForm new uuid = page "Edit repository" (Just Configuration) $ do
 			redirect DashboardR
 		_ -> do
 			let istransfer = repoGroup curr == RepoGroupStandard TransferGroup
-			repoInfo <- getRepoInfo mremote . M.lookup uuid
-				<$> liftAnnex readRemoteLog
+			config <- liftAnnex $ M.lookup uuid <$> readRemoteLog
+			let repoInfo = getRepoInfo mremote config
+			let repoEncryption = getRepoEncryption mremote config
 			$(widgetFile "configurators/editrepository")
 
 {- Makes any directory associated with the repository. -}
@@ -221,3 +226,20 @@ getGitRepoInfo :: Git.Repo -> Widget
 getGitRepoInfo r = do
 	let loc = Git.repoLocation r
 	[whamlet|git repository located at <tt>#{loc}</tt>|]
+
+getRepoEncryption :: Maybe Remote.Remote -> Maybe Remote.RemoteConfig -> Widget
+getRepoEncryption (Just _) (Just c) = case extractCipher c of
+  	Nothing ->
+		[whamlet|not encrypted|]
+	(Just (SharedCipher _)) ->
+		[whamlet|encrypted: encryption key stored in git repository|]
+	(Just (EncryptedCipher _ _ (KeyIds { keyIds = ks }))) -> do
+		knownkeys <- liftIO secretKeys
+		[whamlet|
+encrypted using gpg key:
+<ul style="list-style: none">
+  $forall k <- ks
+    <li>
+      ^{gpgKeyDisplay k (M.lookup k knownkeys)}
+|]
+getRepoEncryption _ _ = [whamlet||] -- local repo

Assistant/WebApp/Configurators/Local.hs

@@ -11,6 +11,7 @@ module Assistant.WebApp.Configurators.Local where
 
 import Assistant.WebApp.Common
 import Assistant.WebApp.OtherRepos
+import Assistant.WebApp.Gpg
 import Assistant.MakeRemote
 import Assistant.Sync
 import Init
@@ -276,30 +277,14 @@ genKeyModal :: Widget
 genKeyModal = $(widgetFile "configurators/genkeymodal")
 
 getGenKeyForDriveR :: RemovableDrive -> Handler Html
-getGenKeyForDriveR drive = do
-	userid <- liftIO $ newUserId
-	liftIO $ genSecretKey RSA "" userid maxRecommendedKeySize
-	results <- M.keys . M.filter (== userid) <$> liftIO secretKeys
-	case results of
-		[] -> error "Failed to generate gpg key!"
-		(key:_) -> do
-			{- Generating a key takes a long time, and 
-			 - the removable drive may have been disconnected
-			 - in the meantime. Check that it is still mounted
-			 - before finishing. -}
-			ifM (liftIO $ any (\d -> mountPoint d == mountPoint drive) <$> driveList)
-				( getFinishAddDriveR drive (RepoKey key)
-				, getAddDriveR
-				)
-
-newUserId :: IO UserId
-newUserId = do
-	oldkeys <- secretKeys
-	username <- myUserName
-  	let basekeyname = username ++ " git-annex"
-	return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys)
-		( basekeyname
-		: map (\n -> basekeyname ++ show n) ([2..] :: [Int])
+getGenKeyForDriveR drive = withNewSecretKey $ \key -> do
+	{- Generating a key takes a long time, and 
+	 - the removable drive may have been disconnected
+	 - in the meantime. Check that it is still mounted
+	 - before finishing. -}
+	ifM (liftIO $ any (\d -> mountPoint d == mountPoint drive) <$> driveList)
+		( getFinishAddDriveR drive (RepoKey key)
+		, getAddDriveR
 		)
 
 getFinishAddDriveR :: RemovableDrive -> RepoKey -> Handler Html

Assistant/WebApp/Gpg.hs

@@ -0,0 +1,47 @@
+{- git-annex webapp gpg stuff
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}
+
+module Assistant.WebApp.Gpg where
+
+import Assistant.WebApp.Common
+import Utility.Gpg
+import Utility.UserInfo
+
+import qualified Data.Map as M
+
+gpgKeyDisplay :: KeyId -> Maybe UserId -> Widget
+gpgKeyDisplay keyid userid = [whamlet|
+  <span title="key id #{keyid}">
+    <i .icon-user></i> #
+      ^{displayname}
+|]
+  where
+  	displayname = case userid of
+		Just name | not (null name) -> [whamlet|#{name}|]
+		_ -> [whamlet|key id #{keyid}|]
+
+{- Generates a gpg user id that is not used by any existing secret key -}
+newUserId :: IO UserId
+newUserId = do
+	oldkeys <- secretKeys
+	username <- myUserName
+  	let basekeyname = username ++ "'s git-annex encryption key"
+	return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys)
+		( basekeyname
+		: map (\n -> basekeyname ++ show n) ([2..] :: [Int])
+		)
+
+withNewSecretKey :: (KeyId -> Handler Html) -> Handler Html
+withNewSecretKey use = do
+	userid <- liftIO $ newUserId
+	liftIO $ genSecretKey RSA "" userid maxRecommendedKeySize
+	results <- M.keys . M.filter (== userid) <$> liftIO secretKeys
+	case results of
+		[] -> error "Failed to generate gpg key!"
+		(key:_) -> use key

debian/changelog

@@ -17,6 +17,7 @@ git-annex (4.20130912) UNRELEASED; urgency=low
   * status: In local mode, displays information about variance from configured
     numcopies levels. (--fast avoids calculating these)
   * gcrypt: Ensure that signing key is set to one of the participants keys.
+  * webapp: Show encryption information when editing a remote.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 12 Sep 2013 12:14:46 -0400
 

templates/configurators/adddrive/encrypt.hamlet

@@ -16,13 +16,7 @@
       <p>
         <a .btn onclick="$('#setupmodal').modal('show');" href="@{FinishAddDriveR drive (RepoKey keyid)}">
           <i .icon-ok-sign></i> Encrypt repository #
-        to
-        <span title="key id #{keyid}">
-          <i .icon-user></i> #
-          $if null name
-            key id #{keyid}
-          $else
-            #{name}
+        to ^{gpgKeyDisplay keyid (Just name)}
   <p>
     <a .btn onclick="$('#genkeymodal').modal('show');" href="@{GenKeyForDriveR drive}">
       <i .icon-plus-sign></i> Encrypt repository #

templates/configurators/editrepository.hamlet

@@ -33,3 +33,5 @@
     Repository information
   <p>
     ^{repoInfo}
+  <p>
+    ^{repoEncryption}