Add UI for display of SSH keys

config/routes

@@ -21,7 +21,7 @@
 /robots.txt                  RobotsR     GET
 
 -- ----------------------------------------------------------------------------
--- User signup and login
+-- User login
 -- ----------------------------------------------------------------------------
 
 /auth                        AuthR       Auth   getAuth
@@ -36,6 +36,10 @@
 /u/!new                      PersonNewR  GET
 /u/#Text                     PersonR     GET
 
+/u/#Text/k                   KeysR       GET POST
+/u/#Text/k/!new              KeyNewR     GET
+/u/#Text/k/#Text             KeyR        GET
+
 /u/#Text/p                   ProjectsR   GET POST
 /u/#Text/p/!new              ProjectNewR GET
 /u/#Text/p/#Text             ProjectR    GET

src/Vervis/Application.hs

@@ -52,6 +52,7 @@ import System.Log.FastLogger                (defaultBufSize, newStdoutLoggerSet,
 -- Don't forget to add new modules to your cabal file!
 import Vervis.Handler.Common
 import Vervis.Handler.Home
+import Vervis.Handler.Key
 import Vervis.Handler.Person
 import Vervis.Handler.Project
 import Vervis.Handler.Repo

src/Vervis/Foundation.hs

@@ -109,6 +109,12 @@ instance Yesod App where
         loggedInAs user "You can’t create projects for other users"
     isAuthorized (RepoNewR user _proj) _ =
         loggedInAs user "You can’t create repos for other users"
+    isAuthorized (KeysR user) _ =
+        loggedInAs user "You can’t watch keys of other users"
+    isAuthorized (KeyR user _key) _ =
+        loggedInAs user "You can’t watch keys of other users"
+    isAuthorized (KeyNewR user) _ =
+        loggedInAs user "You can’t add keys for other users"
     isAuthorized _ _ = return Authorized
 
     -- This function creates static content files in the static folder

src/Vervis/Handler/Key.hs

@@ -0,0 +1,69 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Vervis.Handler.Key
+    ( getKeysR
+    , postKeysR
+    , getKeyNewR
+    , getKeyR
+    )
+where
+
+import Prelude
+
+import Data.ByteString.Base64 (encode)
+import Data.Text (Text, intercalate)
+import Data.Text.Encoding (decodeUtf8With)
+import Data.Text.Encoding.Error (lenientDecode)
+import Database.Persist
+import Text.Blaze.Html (Html, toHtml)
+import Yesod.Core (defaultLayout)
+import Yesod.Core.Widget (setTitle)
+import Yesod.Persist.Core (runDB, getBy404)
+
+import Vervis.Foundation
+import Vervis.Model
+import Vervis.Settings
+
+getKeysR :: Text -> Handler Html
+getKeysR user = do
+    keys <- runDB $ do
+        Entity sid _sharer <- getBy404 $ UniqueSharerIdent user
+        Entity pid _person <- getBy404 $ UniquePersonIdent sid
+        ks <- selectList [SshKeyPerson ==. pid] [Asc SshKeyName]
+        return $ map (\ (Entity _ k) -> sshKeyName k) ks
+    defaultLayout $ do
+        setTitle $ toHtml $
+            intercalate " > " ["Vervis", "People", user, "Keys"]
+        $(widgetFile "keys")
+
+postKeysR :: Text -> Handler Html
+postKeysR _ = error "not impl"
+
+getKeyNewR :: Text -> Handler Html
+getKeyNewR _ = error "not impl"
+
+getKeyR :: Text -> Text -> Handler Html
+getKeyR user tag = do
+    Entity _kid key <- runDB $ do
+        Entity sid _sharer <- getBy404 $ UniqueSharerIdent user
+        Entity pid _person <- getBy404 $ UniquePersonIdent sid
+        getBy404 $ UniqueSshKey pid tag
+    let toText = decodeUtf8With lenientDecode
+        content = toText $ encode $ sshKeyContent key
+    defaultLayout $ do
+        setTitle $ toHtml $
+            intercalate " > " ["Vervis", "People", user, "Keys", tag]
+        $(widgetFile "key")

templates/key.hamlet

@@ -0,0 +1,23 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+$#
+$# ♡ Copying is an act of love. Please copy, reuse and share.
+$#
+$# The author(s) have dedicated all copyright and related and neighboring
+$# rights to this software to the public domain worldwide. This software is
+$# distributed without any warranty.
+$#
+$# You should have received a copy of the CC0 Public Domain Dedication along
+$# with this software. If not, see
+$# <http://creativecommons.org/publicdomain/zero/1.0/>.
+
+<h1>Vervis > People > #{user} > Keys > #{tag}
+
+<table>
+  <tr>
+    <td>Algorithm
+    <td>#{toText $ sshKeyAlgo key}
+  <tr>
+    <td>Content
+    <td>#{content}

templates/keys.hamlet

@@ -0,0 +1,24 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+$#
+$# ♡ Copying is an act of love. Please copy, reuse and share.
+$#
+$# The author(s) have dedicated all copyright and related and neighboring
+$# rights to this software to the public domain worldwide. This software is
+$# distributed without any warranty.
+$#
+$# You should have received a copy of the CC0 Public Domain Dedication along
+$# with this software. If not, see
+$# <http://creativecommons.org/publicdomain/zero/1.0/>.
+
+<h1>Vervis > People > #{user} > Keys
+
+<p>These are the SSH keys for user #{user}.
+
+<ul>
+  $forall key <- keys
+    <li>
+      <a href=@{KeyR user key}>#{key}
+  <li>
+    <a href=@{KeyNewR user}>Add new…

templates/personal-overview.hamlet

@@ -27,3 +27,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
       <a href=@{ProjectR ident project}>#{project}
   <li>
     <a href=@{ProjectNewR ident}>Create new…
+
+<h2>SSH Keys
+
+<p>
+  See <a href=@{KeysR ident}>keys</a>.

vervis.cabal

@@ -56,6 +56,7 @@ library
                        Vervis.Settings.StaticFiles
                        Vervis.Handler.Common
                        Vervis.Handler.Home
+                       Vervis.Handler.Key
                        Vervis.Handler.Person
                        Vervis.Handler.Project
                        Vervis.Handler.Repo
@@ -91,7 +92,8 @@ library
   --                   , unordered-containers >=0.2.5
   build-depends:       aeson                         >= 0.6        && < 0.11
                      , base                          >= 4          && < 5
-                     , blaze-markup
+                     , base64-bytestring
+                     , blaze-html
                      , bytestring                    >= 0.9        && < 0.11
                      , case-insensitive
                      , classy-prelude                >= 0.10.2
@@ -138,6 +140,7 @@ library
                      , yesod-core                    >= 1.4.17     && < 1.5
                      , yesod-form                    >= 1.4.0      && < 1.5
                      , yesod-static                  >= 1.4.0.3    && < 1.6
+                     , yesod-persistent
   hs-source-dirs:      src
   default-language:    Haskell2010