From 928ad8f9a94eb71061138f97124a13e021a9d282 Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Fri, 16 Jun 2023 20:12:40 +0300 Subject: [PATCH] UI in deck collaborators list, for adding a new collaborator --- src/Vervis/Form/Tracker.hs | 56 ++++++++++++++++++------------- src/Vervis/Foundation.hs | 2 ++ src/Vervis/Handler/Deck.hs | 44 ++++++++++++++++++++++++ src/Vervis/Persist/Collab.hs | 28 ++++++++++++++++ src/Web/ActivityPub.hs | 2 +- templates/deck/collab/list.hamlet | 6 ++-- templates/deck/collab/new.hamlet | 4 +-- th/routes | 1 + 8 files changed, 113 insertions(+), 30 deletions(-) diff --git a/src/Vervis/Form/Tracker.hs b/src/Vervis/Form/Tracker.hs index ad6a5e9..c7f6911 100644 --- a/src/Vervis/Form/Tracker.hs +++ b/src/Vervis/Form/Tracker.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016, 2019, 2022 by fr33domlover . + - Written in 2016, 2019, 2022, 2023 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -18,6 +18,8 @@ module Vervis.Form.Tracker , newDeckForm , NewLoom (..) , newLoomForm + , DeckInvite (..) + , deckInviteForm --, NewProjectCollab (..) --, newProjectCollabForm --, editProjectForm @@ -27,7 +29,7 @@ where import Data.Bifunctor import Data.Maybe import Data.Text (Text) -import Database.Persist ((==.)) +import Database.Persist import Yesod.Form.Fields import Yesod.Form.Functions import Yesod.Form.Types @@ -38,8 +40,11 @@ import qualified Database.Esqueleto as E import Yesod.Hashids +import qualified Web.ActivityPub as AP + import Vervis.Foundation import Vervis.Model +import Vervis.Model.Ident data NewDeck = NewDeck { ndName :: Text @@ -78,36 +83,39 @@ newLoomForm = renderDivs $ NewLoom , repoID ) -{- -data NewProjectCollab = NewProjectCollab - { ncPerson :: PersonId - , ncRole :: Maybe RoleId +data DeckInvite = DeckInvite + { diPerson :: PersonId + , diRole :: AP.Role } -newProjectCollabAForm - :: SharerId -> ProjectId -> AForm Handler NewProjectCollab -newProjectCollabAForm sid jid = NewProjectCollab - <$> areq selectPerson "Person*" Nothing - <*> aopt selectRole "Custom role" Nothing +deckInviteForm :: DeckId -> Form DeckInvite +deckInviteForm deckID = renderDivs $ DeckInvite + <$> areq selectPerson "Person*" Nothing + <*> areq selectRole "Role*" Nothing where selectPerson = selectField $ do l <- runDB $ E.select $ - E.from $ \ (person `E.InnerJoin` sharer `E.LeftOuterJoin` (recip `E.InnerJoin` topic)) -> do - E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicLocalProjectCollab E.&&. - topic E.^. CollabTopicLocalProjectProject E.==. E.val jid + E.from $ \ (person `E.InnerJoin` actor `E.LeftOuterJoin` (recip `E.InnerJoin` topic)) -> do + E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicDeckCollab E.&&. + topic E.^. CollabTopicDeckDeck E.==. E.val deckID 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 - return (sharer E.^. SharerIdent, person E.^. PersonId) - optionsPairs $ map (bimap (shr2text . E.unValue) E.unValue) l - selectRole = - selectField $ - optionsPersistKey [RoleSharer ==. sid] [] $ - rl2text . roleIdent - -newProjectCollabForm :: SharerId -> ProjectId -> Form NewProjectCollab -newProjectCollabForm sid jid = renderDivs $ newProjectCollabAForm sid jid + 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 <$> pure (projectActor project) diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 2dcd449..cc8058b 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -929,6 +929,8 @@ instance YesodBreadcrumbs App where DeckCollabsR d -> ("Collaborators", Just $ DeckR d) + DeckInviteR d -> ("Invite", Just $ DeckR d) + TicketR d t -> ("#" <> keyHashidText t, Just $ DeckTicketsR d) TicketDiscussionR d t -> ("Discussion", Just $ TicketR d t) TicketEventsR d t -> ("Events", Just $ TicketR d t) diff --git a/src/Vervis/Handler/Deck.hs b/src/Vervis/Handler/Deck.hs index 04e65dc..ad525b9 100644 --- a/src/Vervis/Handler/Deck.hs +++ b/src/Vervis/Handler/Deck.hs @@ -37,6 +37,8 @@ module Vervis.Handler.Deck , getDeckStampR , getDeckCollabsR + , getDeckInviteR + , postDeckInviteR @@ -427,6 +429,48 @@ getDeckCollabsR deckHash = do LocalActorPerson personID -> return personID _ -> 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 + diff --git a/src/Vervis/Persist/Collab.hs b/src/Vervis/Persist/Collab.hs index c57d50e..87c92c1 100644 --- a/src/Vervis/Persist/Collab.hs +++ b/src/Vervis/Persist/Collab.hs @@ -23,6 +23,8 @@ module Vervis.Persist.Collab , verifyCapability , verifyCapability' + + , getGrant ) where @@ -312,3 +314,29 @@ verifyCapability' cap actor resource = do LocalActorPerson personID -> return personID _ -> throwE "Non-person local actors can't get Grants at the moment" 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 diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 080b61f..928701f 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -1517,7 +1517,7 @@ instance ActivityPub Branch where <> "ref" .= ref <> "context" .= ObjURI authority repo -data Role = RoleAdmin deriving Eq +data Role = RoleAdmin deriving (Show, Eq, Enum, Bounded) instance FromJSON Role where parseJSON = withText "Role" parse diff --git a/templates/deck/collab/list.hamlet b/templates/deck/collab/list.hamlet index 10a7fd8..9fda8bf 100644 --- a/templates/deck/collab/list.hamlet +++ b/templates/deck/collab/list.hamlet @@ -1,6 +1,6 @@ $# This file is part of Vervis. $# -$# Written in 2016, 2019, 2022 by fr33domlover . +$# Written in 2016, 2019, 2022, 2023 by fr33domlover . $# $# ♡ Copying is an act of love. Please copy, reuse and share. $# @@ -42,6 +42,8 @@ $# . Admin #{showDate time} +Invite… +

Joins @@ -54,5 +56,3 @@ $# .
^{personLinkFedW joiner} Admin #{showDate time} - -$# Add… diff --git a/templates/deck/collab/new.hamlet b/templates/deck/collab/new.hamlet index 77b8cab..45dd9a1 100644 --- a/templates/deck/collab/new.hamlet +++ b/templates/deck/collab/new.hamlet @@ -1,6 +1,6 @@ $# This file is part of Vervis. $# -$# Written in 2016 by fr33domlover . +$# Written in 2016, 2023 by fr33domlover . $# $# ♡ 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 $# . -
+ ^{widget}
diff --git a/th/routes b/th/routes index 9c34b5f..7d8abd0 100644 --- a/th/routes +++ b/th/routes @@ -218,6 +218,7 @@ /decks/#DeckKeyHashid/stamps/#SigKeyKeyHashid DeckStampR GET /decks/#DeckKeyHashid/collabs DeckCollabsR GET +/decks/#DeckKeyHashid/invite DeckInviteR GET POST ---- Ticket ------------------------------------------------------------------