UI: Tweak and re-enable UI for uploading personal SSH keys
This commit is contained in:
parent
206d140b95
commit
cc9facdf5a
7 changed files with 51 additions and 70 deletions
|
@ -109,7 +109,7 @@ import Vervis.Handler.Cloth
|
||||||
import Vervis.Handler.Deck
|
import Vervis.Handler.Deck
|
||||||
--import Vervis.Handler.Git
|
--import Vervis.Handler.Git
|
||||||
import Vervis.Handler.Group
|
import Vervis.Handler.Group
|
||||||
--import Vervis.Handler.Key
|
import Vervis.Handler.Key
|
||||||
import Vervis.Handler.Loom
|
import Vervis.Handler.Loom
|
||||||
import Vervis.Handler.Person
|
import Vervis.Handler.Person
|
||||||
import Vervis.Handler.Repo
|
import Vervis.Handler.Repo
|
||||||
|
|
|
@ -807,6 +807,9 @@ instance YesodBreadcrumbs App where
|
||||||
NotificationsR -> ("Notifications", Just HomeR)
|
NotificationsR -> ("Notifications", Just HomeR)
|
||||||
InboxDebugR -> ("Inbox Debug", Just HomeR)
|
InboxDebugR -> ("Inbox Debug", Just HomeR)
|
||||||
|
|
||||||
|
KeysR -> ("SSH Keys", Just HomeR)
|
||||||
|
KeyDeleteR _ -> ("", Nothing)
|
||||||
|
|
||||||
PublishOfferMergeR -> ("Open MR", Just HomeR)
|
PublishOfferMergeR -> ("Open MR", Just HomeR)
|
||||||
PublishMergeR -> ("Apply MR", Just HomeR)
|
PublishMergeR -> ("Apply MR", Just HomeR)
|
||||||
|
|
||||||
|
|
|
@ -16,10 +16,7 @@
|
||||||
module Vervis.Handler.Key
|
module Vervis.Handler.Key
|
||||||
( getKeysR
|
( getKeysR
|
||||||
, postKeysR
|
, postKeysR
|
||||||
, getKeyNewR
|
, postKeyDeleteR
|
||||||
, getKeyR
|
|
||||||
, deleteKeyR
|
|
||||||
, postKeyR
|
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -29,8 +26,9 @@ import Data.Monoid ((<>))
|
||||||
import Data.Text (Text, intercalate)
|
import Data.Text (Text, intercalate)
|
||||||
import Data.Text.Encoding (decodeUtf8With)
|
import Data.Text.Encoding (decodeUtf8With)
|
||||||
import Data.Text.Encoding.Error (lenientDecode)
|
import Data.Text.Encoding.Error (lenientDecode)
|
||||||
|
import Data.Traversable
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Network.HTTP.Types (StdMethod (DELETE))
|
import Network.HTTP.Types.Method
|
||||||
import Text.Blaze.Html (Html, toHtml)
|
import Text.Blaze.Html (Html, toHtml)
|
||||||
import Yesod.Auth (requireAuthId)
|
import Yesod.Auth (requireAuthId)
|
||||||
import Yesod.Core
|
import Yesod.Core
|
||||||
|
@ -45,6 +43,7 @@ import Yesod.ActivityPub
|
||||||
import Yesod.FedURI
|
import Yesod.FedURI
|
||||||
import Yesod.Hashids
|
import Yesod.Hashids
|
||||||
|
|
||||||
|
import Yesod.Form.Local
|
||||||
import Yesod.Persist.Local
|
import Yesod.Persist.Local
|
||||||
|
|
||||||
import Vervis.Form.Key
|
import Vervis.Form.Key
|
||||||
|
@ -54,60 +53,39 @@ import Vervis.Model.Ident
|
||||||
import Vervis.Settings
|
import Vervis.Settings
|
||||||
import Vervis.Widget (buttonW)
|
import Vervis.Widget (buttonW)
|
||||||
|
|
||||||
{-
|
|
||||||
getKeysR :: Handler Html
|
getKeysR :: Handler Html
|
||||||
getKeysR = do
|
getKeysR = do
|
||||||
pid <- requireAuthId
|
pid <- requireAuthId
|
||||||
keys <- runDB $ do
|
newW <- do
|
||||||
ks <- selectList [SshKeyPerson ==. pid] [Asc SshKeyIdent]
|
((_, widget), enctype) <- runFormPost $ newKeyForm pid
|
||||||
return $ map (\ (Entity _ k) -> sshKeyIdent k) ks
|
return $(widgetFile "key/new")
|
||||||
|
keysW <- mconcat <$> do
|
||||||
|
keys <- runDB $ selectList [SshKeyPerson ==. pid] [Asc SshKeyIdent]
|
||||||
|
for keys $ \ (Entity keyID key) -> do
|
||||||
|
keyHash <- encodeKeyHashid keyID
|
||||||
|
return $ keyW keyHash key
|
||||||
defaultLayout $(widgetFile "key/list")
|
defaultLayout $(widgetFile "key/list")
|
||||||
|
where
|
||||||
|
keyW tag key =
|
||||||
|
let toText = decodeUtf8With lenientDecode
|
||||||
|
content = toText $ encode $ sshKeyContent key
|
||||||
|
in $(widgetFile "key/one")
|
||||||
|
|
||||||
postKeysR :: Handler Html
|
postKeysR :: Handler Html
|
||||||
postKeysR = do
|
postKeysR = do
|
||||||
pid <- requireAuthId
|
pid <- requireAuthId
|
||||||
((result, widget), enctype) <- runFormPost $ newKeyForm pid
|
key <- runFormPostRedirect KeysR $ newKeyForm pid
|
||||||
case result of
|
|
||||||
FormSuccess key -> do
|
|
||||||
runDB $ insert_ key
|
runDB $ insert_ key
|
||||||
setMessage "Key added."
|
setMessage "Key added."
|
||||||
redirect KeysR
|
redirect KeysR
|
||||||
FormMissing -> do
|
|
||||||
setMessage "Field(s) missing"
|
|
||||||
defaultLayout $(widgetFile "key/new")
|
|
||||||
FormFailure _l -> do
|
|
||||||
setMessage "Invalid input, see below"
|
|
||||||
defaultLayout $(widgetFile "key/new")
|
|
||||||
|
|
||||||
getKeyNewR :: Handler Html
|
postKeyDeleteR :: KeyHashid SshKey -> Handler Html
|
||||||
getKeyNewR = do
|
postKeyDeleteR keyHash = do
|
||||||
pid <- requireAuthId
|
|
||||||
((_result, widget), enctype) <- runFormPost $ newKeyForm pid
|
|
||||||
defaultLayout $(widgetFile "key/new")
|
|
||||||
|
|
||||||
getKeyR :: KyIdent -> Handler Html
|
|
||||||
getKeyR tag = do
|
|
||||||
pid <- requireAuthId
|
|
||||||
Entity _kid key <- runDB $ getBy404 $ UniqueSshKey pid tag
|
|
||||||
let toText = decodeUtf8With lenientDecode
|
|
||||||
content = toText $ encode $ sshKeyContent key
|
|
||||||
defaultLayout $(widgetFile "key/one")
|
|
||||||
-}
|
|
||||||
|
|
||||||
{-
|
|
||||||
deleteKeyR :: KyIdent -> Handler Html
|
|
||||||
deleteKeyR tag = do
|
|
||||||
pid <- requireAuthId
|
pid <- requireAuthId
|
||||||
|
keyID <- decodeKeyHashid404 keyHash
|
||||||
runDB $ do
|
runDB $ do
|
||||||
Entity kid _k <- getBy404 $ UniqueSshKey pid tag
|
key <- get404 keyID
|
||||||
delete kid
|
unless (sshKeyPerson key == pid) notFound
|
||||||
|
delete keyID
|
||||||
setMessage "Key deleted."
|
setMessage "Key deleted."
|
||||||
redirect KeysR
|
redirect KeysR
|
||||||
|
|
||||||
postKeyR :: KyIdent -> Handler Html
|
|
||||||
postKeyR tag = do
|
|
||||||
mmethod <- lookupPostParam "_method"
|
|
||||||
case mmethod of
|
|
||||||
Just "DELETE" -> deleteKeyR tag
|
|
||||||
_ -> notFound
|
|
||||||
-}
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
$# This file is part of Vervis.
|
$# This file is part of Vervis.
|
||||||
$#
|
$#
|
||||||
$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
$# Written in 2016, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
$#
|
$#
|
||||||
$# ♡ Copying is an act of love. Please copy, reuse and share.
|
$# ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
$#
|
$#
|
||||||
|
@ -12,11 +12,10 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
$# with this software. If not, see
|
$# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
<p>These are your SSH keys.
|
<h2>Your SSH keys
|
||||||
|
|
||||||
<ul>
|
^{keysW}
|
||||||
$forall key <- keys
|
|
||||||
<li>
|
<h2>Add a new SSH key
|
||||||
<a href=@{KeyR key}>#{ky2text key}
|
|
||||||
<li>
|
^{newW}
|
||||||
<a href=@{KeyNewR}>Add new…
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
$# This file is part of Vervis.
|
$# This file is part of Vervis.
|
||||||
$#
|
$#
|
||||||
$# Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
|
$# Written in 2016, 2018, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
$#
|
$#
|
||||||
$# ♡ Copying is an act of love. Please copy, reuse and share.
|
$# ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
$#
|
$#
|
||||||
|
@ -12,8 +12,10 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
$# with this software. If not, see
|
$# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
|
<h2>SSH Key #{ky2text $ sshKeyIdent key}
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
^{buttonW DELETE "Delete this key" (KeyR tag)}
|
^{buttonW POST "Delete this key" (KeyDeleteR tag)}
|
||||||
|
|
||||||
<table>
|
<table>
|
||||||
<tr>
|
<tr>
|
||||||
|
|
|
@ -33,10 +33,6 @@
|
||||||
-- Current user
|
-- Current user
|
||||||
-- ----------------------------------------------------------------------------
|
-- ----------------------------------------------------------------------------
|
||||||
|
|
||||||
-- /k KeysR GET POST
|
|
||||||
-- /k/!new KeyNewR GET
|
|
||||||
-- /k/#KyIdent KeyR GET DELETE POST
|
|
||||||
|
|
||||||
-- /cr ClaimRequestsPersonR GET
|
-- /cr ClaimRequestsPersonR GET
|
||||||
|
|
||||||
-- ----------------------------------------------------------------------------
|
-- ----------------------------------------------------------------------------
|
||||||
|
@ -130,6 +126,9 @@
|
||||||
-- /publish PublishR GET POST
|
-- /publish PublishR GET POST
|
||||||
/inbox InboxDebugR GET
|
/inbox InboxDebugR GET
|
||||||
|
|
||||||
|
/ssh-keys KeysR GET POST
|
||||||
|
/ssh-keys/#SshKeyKeyHashid/delete KeyDeleteR POST
|
||||||
|
|
||||||
/publish/offer-merge PublishOfferMergeR GET POST
|
/publish/offer-merge PublishOfferMergeR GET POST
|
||||||
/publish/merge PublishMergeR GET POST
|
/publish/merge PublishMergeR GET POST
|
||||||
|
|
||||||
|
|
|
@ -156,7 +156,7 @@ library
|
||||||
Vervis.Federation.Util
|
Vervis.Federation.Util
|
||||||
Vervis.FedURI
|
Vervis.FedURI
|
||||||
Vervis.Fetch
|
Vervis.Fetch
|
||||||
-- Vervis.Field.Key
|
Vervis.Field.Key
|
||||||
Vervis.Field.Person
|
Vervis.Field.Person
|
||||||
--Vervis.Field.Project
|
--Vervis.Field.Project
|
||||||
--Vervis.Field.Repo
|
--Vervis.Field.Repo
|
||||||
|
@ -166,7 +166,7 @@ library
|
||||||
-- Vervis.Field.Workflow
|
-- Vervis.Field.Workflow
|
||||||
Vervis.Form.Discussion
|
Vervis.Form.Discussion
|
||||||
--Vervis.Form.Group
|
--Vervis.Form.Group
|
||||||
-- Vervis.Form.Key
|
Vervis.Form.Key
|
||||||
Vervis.Form.Project
|
Vervis.Form.Project
|
||||||
Vervis.Form.Repo
|
Vervis.Form.Repo
|
||||||
--Vervis.Form.Role
|
--Vervis.Form.Role
|
||||||
|
@ -183,7 +183,7 @@ library
|
||||||
-- Vervis.Handler.Git
|
-- Vervis.Handler.Git
|
||||||
Vervis.Handler.Group
|
Vervis.Handler.Group
|
||||||
--Vervis.Handler.Inbox
|
--Vervis.Handler.Inbox
|
||||||
--Vervis.Handler.Key
|
Vervis.Handler.Key
|
||||||
Vervis.Handler.Loom
|
Vervis.Handler.Loom
|
||||||
Vervis.Handler.Person
|
Vervis.Handler.Person
|
||||||
Vervis.Handler.Repo
|
Vervis.Handler.Repo
|
||||||
|
|
Loading…
Reference in a new issue