webapp: Show encryption information when editing a remote.

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