From 0ee94afd9e98339972c860c86fe4be633d5d4007 Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Sat, 18 May 2024 03:40:34 +0300 Subject: [PATCH] UI: Component, Project: Display teams, invites and action buttons --- src/Vervis/Form/Tracker.hs | 8 ++ src/Vervis/Foundation.hs | 5 ++ src/Vervis/Handler/Deck.hs | 13 +-- src/Vervis/Handler/Group.hs | 1 + src/Vervis/Handler/Loom.hs | 13 +-- src/Vervis/Handler/Project.hs | 152 ++++++++++++++++++++++++++++++++ src/Vervis/Handler/Repo.hs | 14 +-- src/Vervis/Persist/Collab.hs | 91 +++++++++++++++++++ src/Vervis/Serve/Collab.hs | 20 +++-- src/Vervis/Widget/Tracker.hs | 24 ++++- src/Web/ActivityPub.hs | 5 +- templates/widget/collabs.hamlet | 56 ++++++++++++ th/routes | 5 ++ 13 files changed, 384 insertions(+), 23 deletions(-) diff --git a/src/Vervis/Form/Tracker.hs b/src/Vervis/Form/Tracker.hs index 2309bd7..bb7d94e 100644 --- a/src/Vervis/Form/Tracker.hs +++ b/src/Vervis/Form/Tracker.hs @@ -31,6 +31,7 @@ module Vervis.Form.Tracker , GroupInvite (..) , groupInviteForm , inviteForm + , addTeamForm --, NewProjectCollab (..) --, newProjectCollabForm --, editProjectForm @@ -225,6 +226,13 @@ inviteForm = renderDivs $ (,) selectRole :: Field Handler AP.Role selectRole = selectField optionsEnum +addTeamForm = renderDivs $ (,) + <$> areq fedUriField "Team URI*" Nothing + <*> areq selectRole "Role*" Nothing + where + selectRole :: Field Handler AP.Role + selectRole = selectField optionsEnum + {- 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 a243323..51f6b4b 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -1076,6 +1076,11 @@ instance YesodBreadcrumbs App where ProjectApproveChildR _ _ -> ("", Nothing) ProjectApproveParentR _ _ -> ("", Nothing) + ProjectTeamsR j -> ("Teams", Just $ ProjectR j) + ProjectAddTeamR _ -> ("", Nothing) + ProjectApproveTeamR _ _ -> ("", Nothing) + ProjectRemoveTeamR _ _ -> ("", Nothing) + PersonErrboxR p -> ("Errbox", Just $ PersonR p) GroupErrboxR g -> ("Errbox", Just $ GroupR g) ProjectErrboxR j -> ("Errbox", Just $ ProjectR j) diff --git a/src/Vervis/Handler/Deck.hs b/src/Vervis/Handler/Deck.hs index 24bff28..e6aa16e 100644 --- a/src/Vervis/Handler/Deck.hs +++ b/src/Vervis/Handler/Deck.hs @@ -434,6 +434,12 @@ getDeckCollabsR deckHash = do (DeckCollabsR deckHash) (DeckRemoveR deckHash) (DeckInviteR deckHash) + (Just + ( DeckRemoveTeamR deckHash + , DeckAddTeamR deckHash + , DeckApproveTeamR deckHash + ) + ) (deckNavW (Entity deckID deck) actor) postDeckInviteR :: KeyHashid Deck -> Handler Html @@ -609,13 +615,10 @@ getDeckTeamsR deckHash = do komponentResource <$> getJust komponentID serveTeamsCollection (DeckR deckHash) (DeckTeamsR deckHash) resourceID -addTeamForm = renderDivs $ - areq fedUriField "(URI) Team" Nothing - postDeckAddTeamR :: KeyHashid Deck -> Handler () postDeckAddTeamR deckHash = do deckID <- decodeKeyHashid404 deckHash - uTeam <- + (uTeam, role) <- runFormPostRedirect (DeckCollabsR deckHash) addTeamForm personEntity@(Entity personID person) <- requireAuth @@ -625,7 +628,7 @@ postDeckAddTeamR deckHash = do let uCollection = encodeRouteHome $ DeckTeamsR deckHash result <- runExceptT $ do - (maybeSummary, audience, add) <- C.add personID uTeam uCollection AP.RoleAdmin + (maybeSummary, audience, add) <- C.add personID uTeam uCollection role cap <- do maybeItem <- lift $ runDB $ do resourceID <- deckResource <$> get404 deckID diff --git a/src/Vervis/Handler/Group.hs b/src/Vervis/Handler/Group.hs index da45b80..aafe89d 100644 --- a/src/Vervis/Handler/Group.hs +++ b/src/Vervis/Handler/Group.hs @@ -262,6 +262,7 @@ getGroupMembersR groupHash = do (GroupMembersR groupHash) (GroupRemoveR groupHash) (GroupInviteR groupHash) + Nothing (groupNavW (Entity groupID group) actor) postGroupInviteR :: KeyHashid Group -> Handler Html diff --git a/src/Vervis/Handler/Loom.hs b/src/Vervis/Handler/Loom.hs index 3d25809..491fe5b 100644 --- a/src/Vervis/Handler/Loom.hs +++ b/src/Vervis/Handler/Loom.hs @@ -383,6 +383,12 @@ getLoomCollabsR loomHash = do (LoomCollabsR loomHash) (LoomRemoveR loomHash) (LoomInviteR loomHash) + (Just + ( LoomRemoveTeamR loomHash + , LoomAddTeamR loomHash + , LoomApproveTeamR loomHash + ) + ) (loomNavW (Entity loomID loom) actor) postLoomInviteR :: KeyHashid Loom -> Handler Html @@ -425,13 +431,10 @@ getLoomTeamsR loomHash = do komponentResource <$> getJust komponentID serveTeamsCollection (LoomR loomHash) (LoomTeamsR loomHash) resourceID -addTeamForm = renderDivs $ - areq fedUriField "(URI) Team" Nothing - postLoomAddTeamR :: KeyHashid Loom -> Handler () postLoomAddTeamR loomHash = do loomID <- decodeKeyHashid404 loomHash - uTeam <- + (uTeam, role) <- runFormPostRedirect (LoomCollabsR loomHash) addTeamForm personEntity@(Entity personID person) <- requireAuth @@ -441,7 +444,7 @@ postLoomAddTeamR loomHash = do let uCollection = encodeRouteHome $ LoomTeamsR loomHash result <- runExceptT $ do - (maybeSummary, audience, add) <- C.add personID uTeam uCollection AP.RoleAdmin + (maybeSummary, audience, add) <- C.add personID uTeam uCollection role cap <- do maybeItem <- lift $ runDB $ do resourceID <- loomResource <$> get404 loomID diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs index 9def7e7..d793533 100644 --- a/src/Vervis/Handler/Project.hs +++ b/src/Vervis/Handler/Project.hs @@ -53,6 +53,11 @@ module Vervis.Handler.Project , postProjectApproveComponentR , postProjectApproveChildR , postProjectApproveParentR + + , getProjectTeamsR + , postProjectAddTeamR + , postProjectApproveTeamR + , postProjectRemoveTeamR ) where @@ -185,6 +190,8 @@ getProjectR projectHash = do encodeRouteLocal $ ProjectComponentsR projectHash , AP.projectCollaborators = encodeRouteLocal $ ProjectCollabsR projectHash + , AP.projectTeams = + encodeRouteLocal $ ProjectTeamsR projectHash } provideHtmlAndAP projectAP $(widgetFile "project/one") where @@ -262,6 +269,12 @@ getProjectCollabsR projectHash = do (ProjectCollabsR projectHash) (ProjectRemoveR projectHash) (ProjectInviteR projectHash) + (Just + ( ProjectRemoveTeamR projectHash + , ProjectAddTeamR projectHash + , ProjectApproveTeamR projectHash + ) + ) (projectNavW (Entity projectID project) actor) postProjectInviteR :: KeyHashid Project -> Handler Html @@ -1219,3 +1232,142 @@ postProjectApproveParentR projectHash destID = do Right removeID -> setMessage "Accept sent" redirect $ ProjectParentsR projectHash + +getProjectTeamsR :: KeyHashid Project -> Handler TypedContent +getProjectTeamsR projectHash = do + projectID <- decodeKeyHashid404 projectHash + resourceID <- runDB $ projectResource <$> getJust projectID + serveTeamsCollection (ProjectR projectHash) (ProjectTeamsR projectHash) resourceID + +postProjectAddTeamR :: KeyHashid Project -> Handler () +postProjectAddTeamR projectHash = do + projectID <- decodeKeyHashid404 projectHash + (uTeam, role) <- + runFormPostRedirect (ProjectCollabsR projectHash) addTeamForm + + personEntity@(Entity personID person) <- requireAuth + personHash <- encodeKeyHashid personID + encodeRouteHome <- getEncodeRouteHome + + let uCollection = encodeRouteHome $ ProjectTeamsR projectHash + + result <- runExceptT $ do + (maybeSummary, audience, add) <- C.add personID uTeam uCollection role + cap <- do + maybeItem <- lift $ runDB $ do + resourceID <- projectResource <$> get404 projectID + getCapability personID (Left resourceID) AP.RoleAdmin + fromMaybeE maybeItem "You need to be have Admin access to the Project to add teams" + uCap <- lift $ renderActivityURI cap + (localRecips, remoteRecips, fwdHosts, action) <- + C.makeServerInput (Just uCap) maybeSummary audience $ AP.AddActivity add + let cap' = first (\ (la, i) -> (la, error "lah", i)) cap + handleViaActor + personID (Just cap') localRecips remoteRecips fwdHosts action + + case result of + Left e -> setMessage $ toHtml e + Right inviteID -> setMessage "Add sent" + redirect $ ProjectCollabsR projectHash + +postProjectApproveTeamR :: KeyHashid Project -> SquadId -> Handler Html +postProjectApproveTeamR projectHash squadID = do + projectID <- decodeKeyHashid404 projectHash + + personEntity@(Entity personID person) <- requireAuth + personHash <- encodeKeyHashid personID + encodeRouteHome <- getEncodeRouteHome + + result <- runExceptT $ do + mpidOrU <- lift $ runDB $ runMaybeT $ do + project <- MaybeT $ get projectID + Squad _ resourceID <- MaybeT $ get squadID + guard $ resourceID == projectResource project + + uAdd <- lift $ do + add <- getSquadAdd squadID + renderActivityURI add + + topic <- lift $ bimap snd snd <$> getSquadTeam squadID + lift $ + (projectResource project,uAdd,) <$> + bitraverse + pure + (getRemoteActorURI <=< getJust) + topic + (resourceID, uAdd, pidOrU) <- maybe notFound pure mpidOrU + (maybeSummary, audience, accept) <- do + uTeam <- + case pidOrU of + Left g -> encodeRouteHome . GroupR <$> encodeKeyHashid g + Right u -> pure u + let uProject = encodeRouteHome $ ProjectR projectHash + C.acceptParentChild personID uAdd uTeam uProject + cap <- do + maybeItem <- lift $ runDB $ getCapability personID (Left resourceID) AP.RoleAdmin + fromMaybeE maybeItem "You need to be have Admin access to the Project to approve teams" + uCap <- lift $ renderActivityURI cap + (localRecips, remoteRecips, fwdHosts, action) <- + C.makeServerInput (Just uCap) maybeSummary audience $ AP.AcceptActivity accept + let cap' = first (\ (la, i) -> (la, error "lah", i)) cap + handleViaActor + personID (Just cap') localRecips remoteRecips fwdHosts action + + case result of + Left e -> do + setMessage $ toHtml e + Right removeID -> + setMessage "Accept sent" + redirect $ ProjectCollabsR projectHash + +postProjectRemoveTeamR :: KeyHashid Project -> SquadId -> Handler Html +postProjectRemoveTeamR projectHash squadID = do + projectID <- decodeKeyHashid404 projectHash + + personEntity@(Entity personID person) <- requireAuth + personHash <- encodeKeyHashid personID + encodeRouteHome <- getEncodeRouteHome + + result <- runExceptT $ do + mpidOrU <- lift $ runDB $ runMaybeT $ do + project <- MaybeT $ get projectID + Squad _ resourceID <- MaybeT $ get squadID + guard $ resourceID == projectResource project + acceptID <- MaybeT $ getKeyBy $ UniqueSquadUsAccept squadID + _ <- MaybeT $ getBy $ UniqueSquadUsStart acceptID + + uAdd <- lift $ do + add <- getSquadAdd squadID + renderActivityURI add + + topic <- lift $ bimap snd snd <$> getSquadTeam squadID + lift $ + (projectResource project,uAdd,) <$> + bitraverse + pure + (getRemoteActorURI <=< getJust) + topic + (resourceID, uAdd, pidOrU) <- maybe notFound pure mpidOrU + (maybeSummary, audience, remove) <- do + uTeam <- + case pidOrU of + Left g -> encodeRouteHome . GroupR <$> encodeKeyHashid g + Right u -> pure u + let uCollection = encodeRouteHome $ ProjectTeamsR projectHash + C.remove personID uTeam uCollection + cap <- do + maybeItem <- lift $ runDB $ getCapability personID (Left resourceID) AP.RoleAdmin + fromMaybeE maybeItem "You need to be have Admin access to the Project to remove teams" + uCap <- lift $ renderActivityURI cap + (localRecips, remoteRecips, fwdHosts, action) <- + C.makeServerInput (Just uCap) maybeSummary audience $ AP.RemoveActivity remove + let cap' = first (\ (la, i) -> (la, error "lah", i)) cap + handleViaActor + personID (Just cap') localRecips remoteRecips fwdHosts action + + case result of + Left e -> do + setMessage $ toHtml e + Right removeID -> + setMessage "Remove sent" + redirect $ ProjectCollabsR projectHash diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 545aac0..ce7ae61 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -180,6 +180,7 @@ import Vervis.Federation.Offer import Vervis.FedURI import Vervis.Field.Person import Vervis.Form.Repo +import Vervis.Form.Tracker import Vervis.Foundation import Vervis.Path import Vervis.Model @@ -805,6 +806,12 @@ getRepoCollabsR repoHash = do (RepoCollabsR repoHash) (RepoRemoveR repoHash) (RepoInviteR repoHash) + (Just + ( RepoRemoveTeamR repoHash + , RepoAddTeamR repoHash + , RepoApproveTeamR repoHash + ) + ) (repoNavW (Entity repoID repo) actor) postRepoInviteR :: KeyHashid Repo -> Handler Html @@ -848,13 +855,10 @@ getRepoTeamsR repoHash = do komponentResource <$> getJust komponentID serveTeamsCollection (RepoR repoHash) (RepoTeamsR repoHash) resourceID -addTeamForm = renderDivs $ - areq fedUriField "(URI) Team" Nothing - postRepoAddTeamR :: KeyHashid Repo -> Handler () postRepoAddTeamR repoHash = do repoID <- decodeKeyHashid404 repoHash - uTeam <- + (uTeam, role) <- runFormPostRedirect (RepoCollabsR repoHash) addTeamForm personEntity@(Entity personID person) <- requireAuth @@ -864,7 +868,7 @@ postRepoAddTeamR repoHash = do let uCollection = encodeRouteHome $ RepoTeamsR repoHash result <- runExceptT $ do - (maybeSummary, audience, add) <- C.add personID uTeam uCollection AP.RoleAdmin + (maybeSummary, audience, add) <- C.add personID uTeam uCollection role cap <- do maybeItem <- lift $ runDB $ do resourceID <- repoResource <$> get404 repoID diff --git a/src/Vervis/Persist/Collab.hs b/src/Vervis/Persist/Collab.hs index 8087911..a426c7b 100644 --- a/src/Vervis/Persist/Collab.hs +++ b/src/Vervis/Persist/Collab.hs @@ -62,6 +62,7 @@ module Vervis.Persist.Collab , getStemDrafts , getResourceTeams + , getResourceTeamDrafts , getSquadAdd , getSquadTeam @@ -1404,6 +1405,16 @@ getCapability personID actor role = do return $ Right u return $ maybeDirect' <|> maybeExt' +getStems + :: MonadIO m + => KomponentId + -> ReaderT SqlBackend m + [ ( Either (ProjectId, Actor) (Instance, RemoteObject, RemoteActor) + , AP.Role + , UTCTime + , StemId + ) + ] getStems komponentID = do stems <- E.select $ E.from $ \ (stem `E.InnerJoin` accept `E.InnerJoin` deleg `E.InnerJoin` grant) -> do @@ -1428,6 +1439,19 @@ getStems komponentID = do j return (projectView, stemRole stem, time, stemID) +getStemDrafts + :: MonadIO m + => KomponentId + -> ReaderT SqlBackend m + [ ( Either (LocalActorBy Key, Actor) (Instance, RemoteObject, RemoteActor) + , Bool + , Either (ProjectId, Actor) (Instance, RemoteObject, RemoteActor) + , Bool + , UTCTime + , AP.Role + , StemId + ) + ] getStemDrafts komponentID = do drafts <- E.select $ E.from $ \ (stem `E.LeftOuterJoin` accept `E.LeftOuterJoin` deleg) -> do @@ -1541,6 +1565,73 @@ getResourceTeams resourceID = , squad E.^. SquadId ) +getResourceTeamDrafts + :: MonadIO m + => ResourceId + -> ReaderT SqlBackend m + [ ( Either (LocalActorBy Key, Actor) (Instance, RemoteObject, RemoteActor) + , Bool + , Either (GroupId, Actor) (Instance, RemoteObject, RemoteActor) + , Bool + , UTCTime + , AP.Role + , SquadId + ) + ] +getResourceTeamDrafts resourceID = do + squads <- E.select $ E.from $ \ (squad `E.LeftOuterJoin` accept `E.LeftOuterJoin` delegl `E.LeftOuterJoin` delegr) -> do + E.on $ accept E.?. SquadUsAcceptId E.==. delegr E.?. SquadThemSendDelegatorRemoteSquad + E.on $ accept E.?. SquadUsAcceptId E.==. delegl E.?. SquadThemSendDelegatorLocalSquad + E.on $ E.just (squad E.^. SquadId) E.==. accept E.?. SquadUsAcceptSquad + E.where_ $ + squad E.^. SquadHolder E.==. E.val resourceID E.&&. + E.isNothing (delegl E.?. SquadThemSendDelegatorLocalId) E.&&. + E.isNothing (delegr E.?. SquadThemSendDelegatorRemoteId) + E.orderBy [E.asc $ squad E.^. SquadId] + return squad + for squads $ \ (Entity squadID (Squad role _)) -> do + team <- do + topic <- getSquadTeam squadID + bitraverse + (\ (_, gID) -> do + g <- getJust gID + actor <- getJust $ groupActor g + return (gID, actor) + ) + (\ (_, actorID) -> getRemoteActorData actorID) + topic + accept <- isJust <$> getBy (UniqueSquadUsAccept squadID) + ((inviter, time), us) <- do + usOrThem <- + requireEitherAlt + (getKeyBy $ UniqueSquadOriginUs squadID) + (getKeyBy $ UniqueSquadOriginThem squadID) + "Neither us nor them" + "Both us and them" + (addOrActor, us) <- + case usOrThem of + Left _usID -> (,True) <$> + requireEitherAlt + (fmap squadUsGestureLocalActivity <$> getValBy (UniqueSquadUsGestureLocal squadID)) + (fmap (squadUsGestureRemoteActor &&& squadUsGestureRemoteActivity) <$> getValBy (UniqueSquadUsGestureRemote squadID)) + "Neither local not remote" + "Both local and remote" + Right themID -> (,False) <$> + requireEitherAlt + (fmap squadThemGestureLocalAdd <$> getValBy (UniqueSquadThemGestureLocal themID)) + (fmap (squadThemGestureRemoteActor &&& squadThemGestureRemoteAdd) <$> getValBy (UniqueSquadThemGestureRemote themID)) + "Neither local not remote" + "Both local and remote" + (,us) <$> case addOrActor of + Left addID -> do + OutboxItem outboxID _ time <- getJust addID + Entity actorID actor <- getByJust $ UniqueActorOutbox outboxID + (,time) . Left . (,actor) <$> getLocalActor actorID + Right (actorID, addID) -> do + RemoteActivity _ _ time <- getJust addID + (,time) . Right <$> getRemoteActorData actorID + return (inviter, us, team, accept, time, role, squadID) + getSquadAdd :: MonadIO m => SquadId diff --git a/src/Vervis/Serve/Collab.hs b/src/Vervis/Serve/Collab.hs index 1c7b4ab..2259fd9 100644 --- a/src/Vervis/Serve/Collab.hs +++ b/src/Vervis/Serve/Collab.hs @@ -133,9 +133,14 @@ serveCollabs -> Route App -> (CollabId -> Route App) -> Route App + -> Maybe + ( SquadId -> Route App + , Route App + , SquadId -> Route App + ) -> Widget -> Handler TypedContent -serveCollabs rel resourceID meR hereR removeR inviteR navW = do +serveCollabs rel resourceID meR hereR removeR inviteR maybeTeams navW = do collabs <- runDB $ getCollabs resourceID h <- asksSite siteInstanceHost encodeRouteLocal <- getEncodeRouteLocal @@ -174,13 +179,16 @@ serveCollabs rel resourceID meR hereR removeR inviteR navW = do haveAdmin <- fmap isJust $ handlerToWidget $ runDB $ runMaybeT $ do personID <- MaybeT $ pure mp MaybeT $ getCapability personID (Left resourceID) AP.RoleAdmin - (invites, joins) <- handlerToWidget $ runDB $ do - invites <- getCollabInvites resourceID - joins <- getCollabJoins resourceID - return (invites, joins) + (invites, joins, teamsAndDrafts) <- handlerToWidget $ runDB $ (,,) + <$> getCollabInvites resourceID + <*> getCollabJoins resourceID + <*> (for maybeTeams $ \ r -> (r,,) + <$> getResourceTeams resourceID + <*> getResourceTeamDrafts resourceID + ) [whamlet| ^{navW} - ^{collabsW haveAdmin collabs invites joins removeR inviteR} + ^{collabsW haveAdmin collabs invites joins teamsAndDrafts removeR inviteR} |] serveInviteCollab :: ResourceId -> Route App -> Handler Html diff --git a/src/Vervis/Widget/Tracker.hs b/src/Vervis/Widget/Tracker.hs index 483a9f7..70831c8 100644 --- a/src/Vervis/Widget/Tracker.hs +++ b/src/Vervis/Widget/Tracker.hs @@ -245,9 +245,31 @@ collabsW , CollabId ) ] + -> Maybe + ( ( SquadId -> Route App + , Route App + , SquadId -> Route App + ) + , [ ( AP.Role + , UTCTime + , Either (GroupId, Actor) (Instance, RemoteObject, RemoteActor) + , SquadId + ) + ] + , [ ( Either (LocalActorBy Key, Actor) (Instance, RemoteObject, RemoteActor) + , Bool + , Either (GroupId, Actor) (Instance, RemoteObject, RemoteActor) + , Bool + , UTCTime + , AP.Role + , SquadId + ) + ] + ) -> (CollabId -> Route App) -> Route App -> Widget -collabsW haveAdmin collabs invites joins removeR inviteR = do +collabsW haveAdmin collabs invites joins teamsAndDrafts removeR inviteR = do ((_, widgetIC), enctypeIC) <- handlerToWidget $ runFormPost inviteForm + ((_, widgetAT), enctypeAT) <- handlerToWidget $ runFormPost addTeamForm $(widgetFile "widget/collabs") diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 786d080..0b81775 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -920,6 +920,7 @@ data Project u = Project , projectParents :: LocalURI , projectComponents :: LocalURI , projectCollaborators :: LocalURI + , projectTeams :: LocalURI } instance ActivityPub Project where @@ -935,13 +936,15 @@ instance ActivityPub Project where <*> withAuthorityO h (o .: "context") <*> withAuthorityO h (o .: "components") <*> withAuthorityO h (o .: "collaborators") - toSeries h (Project actor tracker children parents components collabs) + <*> withAuthorityO h (o .: "teams") + toSeries h (Project actor tracker children parents components collabs teams) = toSeries h actor <> "ticketsTrackedBy" .=? tracker <> "subprojects" .= ObjURI h children <> "context" .= ObjURI h parents <> "components" .= ObjURI h components <> "collaborators" .= ObjURI h collabs + <> "teams" .= ObjURI h teams data Team u = Team { teamActor :: Actor u diff --git a/templates/widget/collabs.hamlet b/templates/widget/collabs.hamlet index 26a1c9a..90e6716 100644 --- a/templates/widget/collabs.hamlet +++ b/templates/widget/collabs.hamlet @@ -13,6 +13,30 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . +$maybe ((removeTeamR, addTeamR, _approveTeamR), teams, _drafts) <- teamsAndDrafts +

Teams + + + + +
Role + Since + Team + $if haveAdmin + Remove + $forall (role, since, team, squadID) <- teams +
#{show role} + #{showDate since} + ^{groupLinkFedW team} + $if haveAdmin + ^{buttonW POST "Remove" (removeTeamR squadID)} + + $if haveAdmin +

Add a team: +

+ ^{widgetAT} + +

Collaborators @@ -36,6 +60,38 @@ $if haveAdmin ^{widgetIC} +$maybe ((_removeTeamR, _addTeamR, approveTeamR), _teams, drafts) <- teamsAndDrafts +

Team Invites + +

+ + +
Inviter + Via + Invited team + I accepted? + Role + Time + $if haveAdmin + Approve + $forall (inviter, us, team, accept, time, role, squadID) <- drafts +
^{actorLinkFedW inviter} + + $if us + Us + $else + Them + ^{groupLinkFedW team} + + $if accept + [x] + $else + [_] + #{show role} + #{showDate time} + $if haveAdmin && (not accept && not us) + ^{buttonW POST "Approve" (approveTeamR squadID)} +

Invites diff --git a/th/routes b/th/routes index 1e22fba..009affe 100644 --- a/th/routes +++ b/th/routes @@ -407,3 +407,8 @@ /projects/#ProjectKeyHashid/component/approve/#ComponentId ProjectApproveComponentR POST /projects/#ProjectKeyHashid/child/approve/#SourceId ProjectApproveChildR POST /projects/#ProjectKeyHashid/parent/approve/#DestId ProjectApproveParentR POST + +/projects/#ProjectKeyHashid/teams ProjectTeamsR GET +/projects/#ProjectKeyHashid/add-team ProjectAddTeamR POST +/projects/#ProjectKeyHashid/approve-team/#SquadId ProjectApproveTeamR POST +/projects/#ProjectKeyHashid/remove-team/#SquadId ProjectRemoveTeamR POST