Client: Project UI for adding a component
This commit is contained in:
parent
fe6f95d497
commit
47f993d63f
8 changed files with 146 additions and 1 deletions
|
@ -40,6 +40,7 @@ module Vervis.Client
|
||||||
, createProject
|
, createProject
|
||||||
, invite
|
, invite
|
||||||
, remove
|
, remove
|
||||||
|
, inviteComponent
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -84,6 +85,7 @@ import Vervis.ActivityPub
|
||||||
import Vervis.Actor
|
import Vervis.Actor
|
||||||
import Vervis.Actor2
|
import Vervis.Actor2
|
||||||
import Vervis.Cloth
|
import Vervis.Cloth
|
||||||
|
import Vervis.Data.Actor
|
||||||
import Vervis.Data.Collab
|
import Vervis.Data.Collab
|
||||||
import Vervis.Data.Ticket
|
import Vervis.Data.Ticket
|
||||||
import Vervis.FedURI
|
import Vervis.FedURI
|
||||||
|
@ -1198,3 +1200,74 @@ remove personID uRecipient uResourceCollabs = do
|
||||||
audience = [audResource, audRecipient, audAuthor]
|
audience = [audResource, audRecipient, audAuthor]
|
||||||
|
|
||||||
return (Nothing, audience, activity)
|
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
|
||||||
|
|
|
@ -48,7 +48,9 @@ module Vervis.Data.Collab
|
||||||
, grantResourceLocalActor
|
, grantResourceLocalActor
|
||||||
|
|
||||||
, ComponentBy (..)
|
, ComponentBy (..)
|
||||||
|
, parseComponent
|
||||||
, hashComponent
|
, hashComponent
|
||||||
|
, unhashComponentE
|
||||||
, componentActor
|
, componentActor
|
||||||
, resourceToComponent
|
, resourceToComponent
|
||||||
|
|
||||||
|
|
|
@ -24,6 +24,7 @@ module Vervis.Form.Tracker
|
||||||
, deckInviteForm
|
, deckInviteForm
|
||||||
, ProjectInvite (..)
|
, ProjectInvite (..)
|
||||||
, projectInviteForm
|
, projectInviteForm
|
||||||
|
, projectInviteCompForm
|
||||||
--, NewProjectCollab (..)
|
--, NewProjectCollab (..)
|
||||||
--, newProjectCollabForm
|
--, newProjectCollabForm
|
||||||
--, editProjectForm
|
--, editProjectForm
|
||||||
|
@ -46,6 +47,8 @@ import Yesod.Hashids
|
||||||
|
|
||||||
import qualified Web.ActivityPub as AP
|
import qualified Web.ActivityPub as AP
|
||||||
|
|
||||||
|
import Vervis.FedURI
|
||||||
|
import Vervis.Form.Ticket
|
||||||
import Vervis.Foundation
|
import Vervis.Foundation
|
||||||
import Vervis.Model
|
import Vervis.Model
|
||||||
import Vervis.Model.Ident
|
import Vervis.Model.Ident
|
||||||
|
@ -161,6 +164,9 @@ projectInviteForm projectID = renderDivs $ ProjectInvite
|
||||||
l
|
l
|
||||||
selectRole = selectField optionsEnum
|
selectRole = selectField optionsEnum
|
||||||
|
|
||||||
|
projectInviteCompForm :: Form FedURI
|
||||||
|
projectInviteCompForm = renderDivs $ areq fedUriField "Component URI*" Nothing
|
||||||
|
|
||||||
{-
|
{-
|
||||||
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
|
||||||
|
|
|
@ -1010,3 +1010,5 @@ instance YesodBreadcrumbs App where
|
||||||
|
|
||||||
ProjectComponentsR j -> ("Components", Just $ ProjectR j)
|
ProjectComponentsR j -> ("Components", Just $ ProjectR j)
|
||||||
ProjectCollabLiveR j c -> (keyHashidText c, Just $ ProjectCollabsR j)
|
ProjectCollabLiveR j c -> (keyHashidText c, Just $ ProjectCollabsR j)
|
||||||
|
|
||||||
|
ProjectInviteCompR d -> ("Invite", Just $ ProjectComponentsR d)
|
||||||
|
|
|
@ -35,6 +35,9 @@ module Vervis.Handler.Project
|
||||||
|
|
||||||
, getProjectComponentsR
|
, getProjectComponentsR
|
||||||
, getProjectCollabLiveR
|
, getProjectCollabLiveR
|
||||||
|
|
||||||
|
, getProjectInviteCompR
|
||||||
|
, postProjectInviteCompR
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -522,3 +525,42 @@ getProjectCollabLiveR projectHash enableHash = do
|
||||||
CollabTopicProject _ j <-
|
CollabTopicProject _ j <-
|
||||||
getValBy404 $ UniqueCollabTopicProject collabID
|
getValBy404 $ UniqueCollabTopicProject collabID
|
||||||
unless (j == projectID) notFound
|
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
|
||||||
|
|
18
templates/project/component-new.hamlet
Normal file
18
templates/project/component-new.hamlet
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
$# This file is part of Vervis.
|
||||||
|
$#
|
||||||
|
$# Written in 2016, 2023 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
|
$#
|
||||||
|
$# ♡ 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
|
||||||
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
|
<form method=POST action=@{ProjectInviteCompR projectHash} enctype=#{enctype}>
|
||||||
|
^{widget}
|
||||||
|
<div class="submit">
|
||||||
|
<input type="submit">
|
|
@ -39,4 +39,4 @@ $# <td>^{buttonW POST "Remove" (ProjectRemoveR projectHash ctID)}
|
||||||
<td>#{show role}
|
<td>#{show role}
|
||||||
<td>^{componentLinkFedW comp}
|
<td>^{componentLinkFedW comp}
|
||||||
|
|
||||||
$#<a href=@{ProjectInviteR projectHash}>Invite…
|
<a href=@{ProjectInviteCompR projectHash}>Invite…
|
||||||
|
|
|
@ -330,3 +330,5 @@
|
||||||
|
|
||||||
/projects/#ProjectKeyHashid/components ProjectComponentsR GET
|
/projects/#ProjectKeyHashid/components ProjectComponentsR GET
|
||||||
/projects/#ProjectKeyHashid/collabs/#CollabEnableKeyHashid/live ProjectCollabLiveR GET
|
/projects/#ProjectKeyHashid/collabs/#CollabEnableKeyHashid/live ProjectCollabLiveR GET
|
||||||
|
|
||||||
|
/projects/#ProjectKeyHashid/invite-component ProjectInviteCompR GET POST
|
||||||
|
|
Loading…
Reference in a new issue