UI in deck collaborators list, for adding a new collaborator

This commit is contained in:
Pere Lev 2023-06-16 20:12:40 +03:00
parent aaa92d8141
commit 928ad8f9a9
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
8 changed files with 113 additions and 30 deletions

View file

@ -1,6 +1,6 @@
{- This file is part of Vervis. {- This file is part of Vervis.
- -
- Written in 2016, 2019, 2022 by fr33domlover <fr33domlover@riseup.net>. - Written in 2016, 2019, 2022, 2023 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.
- -
@ -18,6 +18,8 @@ module Vervis.Form.Tracker
, newDeckForm , newDeckForm
, NewLoom (..) , NewLoom (..)
, newLoomForm , newLoomForm
, DeckInvite (..)
, deckInviteForm
--, NewProjectCollab (..) --, NewProjectCollab (..)
--, newProjectCollabForm --, newProjectCollabForm
--, editProjectForm --, editProjectForm
@ -27,7 +29,7 @@ where
import Data.Bifunctor import Data.Bifunctor
import Data.Maybe import Data.Maybe
import Data.Text (Text) import Data.Text (Text)
import Database.Persist ((==.)) import Database.Persist
import Yesod.Form.Fields import Yesod.Form.Fields
import Yesod.Form.Functions import Yesod.Form.Functions
import Yesod.Form.Types import Yesod.Form.Types
@ -38,8 +40,11 @@ import qualified Database.Esqueleto as E
import Yesod.Hashids import Yesod.Hashids
import qualified Web.ActivityPub as AP
import Vervis.Foundation import Vervis.Foundation
import Vervis.Model import Vervis.Model
import Vervis.Model.Ident
data NewDeck = NewDeck data NewDeck = NewDeck
{ ndName :: Text { ndName :: Text
@ -78,36 +83,39 @@ newLoomForm = renderDivs $ NewLoom
, repoID , repoID
) )
{- data DeckInvite = DeckInvite
data NewProjectCollab = NewProjectCollab { diPerson :: PersonId
{ ncPerson :: PersonId , diRole :: AP.Role
, ncRole :: Maybe RoleId
} }
newProjectCollabAForm deckInviteForm :: DeckId -> Form DeckInvite
:: SharerId -> ProjectId -> AForm Handler NewProjectCollab deckInviteForm deckID = renderDivs $ DeckInvite
newProjectCollabAForm sid jid = NewProjectCollab <$> areq selectPerson "Person*" Nothing
<$> areq selectPerson "Person*" Nothing <*> areq selectRole "Role*" Nothing
<*> aopt selectRole "Custom role" Nothing
where where
selectPerson = selectField $ do selectPerson = selectField $ do
l <- runDB $ E.select $ l <- runDB $ E.select $
E.from $ \ (person `E.InnerJoin` sharer `E.LeftOuterJoin` (recip `E.InnerJoin` topic)) -> do E.from $ \ (person `E.InnerJoin` actor `E.LeftOuterJoin` (recip `E.InnerJoin` topic)) -> do
E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicLocalProjectCollab E.&&. E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicDeckCollab E.&&.
topic E.^. CollabTopicLocalProjectProject E.==. E.val jid topic E.^. CollabTopicDeckDeck E.==. E.val deckID
E.on $ person E.^. PersonId E.==. recip E.^. CollabRecipLocalPerson E.on $ person E.^. PersonId E.==. recip E.^. CollabRecipLocalPerson
E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId E.on $ person E.^. PersonActor E.==. actor E.^. ActorId
E.where_ $ E.isNothing $ E.just $ recip E.^. CollabRecipLocalId E.where_ $ E.isNothing $ E.just $ recip E.^. CollabRecipLocalId
return (sharer E.^. SharerIdent, person E.^. PersonId) return (person, actor)
optionsPairs $ map (bimap (shr2text . E.unValue) E.unValue) l optionsPairs $
selectRole = map (\ (Entity pid p, Entity _ a) ->
selectField $ ( T.concat
optionsPersistKey [RoleSharer ==. sid] [] $ [ actorName a
rl2text . roleIdent , " ~"
, username2text $ personUsername p
newProjectCollabForm :: SharerId -> ProjectId -> Form NewProjectCollab ]
newProjectCollabForm sid jid = renderDivs $ newProjectCollabAForm sid jid , pid
)
)
l
selectRole = selectField optionsEnum
{-
editProjectAForm :: SharerId -> Entity Project -> AForm Handler Project editProjectAForm :: SharerId -> Entity Project -> AForm Handler Project
editProjectAForm sid (Entity jid project) = Project editProjectAForm sid (Entity jid project) = Project
<$> pure (projectActor project) <$> pure (projectActor project)

View file

@ -929,6 +929,8 @@ instance YesodBreadcrumbs App where
DeckCollabsR d -> ("Collaborators", Just $ DeckR d) DeckCollabsR d -> ("Collaborators", Just $ DeckR d)
DeckInviteR d -> ("Invite", Just $ DeckR d)
TicketR d t -> ("#" <> keyHashidText t, Just $ DeckTicketsR d) TicketR d t -> ("#" <> keyHashidText t, Just $ DeckTicketsR d)
TicketDiscussionR d t -> ("Discussion", Just $ TicketR d t) TicketDiscussionR d t -> ("Discussion", Just $ TicketR d t)
TicketEventsR d t -> ("Events", Just $ TicketR d t) TicketEventsR d t -> ("Events", Just $ TicketR d t)

View file

@ -37,6 +37,8 @@ module Vervis.Handler.Deck
, getDeckStampR , getDeckStampR
, getDeckCollabsR , getDeckCollabsR
, getDeckInviteR
, postDeckInviteR
@ -427,6 +429,48 @@ getDeckCollabsR deckHash = do
LocalActorPerson personID -> return personID LocalActorPerson personID -> return personID
_ -> error "Surprise, local inviter actor isn't a Person" _ -> error "Surprise, local inviter actor isn't a Person"
getDeckInviteR :: KeyHashid Deck -> Handler Html
getDeckInviteR deckHash = do
deckID <- decodeKeyHashid404 deckHash
((_result, widget), enctype) <- runFormPost $ deckInviteForm deckID
defaultLayout $(widgetFile "deck/collab/new")
postDeckInviteR :: KeyHashid Deck -> Handler Html
postDeckInviteR deckHash = do
deckID <- decodeKeyHashid404 deckHash
DeckInvite recipPersonID AP.RoleAdmin <-
runFormPostRedirect (DeckInviteR deckHash) $ deckInviteForm deckID
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
uResource = encodeRouteHome $ DeckR deckHash
C.invite personID uRecipient uResource
grantID <- do
maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID recipPersonID
fromMaybeE maybeItem "You need to be a collaborator in the Deck to invite people"
grantHash <- encodeKeyHashid grantID
let uCap = encodeRouteHome $ DeckOutboxItemR deckHash grantHash
(localRecips, remoteRecips, fwdHosts, action) <-
C.makeServerInput (Just uCap) maybeSummary audience $ AP.InviteActivity invite
let cap =
Left (LocalActorDeck deckID, LocalActorDeck deckHash, grantID)
handleViaActor
personID (Just cap) localRecips remoteRecips fwdHosts action
case result of
Left e -> do
setMessage $ toHtml e
redirect $ DeckInviteR deckHash
Right inviteID -> do
setMessage "Invite sent"
redirect $ DeckCollabsR deckHash

View file

@ -23,6 +23,8 @@ module Vervis.Persist.Collab
, verifyCapability , verifyCapability
, verifyCapability' , verifyCapability'
, getGrant
) )
where where
@ -312,3 +314,29 @@ verifyCapability' cap actor resource = do
LocalActorPerson personID -> return personID LocalActorPerson personID -> return personID
_ -> throwE "Non-person local actors can't get Grants at the moment" _ -> throwE "Non-person local actors can't get Grants at the moment"
processRemote (author, _, _) = pure $ remoteAuthorId author processRemote (author, _, _) = pure $ remoteAuthorId author
getGrant
:: ( MonadIO m
, PersistRecordBackend topic SqlBackend
, PersistRecordBackend resource SqlBackend
, Show (Key resource)
)
=> EntityField topic CollabId
-> EntityField topic (Key resource)
-> Key resource
-> PersonId
-> ReaderT SqlBackend m (Maybe OutboxItemId)
getGrant topicCollabField topicActorField resourceID personID = do
items <-
E.select $ E.from $ \ (topic `E.InnerJoin` enable `E.InnerJoin` grant `E.InnerJoin` recipL) -> do
E.on $ enable E.^. CollabEnableCollab E.==. recipL E.^. CollabRecipLocalCollab
E.on $ enable E.^. CollabEnableGrant E.==. grant E.^. OutboxItemId
E.on $ topic E.^. topicCollabField E.==. enable E.^. CollabEnableCollab
E.where_ $
topic E.^. topicActorField E.==. E.val resourceID E.&&.
recipL E.^. CollabRecipLocalPerson E.==. E.val personID
return $ grant E.^. OutboxItemId
case items of
[] -> return Nothing
[E.Value i] -> return $ Just i
_ -> error $ "Multiple grants for a Person in resource#" ++ show resourceID

View file

@ -1517,7 +1517,7 @@ instance ActivityPub Branch where
<> "ref" .= ref <> "ref" .= ref
<> "context" .= ObjURI authority repo <> "context" .= ObjURI authority repo
data Role = RoleAdmin deriving Eq data Role = RoleAdmin deriving (Show, Eq, Enum, Bounded)
instance FromJSON Role where instance FromJSON Role where
parseJSON = withText "Role" parse parseJSON = withText "Role" parse

View file

@ -1,6 +1,6 @@
$# This file is part of Vervis. $# This file is part of Vervis.
$# $#
$# Written in 2016, 2019, 2022 by fr33domlover <fr33domlover@riseup.net>. $# Written in 2016, 2019, 2022, 2023 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.
$# $#
@ -42,6 +42,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<td>Admin <td>Admin
<td>#{showDate time} <td>#{showDate time}
<a href=@{DeckInviteR deckHash}>Invite…
<h2>Joins <h2>Joins
<table> <table>
@ -54,5 +56,3 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<td>^{personLinkFedW joiner} <td>^{personLinkFedW joiner}
<td>Admin <td>Admin
<td>#{showDate time} <td>#{showDate time}
$# <a href=@{ProjectDevNewR shr prj}>Add…

View file

@ -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, 2023 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,7 +12,7 @@ $# 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/>.
<form method=POST action=@{ProjectDevsR shr rp} enctype=#{enctype}> <form method=POST action=@{DeckInviteR deckHash} enctype=#{enctype}>
^{widget} ^{widget}
<div class="submit"> <div class="submit">
<input type="submit"> <input type="submit">

View file

@ -218,6 +218,7 @@
/decks/#DeckKeyHashid/stamps/#SigKeyKeyHashid DeckStampR GET /decks/#DeckKeyHashid/stamps/#SigKeyKeyHashid DeckStampR GET
/decks/#DeckKeyHashid/collabs DeckCollabsR GET /decks/#DeckKeyHashid/collabs DeckCollabsR GET
/decks/#DeckKeyHashid/invite DeckInviteR GET POST
---- Ticket ------------------------------------------------------------------ ---- Ticket ------------------------------------------------------------------