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
$#
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: + |