From 78213db2fcaeed3682680352f5e37fc225653255 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Mon, 7 Mar 2016 00:42:06 +0000 Subject: [PATCH] Add UI for display of SSH keys --- config/routes | 6 ++- src/Vervis/Application.hs | 1 + src/Vervis/Foundation.hs | 6 +++ src/Vervis/Handler/Key.hs | 69 ++++++++++++++++++++++++++++++ templates/key.hamlet | 23 ++++++++++ templates/keys.hamlet | 24 +++++++++++ templates/personal-overview.hamlet | 5 +++ vervis.cabal | 5 ++- 8 files changed, 137 insertions(+), 2 deletions(-) create mode 100644 src/Vervis/Handler/Key.hs create mode 100644 templates/key.hamlet create mode 100644 templates/keys.hamlet diff --git a/config/routes b/config/routes index f13ad40..607946c 100644 --- a/config/routes +++ b/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 diff --git a/src/Vervis/Application.hs b/src/Vervis/Application.hs index 472fd04..e8ea9dc 100644 --- a/src/Vervis/Application.hs +++ b/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 diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 2f6f93d..ed2ae4d 100644 --- a/src/Vervis/Foundation.hs +++ b/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 diff --git a/src/Vervis/Handler/Key.hs b/src/Vervis/Handler/Key.hs new file mode 100644 index 0000000..0723cab --- /dev/null +++ b/src/Vervis/Handler/Key.hs @@ -0,0 +1,69 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ 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 + - . + -} + +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") diff --git a/templates/key.hamlet b/templates/key.hamlet new file mode 100644 index 0000000..340349b --- /dev/null +++ b/templates/key.hamlet @@ -0,0 +1,23 @@ +$# This file is part of Vervis. +$# +$# Written in 2016 by fr33domlover . +$# +$# ♡ 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 +$# . + +

Vervis > People > #{user} > Keys > #{tag} + + + + +
Algorithm + #{toText $ sshKeyAlgo key} +
Content + #{content} diff --git a/templates/keys.hamlet b/templates/keys.hamlet new file mode 100644 index 0000000..0c8377d --- /dev/null +++ b/templates/keys.hamlet @@ -0,0 +1,24 @@ +$# This file is part of Vervis. +$# +$# Written in 2016 by fr33domlover . +$# +$# ♡ 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 +$# . + +

Vervis > People > #{user} > Keys + +

These are the SSH keys for user #{user}. + +