forge/Vervis
1
0
Fork 0
Code Pull requests Activity

UI: In my-grants-for-given-resource display, list direct grants as well

Browse source 
Previously, only extensions were being displayed. Adding direct grants
required DB schema changes, which the previous huge commit did.
This commit is contained in:
Pere Lev 2024-04-26 03:00:59 +03:00
parent 888a30e989
commit 07d9f9adab
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
2 changed files with 90 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

51
src/Vervis/Persist/Collab.hs
View file

@ -960,12 +960,57 @@ getPermitsForResource
-> ReaderT SqlBackend m
[ ( Either (LocalActorBy Key, OutboxItemId) FedURI
, AP.Role
, Either
, Maybe
(Either
(LocalActorBy Key, Actor)
(Instance, RemoteObject, RemoteActor)
)
)
]
getPermitsForResource personID actor = do
direct <-
bitraverse
(\ resourceID ->
fmap (resourceID,) $
E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do
E.on $ topic E.^. PermitTopicLocalId E.==. enable E.^. PermitTopicEnableLocalTopic
E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicLocalPermit
E.where_ $
permit E.^. PermitPerson E.==. E.val personID E.&&.
topic E.^. PermitTopicLocalTopic E.==. E.val resourceID
return
( permit E.^. PermitRole
, enable E.^. PermitTopicEnableLocalGrant
)
)
(\ actorID ->
E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do
E.on $ topic E.^. PermitTopicRemoteId E.==. enable E.^. PermitTopicEnableRemoteTopic
E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicRemotePermit
E.where_ $
permit E.^. PermitPerson E.==. E.val personID E.&&.
topic E.^. PermitTopicRemoteActor E.==. E.val actorID
return
( permit E.^. PermitRole
, enable E.^. PermitTopicEnableRemoteGrant
)
)
actor
directsFinal <-
case direct of
Left (resourceID, ds) -> do
lr <- getLocalResource resourceID
let la = resourceToActor lr
return $
map
(\ (E.Value role, E.Value grantID) ->
(Left (la, grantID), role, Nothing)
)
ds
Right ds -> for ds $ \ (E.Value role, E.Value grantID) -> do
grant <- getJust grantID
u <- getRemoteActivityURI grant
return (Right u, role, Nothing)
exts <-
case actor of
Left resourceID ->
@ -996,6 +1041,7 @@ getPermitsForResource personID actor = do
, extend E.^. PermitTopicExtendId
, extend E.^. PermitTopicExtendRole
)
extsFinal <-
for exts $ \ (E.Value permitID, E.Value extendID, E.Value role) -> do
sender <-
requireEitherAlt
@ -1026,4 +1072,5 @@ getPermitsForResource personID actor = do
grant <- getJust grantID
u <- getRemoteActivityURI grant
return (Right u, Right (inztance, remoteObject, remoteActor))
return (uExt, role, via)
return (uExt, role, Just via)
return $ directsFinal ++ extsFinal

9
src/Vervis/Widget/Tracker.hs
View file

@ -182,7 +182,11 @@ actorLinkFedW (Right (inztance, object, actor)) =
personPermitsForResourceW
:: [ ( Either (LocalActorBy Key, OutboxItemId) FedURI
, AP.Role
, Either (LocalActorBy Key, Actor) (Instance, RemoteObject, RemoteActor)
, Maybe
(Either
(LocalActorBy Key, Actor)
(Instance, RemoteObject, RemoteActor)
)
)
]
-> Widget
@ -194,7 +198,7 @@ personPermitsForResourceW permits = do
[whamlet|
<h3>My access
<ul>
$forall (u, role, via) <- permits
$forall (u, role, mvia) <- permits
<li>
$case u
$of Left (la, i)
@ -204,6 +208,7 @@ personPermitsForResourceW permits = do
<a href="#{renderObjURI u'}">
Grant
[ #{show role} ] #
$maybe via <- mvia
\ via #
[ ^{actorLinkFedW via} ]
|]