UI: In my-grants-for-given-resource display, list direct grants as well
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
parent
888a30e989
commit
07d9f9adab
2 changed files with 90 additions and 38 deletions
|
|
@ -960,12 +960,57 @@ getPermitsForResource
|
|||
-> ReaderT SqlBackend m
|
||||
[ ( Either (LocalActorBy Key, OutboxItemId) FedURI
|
||||
, AP.Role
|
||||
, Either
|
||||
(LocalActorBy Key, Actor)
|
||||
(Instance, RemoteObject, RemoteActor)
|
||||
, 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,34 +1041,36 @@ getPermitsForResource personID actor = do
|
|||
, extend E.^. PermitTopicExtendId
|
||||
, extend E.^. PermitTopicExtendRole
|
||||
)
|
||||
for exts $ \ (E.Value permitID, E.Value extendID, E.Value role) -> do
|
||||
sender <-
|
||||
requireEitherAlt
|
||||
(getValBy $ UniquePermitTopicExtendLocal extendID)
|
||||
(getValBy $ UniquePermitTopicExtendRemote extendID)
|
||||
"PermitTopicExtend* neither"
|
||||
"PermitTopicExtend* both"
|
||||
(uExt, via) <-
|
||||
case sender of
|
||||
Left (PermitTopicExtendLocal _ enableID grantID) -> do
|
||||
PermitTopicEnableLocal _ topicID _ <- getJust enableID
|
||||
byk <- getPermitTopicLocal topicID
|
||||
bye <- do
|
||||
m <- getLocalResourceEntity byk
|
||||
case m of
|
||||
Nothing -> error "I just found this PermitTopicLocal in DB but now the specific actor ID isn't found"
|
||||
Just bye -> pure bye
|
||||
Resource aid <- getJust $ localResourceID bye
|
||||
a <- getJust aid
|
||||
let byk' = resourceToActor byk
|
||||
return (Left (byk', grantID), Left (byk', a))
|
||||
Right (PermitTopicExtendRemote _ enableID grantID) -> do
|
||||
PermitTopicEnableRemote _ topicID _ <- getJust enableID
|
||||
PermitTopicRemote _ remoteActorID <- getJust topicID
|
||||
remoteActor <- getJust remoteActorID
|
||||
remoteObject <- getJust $ remoteActorIdent remoteActor
|
||||
inztance <- getJust $ remoteObjectInstance remoteObject
|
||||
grant <- getJust grantID
|
||||
u <- getRemoteActivityURI grant
|
||||
return (Right u, Right (inztance, remoteObject, remoteActor))
|
||||
return (uExt, role, via)
|
||||
extsFinal <-
|
||||
for exts $ \ (E.Value permitID, E.Value extendID, E.Value role) -> do
|
||||
sender <-
|
||||
requireEitherAlt
|
||||
(getValBy $ UniquePermitTopicExtendLocal extendID)
|
||||
(getValBy $ UniquePermitTopicExtendRemote extendID)
|
||||
"PermitTopicExtend* neither"
|
||||
"PermitTopicExtend* both"
|
||||
(uExt, via) <-
|
||||
case sender of
|
||||
Left (PermitTopicExtendLocal _ enableID grantID) -> do
|
||||
PermitTopicEnableLocal _ topicID _ <- getJust enableID
|
||||
byk <- getPermitTopicLocal topicID
|
||||
bye <- do
|
||||
m <- getLocalResourceEntity byk
|
||||
case m of
|
||||
Nothing -> error "I just found this PermitTopicLocal in DB but now the specific actor ID isn't found"
|
||||
Just bye -> pure bye
|
||||
Resource aid <- getJust $ localResourceID bye
|
||||
a <- getJust aid
|
||||
let byk' = resourceToActor byk
|
||||
return (Left (byk', grantID), Left (byk', a))
|
||||
Right (PermitTopicExtendRemote _ enableID grantID) -> do
|
||||
PermitTopicEnableRemote _ topicID _ <- getJust enableID
|
||||
PermitTopicRemote _ remoteActorID <- getJust topicID
|
||||
remoteActor <- getJust remoteActorID
|
||||
remoteObject <- getJust $ remoteActorIdent remoteActor
|
||||
inztance <- getJust $ remoteObjectInstance remoteObject
|
||||
grant <- getJust grantID
|
||||
u <- getRemoteActivityURI grant
|
||||
return (Right u, Right (inztance, remoteObject, remoteActor))
|
||||
return (uExt, role, Just via)
|
||||
return $ directsFinal ++ extsFinal
|
||||
|
|
|
|||
|
|
@ -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} ] #
|
||||
\ via #
|
||||
[ ^{actorLinkFedW via} ]
|
||||
$maybe via <- mvia
|
||||
\ via #
|
||||
[ ^{actorLinkFedW via} ]
|
||||
|]
|
||||
|
|
|
|||
Loading…
Reference in a new issue