UI, Vocab: Group: Serve accessible resources collection
This commit is contained in:
parent
0ee94afd9e
commit
f93f67a098
8 changed files with 144 additions and 13 deletions
|
@ -905,6 +905,8 @@ instance YesodBreadcrumbs App where
|
||||||
GroupApproveChildR _ _ -> ("", Nothing)
|
GroupApproveChildR _ _ -> ("", Nothing)
|
||||||
GroupApproveParentR _ _ -> ("", Nothing)
|
GroupApproveParentR _ _ -> ("", Nothing)
|
||||||
|
|
||||||
|
GroupEffortsR g -> ("Accessible Resources", Just $ GroupR g)
|
||||||
|
|
||||||
RepoR r -> ("Repo ^" <> keyHashidText r, Just HomeR)
|
RepoR r -> ("Repo ^" <> keyHashidText r, Just HomeR)
|
||||||
RepoInboxR r -> ("Inbox", Just $ RepoR r)
|
RepoInboxR r -> ("Inbox", Just $ RepoR r)
|
||||||
RepoOutboxR r -> ("Outbox", Just $ RepoR r)
|
RepoOutboxR r -> ("Outbox", Just $ RepoR r)
|
||||||
|
|
|
@ -45,6 +45,8 @@ module Vervis.Handler.Group
|
||||||
, postGroupApproveChildR
|
, postGroupApproveChildR
|
||||||
, postGroupApproveParentR
|
, postGroupApproveParentR
|
||||||
|
|
||||||
|
, getGroupEffortsR
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -216,6 +218,7 @@ getGroupR groupHash = do
|
||||||
, AP.teamChildren = encodeRouteLocal $ GroupChildrenR groupHash
|
, AP.teamChildren = encodeRouteLocal $ GroupChildrenR groupHash
|
||||||
, AP.teamParents = encodeRouteLocal $ GroupParentsR groupHash
|
, AP.teamParents = encodeRouteLocal $ GroupParentsR groupHash
|
||||||
, AP.teamMembers = encodeRouteLocal $ GroupMembersR groupHash
|
, AP.teamMembers = encodeRouteLocal $ GroupMembersR groupHash
|
||||||
|
, AP.teamResources = encodeRouteLocal $ GroupEffortsR groupHash
|
||||||
}
|
}
|
||||||
|
|
||||||
provideHtmlAndAP groupAP $(widgetFile "group/one")
|
provideHtmlAndAP groupAP $(widgetFile "group/one")
|
||||||
|
@ -935,6 +938,46 @@ postGroupApproveChildR groupHash destID = do
|
||||||
setMessage "Accept sent"
|
setMessage "Accept sent"
|
||||||
redirect $ GroupChildrenR groupHash
|
redirect $ GroupChildrenR groupHash
|
||||||
|
|
||||||
|
getGroupEffortsR :: KeyHashid Group -> Handler TypedContent
|
||||||
|
getGroupEffortsR groupHash = do
|
||||||
|
groupID <- decodeKeyHashid404 groupHash
|
||||||
|
(group, actor, efforts) <- runDB $ do
|
||||||
|
group <- get404 groupID
|
||||||
|
actor <- getJust $ groupActor group
|
||||||
|
efforts <- getTeamResources groupID
|
||||||
|
return (group, actor, efforts)
|
||||||
|
h <- asksSite siteInstanceHost
|
||||||
|
encodeRouteLocal <- getEncodeRouteLocal
|
||||||
|
encodeRouteHome <- getEncodeRouteHome
|
||||||
|
hashActor <- getHashLocalActor
|
||||||
|
let meR = GroupR groupHash
|
||||||
|
makeItem (role, time, resource, _) = AP.Relationship
|
||||||
|
{ AP.relationshipId = Nothing
|
||||||
|
, AP.relationshipExtraTypes = []
|
||||||
|
, AP.relationshipSubject =
|
||||||
|
case resource of
|
||||||
|
Left (la, _) ->
|
||||||
|
encodeRouteHome $ renderLocalActor $ hashActor la
|
||||||
|
Right (i, ro, _) ->
|
||||||
|
ObjURI (instanceHost i) (remoteObjectIdent ro)
|
||||||
|
, AP.relationshipProperty = Left AP.RelHasRecCollab
|
||||||
|
, AP.relationshipObject = encodeRouteHome meR
|
||||||
|
, AP.relationshipAttributedTo = encodeRouteLocal meR
|
||||||
|
, AP.relationshipPublished = Just time
|
||||||
|
, AP.relationshipUpdated = Nothing
|
||||||
|
, AP.relationshipInstrument = Just role
|
||||||
|
}
|
||||||
|
effortsAP = AP.Collection
|
||||||
|
{ AP.collectionId = encodeRouteLocal $ GroupEffortsR groupHash
|
||||||
|
, AP.collectionType = CollectionTypeUnordered
|
||||||
|
, AP.collectionTotalItems = Just $ length efforts
|
||||||
|
, AP.collectionCurrent = Nothing
|
||||||
|
, AP.collectionFirst = Nothing
|
||||||
|
, AP.collectionLast = Nothing
|
||||||
|
, AP.collectionItems = map (Doc h . makeItem) efforts
|
||||||
|
, AP.collectionContext = Just $ encodeRouteLocal meR
|
||||||
|
}
|
||||||
|
provideHtmlAndAP effortsAP $ redirectToPrettyJSON (GroupEffortsR groupHash)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -3819,6 +3819,16 @@ changes hLocal ctx =
|
||||||
, removeEntity "SquadHolderProject"
|
, removeEntity "SquadHolderProject"
|
||||||
-- 642
|
-- 642
|
||||||
, removeEntity "SquadHolderComponent"
|
, removeEntity "SquadHolderComponent"
|
||||||
|
-- 643
|
||||||
|
, addFieldRefRequiredEmpty "Effort" "topic" "Resource"
|
||||||
|
-- 644
|
||||||
|
, removeEntity "EffortTopicProject"
|
||||||
|
-- 645
|
||||||
|
, removeEntity "EffortTopicComponent"
|
||||||
|
-- 646
|
||||||
|
, addFieldRefRequiredEmpty "EffortTopicLocal" "topic" "Resource"
|
||||||
|
-- 647
|
||||||
|
, removeField "Effort" "topic"
|
||||||
]
|
]
|
||||||
|
|
||||||
migrateDB
|
migrateDB
|
||||||
|
|
|
@ -66,6 +66,8 @@ module Vervis.Persist.Collab
|
||||||
|
|
||||||
, getSquadAdd
|
, getSquadAdd
|
||||||
, getSquadTeam
|
, getSquadTeam
|
||||||
|
|
||||||
|
, getTeamResources
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -1681,3 +1683,80 @@ getSquadTeam squadID =
|
||||||
(getBy $ UniqueSquadTopicRemote squadID)
|
(getBy $ UniqueSquadTopicRemote squadID)
|
||||||
"Found Squad without topic"
|
"Found Squad without topic"
|
||||||
"Found Squad with both local and remote topic"
|
"Found Squad with both local and remote topic"
|
||||||
|
|
||||||
|
getTeamResources
|
||||||
|
:: MonadIO m
|
||||||
|
=> GroupId
|
||||||
|
-> ReaderT SqlBackend m
|
||||||
|
[ ( AP.Role
|
||||||
|
, UTCTime
|
||||||
|
, Either (LocalActorBy Key, Actor) (Instance, RemoteObject, RemoteActor)
|
||||||
|
, EffortId
|
||||||
|
)
|
||||||
|
]
|
||||||
|
getTeamResources groupID =
|
||||||
|
fmap (sortOn $ view _2) $ liftA2 (++)
|
||||||
|
(map (\ (E.Value role, E.Value time, resource, Entity _ actor, E.Value effortID) ->
|
||||||
|
(role, time, Left (resource, actor), effortID)
|
||||||
|
)
|
||||||
|
<$> (do ls <- getLocals
|
||||||
|
for ls $ \ (role, time, E.Value r, E.Value d, E.Value l, E.Value j, actor, effort) -> do
|
||||||
|
resource <-
|
||||||
|
exactlyOneJust
|
||||||
|
[ LocalActorRepo <$> r
|
||||||
|
, LocalActorDeck <$> d
|
||||||
|
, LocalActorLoom <$> l
|
||||||
|
, LocalActorProject <$> j
|
||||||
|
]
|
||||||
|
"EffortTopicLocal: Specific actor not found"
|
||||||
|
"EffortTopicLocal: Multiple specific actors not found"
|
||||||
|
return (role, time, resource, actor, effort)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(map (\ (E.Value role, E.Value time, Entity _ i, Entity _ ro, Entity _ ra, E.Value effortID) ->
|
||||||
|
(role, time, Right (i, ro, ra), effortID)
|
||||||
|
)
|
||||||
|
<$> getRemotes
|
||||||
|
)
|
||||||
|
where
|
||||||
|
getLocals =
|
||||||
|
E.select $ E.from $ \ (effort `E.InnerJoin` topic `E.InnerJoin` resource `E.InnerJoin` actor `E.InnerJoin` deleg `E.InnerJoin` grant `E.LeftOuterJoin` repo `E.LeftOuterJoin` deck `E.LeftOuterJoin` loom `E.LeftOuterJoin` project) -> do
|
||||||
|
E.on $ E.just (resource E.^. ResourceId) E.==. project E.?. ProjectResource
|
||||||
|
E.on $ E.just (resource E.^. ResourceId) E.==. loom E.?. LoomResource
|
||||||
|
E.on $ E.just (resource E.^. ResourceId) E.==. deck E.?. DeckResource
|
||||||
|
E.on $ E.just (resource E.^. ResourceId) E.==. repo E.?. RepoResource
|
||||||
|
E.on $ deleg E.^. EffortUsSendDelegatorGrant E.==. grant E.^. OutboxItemId
|
||||||
|
E.on $ effort E.^. EffortId E.==. deleg E.^. EffortUsSendDelegatorEffort
|
||||||
|
E.on $ resource E.^. ResourceActor E.==. actor E.^. ActorId
|
||||||
|
E.on $ topic E.^. EffortTopicLocalTopic E.==. resource E.^. ResourceId
|
||||||
|
E.on $ effort E.^. EffortId E.==. topic E.^. EffortTopicLocalEffort
|
||||||
|
E.where_ $ effort E.^. EffortHolder E.==. E.val groupID
|
||||||
|
E.orderBy [E.asc $ deleg E.^. EffortUsSendDelegatorId]
|
||||||
|
return
|
||||||
|
( effort E.^. EffortRole
|
||||||
|
, grant E.^. OutboxItemPublished
|
||||||
|
, repo E.?. RepoId
|
||||||
|
, deck E.?. DeckId
|
||||||
|
, loom E.?. LoomId
|
||||||
|
, project E.?. ProjectId
|
||||||
|
, actor
|
||||||
|
, effort E.^. EffortId
|
||||||
|
)
|
||||||
|
getRemotes =
|
||||||
|
E.select $ E.from $ \ (effort `E.InnerJoin` topic `E.InnerJoin` deleg `E.InnerJoin` grant `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i) -> do
|
||||||
|
E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId
|
||||||
|
E.on $ ra E.^. RemoteActorIdent E.==. ro E.^. RemoteObjectId
|
||||||
|
E.on $ topic E.^. EffortTopicRemoteTopic E.==. ra E.^. RemoteActorId
|
||||||
|
E.on $ deleg E.^. EffortUsSendDelegatorGrant E.==. grant E.^. OutboxItemId
|
||||||
|
E.on $ effort E.^. EffortId E.==. deleg E.^. EffortUsSendDelegatorEffort
|
||||||
|
E.on $ effort E.^. EffortId E.==. topic E.^. EffortTopicRemoteEffort
|
||||||
|
E.where_ $ effort E.^. EffortHolder E.==. E.val groupID
|
||||||
|
E.orderBy [E.asc $ deleg E.^. EffortUsSendDelegatorId]
|
||||||
|
return
|
||||||
|
( effort E.^. EffortRole
|
||||||
|
, grant E.^. OutboxItemPublished
|
||||||
|
, i
|
||||||
|
, ro
|
||||||
|
, ra
|
||||||
|
, effort E.^. EffortId
|
||||||
|
)
|
||||||
|
|
|
@ -951,6 +951,7 @@ data Team u = Team
|
||||||
, teamChildren :: LocalURI
|
, teamChildren :: LocalURI
|
||||||
, teamParents :: LocalURI
|
, teamParents :: LocalURI
|
||||||
, teamMembers :: LocalURI
|
, teamMembers :: LocalURI
|
||||||
|
, teamResources :: LocalURI
|
||||||
}
|
}
|
||||||
|
|
||||||
instance ActivityPub Team where
|
instance ActivityPub Team where
|
||||||
|
@ -964,11 +965,13 @@ instance ActivityPub Team where
|
||||||
<$> withAuthorityO h (o .: "subteams")
|
<$> withAuthorityO h (o .: "subteams")
|
||||||
<*> withAuthorityO h (o .: "context")
|
<*> withAuthorityO h (o .: "context")
|
||||||
<*> withAuthorityO h (o .: "members")
|
<*> withAuthorityO h (o .: "members")
|
||||||
toSeries h (Team actor children parents members)
|
<*> withAuthorityO h (o .: "teamResources")
|
||||||
|
toSeries h (Team actor children parents members resources)
|
||||||
= toSeries h actor
|
= toSeries h actor
|
||||||
<> "subteams" .= ObjURI h children
|
<> "subteams" .= ObjURI h children
|
||||||
<> "context" .= ObjURI h parents
|
<> "context" .= ObjURI h parents
|
||||||
<> "members" .= ObjURI h members
|
<> "members" .= ObjURI h members
|
||||||
|
<> "teamResources" .= ObjURI h resources
|
||||||
|
|
||||||
data Audience u = Audience
|
data Audience u = Audience
|
||||||
{ audienceTo :: [ObjURI u]
|
{ audienceTo :: [ObjURI u]
|
||||||
|
|
|
@ -33,6 +33,9 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
<span>
|
<span>
|
||||||
<a href=@{GroupMembersR groupHash}>
|
<a href=@{GroupMembersR groupHash}>
|
||||||
[🤝 Members]
|
[🤝 Members]
|
||||||
|
<span>
|
||||||
|
<a href=@{GroupEffortsR groupHash}>
|
||||||
|
[💼 Projects]
|
||||||
<span>
|
<span>
|
||||||
<a href=@{GroupChildrenR groupHash}>
|
<a href=@{GroupChildrenR groupHash}>
|
||||||
[🐛 Children]
|
[🐛 Children]
|
||||||
|
|
13
th/models
13
th/models
|
@ -1659,21 +1659,10 @@ Effort
|
||||||
|
|
||||||
EffortTopicLocal
|
EffortTopicLocal
|
||||||
effort EffortId
|
effort EffortId
|
||||||
|
topic ResourceId
|
||||||
|
|
||||||
UniqueEffortTopicLocal effort
|
UniqueEffortTopicLocal effort
|
||||||
|
|
||||||
EffortTopicProject
|
|
||||||
topic EffortTopicLocalId
|
|
||||||
project ProjectId
|
|
||||||
|
|
||||||
UniqueEffortTopicProject topic
|
|
||||||
|
|
||||||
EffortTopicComponent
|
|
||||||
topic EffortTopicLocalId
|
|
||||||
component KomponentId
|
|
||||||
|
|
||||||
UniqueEffortTopicComponent topic
|
|
||||||
|
|
||||||
EffortTopicRemote
|
EffortTopicRemote
|
||||||
effort EffortId
|
effort EffortId
|
||||||
topic RemoteActorId
|
topic RemoteActorId
|
||||||
|
|
|
@ -198,6 +198,8 @@
|
||||||
/groups/#GroupKeyHashid/child/approve/#DestId GroupApproveChildR POST
|
/groups/#GroupKeyHashid/child/approve/#DestId GroupApproveChildR POST
|
||||||
/groups/#GroupKeyHashid/parent/approve/#SourceId GroupApproveParentR POST
|
/groups/#GroupKeyHashid/parent/approve/#SourceId GroupApproveParentR POST
|
||||||
|
|
||||||
|
/groups/#GroupKeyHashid/efforts GroupEffortsR GET
|
||||||
|
|
||||||
---- Repo --------------------------------------------------------------------
|
---- Repo --------------------------------------------------------------------
|
||||||
|
|
||||||
/repos/#RepoKeyHashid RepoR GET
|
/repos/#RepoKeyHashid RepoR GET
|
||||||
|
|
Loading…
Reference in a new issue