47 lines
1.3 KiB
Haskell
47 lines
1.3 KiB
Haskell
{- 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
|