diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index 4a188bf..9f739ad 100644 --- a/src/Vervis/Client.hs +++ b/src/Vervis/Client.hs @@ -40,6 +40,7 @@ module Vervis.Client , createProject , invite , remove + , inviteComponent ) where @@ -84,6 +85,7 @@ import Vervis.ActivityPub import Vervis.Actor import Vervis.Actor2 import Vervis.Cloth +import Vervis.Data.Actor import Vervis.Data.Collab import Vervis.Data.Ticket import Vervis.FedURI @@ -1198,3 +1200,74 @@ remove personID uRecipient uResourceCollabs = do audience = [audResource, audRecipient, audAuthor] return (Nothing, audience, activity) + +inviteComponent + :: PersonId + -> ProjectId + -> FedURI + -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Invite URIMode) +inviteComponent personID projectID uComp = do + + encodeRouteHome <- getEncodeRouteHome + theater <- asksSite appTheater + env <- asksSite appEnv + projectHash <- encodeKeyHashid projectID + + let uComps = encodeRouteHome $ ProjectComponentsR projectHash + activity = AP.Invite AP.RoleAdmin uComp uComps + + -- If component is remote, get it via HTTP/DB to determine its followers + -- collection + comp <- parseComp uComp + compDB <- + bitraverse + (runActE . hashComponent) + (\ u@(ObjURI h lu) -> do + instanceID <- + lift $ runDB $ either entityKey id <$> insertBy' (Instance h) + result <- + ExceptT $ first (T.pack . displayException) <$> + fetchRemoteActor instanceID h lu + case result of + Left Nothing -> throwE "Recipient @id mismatch" + Left (Just err) -> throwE $ T.pack $ displayException err + Right Nothing -> throwE "Recipient isn't an actor" + Right (Just actor) -> return (entityVal actor, u) + ) + comp + + senderHash <- encodeKeyHashid personID + + let audComp = + case compDB of + Left (ComponentRepo r) -> + AudLocal [LocalActorRepo r] [LocalStageRepoFollowers r] + Left (ComponentDeck d) -> + AudLocal [LocalActorDeck d] [LocalStageDeckFollowers d] + Left (ComponentLoom l) -> + AudLocal [LocalActorLoom l] [LocalStageLoomFollowers l] + Right (remoteActor, ObjURI h lu) -> + AudRemote h + [lu] + (maybeToList $ remoteActorFollowers remoteActor) + audProject = + AudLocal [LocalActorProject projectHash] [LocalStageProjectFollowers projectHash] + audAuthor = + AudLocal [] [LocalStagePersonFollowers senderHash] + + audience = [audComp, audProject, audAuthor] + + return (Nothing, audience, activity) + where + parseComp u = do + routeOrRemote <- parseFedURIOld u + bitraverse + (\ route -> do + c <- + fromMaybeE + (parseComponent route) + "Not a component route" + runActE $ unhashComponentE c "Contains invalid keyhashid" + ) + pure + routeOrRemote diff --git a/src/Vervis/Data/Collab.hs b/src/Vervis/Data/Collab.hs index 56861e2..995a65f 100644 --- a/src/Vervis/Data/Collab.hs +++ b/src/Vervis/Data/Collab.hs @@ -48,7 +48,9 @@ module Vervis.Data.Collab , grantResourceLocalActor , ComponentBy (..) + , parseComponent , hashComponent + , unhashComponentE , componentActor , resourceToComponent diff --git a/src/Vervis/Form/Tracker.hs b/src/Vervis/Form/Tracker.hs index 0b6fb2e..66c5cf4 100644 --- a/src/Vervis/Form/Tracker.hs +++ b/src/Vervis/Form/Tracker.hs @@ -24,6 +24,7 @@ module Vervis.Form.Tracker , deckInviteForm , ProjectInvite (..) , projectInviteForm + , projectInviteCompForm --, NewProjectCollab (..) --, newProjectCollabForm --, editProjectForm @@ -46,6 +47,8 @@ import Yesod.Hashids import qualified Web.ActivityPub as AP +import Vervis.FedURI +import Vervis.Form.Ticket import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident @@ -161,6 +164,9 @@ projectInviteForm projectID = renderDivs $ ProjectInvite l selectRole = selectField optionsEnum +projectInviteCompForm :: Form FedURI +projectInviteCompForm = renderDivs $ areq fedUriField "Component URI*" Nothing + {- editProjectAForm :: SharerId -> Entity Project -> AForm Handler Project editProjectAForm sid (Entity jid project) = Project diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 914b357..7b0bed9 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -1010,3 +1010,5 @@ instance YesodBreadcrumbs App where ProjectComponentsR j -> ("Components", Just $ ProjectR j) ProjectCollabLiveR j c -> (keyHashidText c, Just $ ProjectCollabsR j) + + ProjectInviteCompR d -> ("Invite", Just $ ProjectComponentsR d) diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs index aa737dd..3a43242 100644 --- a/src/Vervis/Handler/Project.hs +++ b/src/Vervis/Handler/Project.hs @@ -35,6 +35,9 @@ module Vervis.Handler.Project , getProjectComponentsR , getProjectCollabLiveR + + , getProjectInviteCompR + , postProjectInviteCompR ) where @@ -522,3 +525,42 @@ getProjectCollabLiveR projectHash enableHash = do CollabTopicProject _ j <- getValBy404 $ UniqueCollabTopicProject collabID unless (j == projectID) notFound + +getProjectInviteCompR :: KeyHashid Project -> Handler Html +getProjectInviteCompR projectHash = do + projectID <- decodeKeyHashid404 projectHash + ((_result, widget), enctype) <- runFormPost projectInviteCompForm + defaultLayout $(widgetFile "project/component-new") + +postProjectInviteCompR :: KeyHashid Project -> Handler Html +postProjectInviteCompR projectHash = do + projectID <- decodeKeyHashid404 projectHash + uComp <- + runFormPostRedirect (ProjectInviteCompR projectHash) projectInviteCompForm + + personEntity@(Entity personID person) <- requireAuth + personHash <- encodeKeyHashid personID + encodeRouteHome <- getEncodeRouteHome + + result <- runExceptT $ do + (maybeSummary, audience, invite) <- + C.inviteComponent personID projectID uComp + grantID <- do + maybeItem <- lift $ runDB $ getGrant CollabTopicProjectCollab CollabTopicProjectProject projectID personID + fromMaybeE maybeItem "You need to be a collaborator in the Project to invite people" + grantHash <- encodeKeyHashid grantID + let uCap = encodeRouteHome $ ProjectOutboxItemR projectHash grantHash + (localRecips, remoteRecips, fwdHosts, action) <- + C.makeServerInput (Just uCap) maybeSummary audience $ AP.InviteActivity invite + let cap = + Left (LocalActorProject projectID, LocalActorProject projectHash, grantID) + handleViaActor + personID (Just cap) localRecips remoteRecips fwdHosts action + + case result of + Left e -> do + setMessage $ toHtml e + redirect $ ProjectInviteCompR projectHash + Right inviteID -> do + setMessage "Invite sent" + redirect $ ProjectComponentsR projectHash diff --git a/templates/project/component-new.hamlet b/templates/project/component-new.hamlet new file mode 100644 index 0000000..47e4c9f --- /dev/null +++ b/templates/project/component-new.hamlet @@ -0,0 +1,18 @@ +$# This file is part of Vervis. +$# +$# Written in 2016, 2023 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 +$# . + +
+ ^{widget} +
+ diff --git a/templates/project/components.hamlet b/templates/project/components.hamlet index b996301..28483e6 100644 --- a/templates/project/components.hamlet +++ b/templates/project/components.hamlet @@ -39,4 +39,4 @@ $# ^{buttonW POST "Remove" (ProjectRemoveR projectHash ctID)} #{show role} ^{componentLinkFedW comp} -$#Invite… +Invite… diff --git a/th/routes b/th/routes index 58d55f1..40c9dfa 100644 --- a/th/routes +++ b/th/routes @@ -330,3 +330,5 @@ /projects/#ProjectKeyHashid/components ProjectComponentsR GET /projects/#ProjectKeyHashid/collabs/#CollabEnableKeyHashid/live ProjectCollabLiveR GET + +/projects/#ProjectKeyHashid/invite-component ProjectInviteCompR GET POST