UI: Group: Buttons for adding and removing members
This commit is contained in:
Pere Lev
parent
702ad39b96
commit
5af2fdd58b
6 changed files with 135 additions and 5 deletions
|
|
@ -27,6 +27,8 @@ module Vervis.Form.Tracker
|
|||
, ProjectInvite (..)
|
||||
, projectInviteForm
|
||||
, projectInviteCompForm
|
||||
, GroupInvite (..)
|
||||
, groupInviteForm
|
||||
--, NewProjectCollab (..)
|
||||
--, newProjectCollabForm
|
||||
--, editProjectForm
|
||||
|
|
@ -179,6 +181,38 @@ projectInviteForm projectID = renderDivs $ ProjectInvite
|
|||
projectInviteCompForm :: Form FedURI
|
||||
projectInviteCompForm = renderDivs $ areq fedUriField "Component URI*" Nothing
|
||||
|
||||
data GroupInvite = GroupInvite
|
||||
{ giPerson :: PersonId
|
||||
, giRole :: AP.Role
|
||||
}
|
||||
|
||||
groupInviteForm :: GroupId -> Form GroupInvite
|
||||
groupInviteForm groupID = renderDivs $ GroupInvite
|
||||
<$> areq selectPerson "Person*" Nothing
|
||||
<*> areq selectRole "Role*" Nothing
|
||||
where
|
||||
selectPerson = selectField $ do
|
||||
l <- runDB $ E.select $
|
||||
E.from $ \ (person `E.InnerJoin` actor `E.LeftOuterJoin` (recip `E.InnerJoin` topic)) -> do
|
||||
E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicGroupCollab E.&&.
|
||||
topic E.^. CollabTopicGroupGroup E.==. E.val groupID
|
||||
E.on $ person E.^. PersonId E.==. recip E.^. CollabRecipLocalPerson
|
||||
E.on $ person E.^. PersonActor E.==. actor E.^. ActorId
|
||||
E.where_ $ E.isNothing $ E.just $ recip E.^. CollabRecipLocalId
|
||||
return (person, actor)
|
||||
optionsPairs $
|
||||
map (\ (Entity pid p, Entity _ a) ->
|
||||
( T.concat
|
||||
[ actorName a
|
||||
, " ~"
|
||||
, username2text $ personUsername p
|
||||
]
|
||||
, pid
|
||||
)
|
||||
)
|
||||
l
|
||||
selectRole = selectField optionsEnum
|
||||
|
||||
{-
|
||||
editProjectAForm :: SharerId -> Entity Project -> AForm Handler Project
|
||||
editProjectAForm sid (Entity jid project) = Project
|
||||
|
|
|
|||
|
|
@ -884,6 +884,8 @@ instance YesodBreadcrumbs App where
|
|||
GroupStampR g k -> ("Stamp #" <> keyHashidText k, Just $ GroupR g)
|
||||
|
||||
GroupMembersR g -> ("Members", Just $ GroupR g)
|
||||
GroupInviteR g -> ("Invite", Just $ GroupR g)
|
||||
GroupRemoveR _ _ -> ("", Nothing)
|
||||
|
||||
RepoR r -> ("Repo ^" <> keyHashidText r, Just HomeR)
|
||||
RepoInboxR r -> ("Inbox", Just $ RepoR r)
|
||||
|
|
|
|||
|
|
@ -28,6 +28,9 @@ module Vervis.Handler.Group
|
|||
, getGroupStampR
|
||||
|
||||
, getGroupMembersR
|
||||
, getGroupInviteR
|
||||
, postGroupInviteR
|
||||
, postGroupRemoveR
|
||||
|
||||
|
||||
|
||||
|
|
@ -290,6 +293,95 @@ getGroupMembersR groupHash = do
|
|||
LocalActorPerson personID -> return personID
|
||||
_ -> error "Surprise, local inviter actor isn't a Person"
|
||||
|
||||
getGroupInviteR :: KeyHashid Group -> Handler Html
|
||||
getGroupInviteR groupHash = do
|
||||
groupID <- decodeKeyHashid404 groupHash
|
||||
((_result, widget), enctype) <- runFormPost $ groupInviteForm groupID
|
||||
defaultLayout $(widgetFile "group/member/new")
|
||||
|
||||
postGroupInviteR :: KeyHashid Group -> Handler Html
|
||||
postGroupInviteR groupHash = do
|
||||
groupID <- decodeKeyHashid404 groupHash
|
||||
GroupInvite recipPersonID role <-
|
||||
runFormPostRedirect (GroupInviteR groupHash) $ groupInviteForm groupID
|
||||
|
||||
personEntity@(Entity personID person) <- requireAuth
|
||||
personHash <- encodeKeyHashid personID
|
||||
recipPersonHash <- encodeKeyHashid recipPersonID
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
|
||||
result <- runExceptT $ do
|
||||
(maybeSummary, audience, invite) <- do
|
||||
let uRecipient = encodeRouteHome $ PersonR recipPersonHash
|
||||
uResourceCollabs = encodeRouteHome $ GroupMembersR groupHash
|
||||
C.invite personID uRecipient uResourceCollabs role
|
||||
grantID <- do
|
||||
maybeItem <- lift $ runDB $ getGrant CollabTopicGroupCollab CollabTopicGroupGroup groupID personID
|
||||
fromMaybeE maybeItem "You need to be a collaborator in the Group to invite people"
|
||||
grantHash <- encodeKeyHashid grantID
|
||||
let uCap = encodeRouteHome $ GroupOutboxItemR groupHash grantHash
|
||||
(localRecips, remoteRecips, fwdHosts, action) <-
|
||||
C.makeServerInput (Just uCap) maybeSummary audience $ AP.InviteActivity invite
|
||||
let cap =
|
||||
Left (LocalActorGroup groupID, LocalActorGroup groupHash, grantID)
|
||||
handleViaActor
|
||||
personID (Just cap) localRecips remoteRecips fwdHosts action
|
||||
|
||||
case result of
|
||||
Left e -> do
|
||||
setMessage $ toHtml e
|
||||
redirect $ GroupInviteR groupHash
|
||||
Right inviteID -> do
|
||||
setMessage "Invite sent"
|
||||
redirect $ GroupMembersR groupHash
|
||||
|
||||
postGroupRemoveR :: KeyHashid Group -> CollabTopicGroupId -> Handler Html
|
||||
postGroupRemoveR groupHash ctID = do
|
||||
groupID <- decodeKeyHashid404 groupHash
|
||||
|
||||
personEntity@(Entity personID person) <- requireAuth
|
||||
personHash <- encodeKeyHashid personID
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
|
||||
result <- runExceptT $ do
|
||||
mpidOrU <- lift $ runDB $ runMaybeT $ do
|
||||
CollabTopicGroup collabID groupID' <- MaybeT $ get ctID
|
||||
guard $ groupID' == groupID
|
||||
_ <- MaybeT $ getBy $ UniqueCollabEnable collabID
|
||||
member <-
|
||||
Left <$> MaybeT (getValBy $ UniqueCollabRecipLocal collabID) <|>
|
||||
Right <$> MaybeT (getValBy $ UniqueCollabRecipRemote collabID)
|
||||
lift $
|
||||
bitraverse
|
||||
(pure . collabRecipLocalPerson)
|
||||
(getRemoteActorURI <=< getJust . collabRecipRemoteActor)
|
||||
member
|
||||
pidOrU <- maybe notFound pure mpidOrU
|
||||
(maybeSummary, audience, remove) <- do
|
||||
uRecipient <-
|
||||
case pidOrU of
|
||||
Left pid -> encodeRouteHome . PersonR <$> encodeKeyHashid pid
|
||||
Right u -> pure u
|
||||
let uResourceCollabs = encodeRouteHome $ GroupMembersR groupHash
|
||||
C.remove personID uRecipient uResourceCollabs
|
||||
grantID <- do
|
||||
maybeItem <- lift $ runDB $ getGrant CollabTopicGroupCollab CollabTopicGroupGroup groupID personID
|
||||
fromMaybeE maybeItem "You need to be a collaborator in the Group to remove people"
|
||||
grantHash <- encodeKeyHashid grantID
|
||||
let uCap = encodeRouteHome $ GroupOutboxItemR groupHash grantHash
|
||||
(localRecips, remoteRecips, fwdHosts, action) <-
|
||||
C.makeServerInput (Just uCap) maybeSummary audience $ AP.RemoveActivity remove
|
||||
let cap =
|
||||
Left (LocalActorGroup groupID, LocalActorGroup groupHash, grantID)
|
||||
handleViaActor
|
||||
personID (Just cap) localRecips remoteRecips fwdHosts action
|
||||
|
||||
case result of
|
||||
Left e -> do
|
||||
setMessage $ toHtml e
|
||||
Right removeID ->
|
||||
setMessage "Remove sent"
|
||||
redirect $ GroupMembersR groupHash
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
$# This file is part of Vervis.
|
||||
$#
|
||||
$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
$# Written in 2016, 2023 by fr33domlover <fr33domlover@riseup.net>.
|
||||
$#
|
||||
$# ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
$#
|
||||
|
|
@ -12,7 +12,7 @@ $# 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/>.
|
||||
|
||||
<form method=POST action=@{GroupMembersR shar} enctype=#{enctype}>
|
||||
<form method=POST action=@{GroupInviteR groupHash} enctype=#{enctype}>
|
||||
^{widget}
|
||||
<div class="submit">
|
||||
<input type="submit">
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|||
<td>#{show role}
|
||||
<td>^{personLinkFedW person}
|
||||
<td>#{showDate since}
|
||||
$#<td>^{buttonW POST "Remove" (GroupRemoveR groupHash ctID)}
|
||||
<td>^{buttonW POST "Remove" (GroupRemoveR groupHash ctID)}
|
||||
|
||||
<h2>Invites
|
||||
|
||||
|
|
@ -43,7 +43,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|||
<td>#{show role}
|
||||
<td>#{showDate time}
|
||||
|
||||
$#<a href=@{ProjectInviteR projectHash}>Invite…
|
||||
<a href=@{GroupInviteR groupHash}>Invite…
|
||||
|
||||
<h2>Joins
|
||||
|
||||
|
|
|
|||
|
|
@ -169,6 +169,8 @@
|
|||
/groups/#GroupKeyHashid/stamps/#SigKeyKeyHashid GroupStampR GET
|
||||
|
||||
/groups/#GroupKeyHashid/members GroupMembersR GET
|
||||
/groups/#GroupKeyHashid/invite GroupInviteR GET POST
|
||||
/groups/#GroupKeyHashid/remove/#CollabTopicGroupId GroupRemoveR POST
|
||||
|
||||
---- Repo --------------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue