sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 03:14:53 +09:00
Code Issues Activity

UI: For each Permit, display delegator-Grant and extensions

Browse source
This commit is contained in:
Pere Lev 2023-12-09 07:58:16 +02:00
parent 119779b9b3
commit e65563cd19
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
1 changed files with 48 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

60
src/Vervis/Handler/Client.hs
View file

@ -79,6 +79,7 @@ import Network.FedURI
import Web.Text import Web.Text
import Yesod.ActivityPub import Yesod.ActivityPub
import Yesod.Auth.Unverified import Yesod.Auth.Unverified
import Yesod.FedURI
import Yesod.Hashids import Yesod.Hashids
import Yesod.MonadSite import Yesod.MonadSite
import Yesod.RenderSource import Yesod.RenderSource
@ -108,6 +109,8 @@ import Vervis.Settings
import Vervis.Web.Actor import Vervis.Web.Actor
import Vervis.Widget.Tracker import Vervis.Widget.Tracker
import qualified Vervis.Recipient as VR
-- | Account verification email resend form -- | Account verification email resend form
getResendVerifyEmailR :: Handler Html getResendVerifyEmailR :: Handler Html
getResendVerifyEmailR = do getResendVerifyEmailR = do
@ -142,11 +145,11 @@ getHomeR = do
E.where_ $ permit E.^. PermitPerson E.==. E.val pid E.where_ $ permit E.^. PermitPerson E.==. E.val pid
E.orderBy [E.asc $ enable E.^. PermitTopicEnableLocalId] E.orderBy [E.asc $ enable E.^. PermitTopicEnableLocalId]
return return
( permit E.^. PermitId ( enable E.^. PermitTopicEnableLocalPermit
, permit E.^. PermitRole , permit E.^. PermitRole
, topic E.^. PermitTopicLocalId , topic E.^. PermitTopicLocalId
) )
for ls $ \ (E.Value permitID, E.Value role, E.Value topicID) -> do for ls $ \ (E.Value gestureID, E.Value role, E.Value topicID) -> do
topic <- getPermitTopicLocal topicID topic <- getPermitTopicLocal topicID
actorID <- do actorID <- do
ma <- getLocalActorEntity topic ma <- getLocalActorEntity topic
@ -154,11 +157,23 @@ getHomeR = do
Nothing -> error "Impossible, we should have found the local actor in DB" Nothing -> error "Impossible, we should have found the local actor in DB"
Just a -> pure $ localActorID a Just a -> pure $ localActorID a
actor <- getJust actorID actor <- getJust actorID
delegator <- getKeyBy $ UniquePermitPersonSendDelegator gestureID
exts <-
case delegator of
Nothing -> pure []
Just sendID -> do
topicHash <- VR.hashLocalActor topic
hashItem <- getEncodeKeyHashid
encodeRouteHome <- getEncodeRouteHome
map (encodeRouteHome . activityRoute topicHash . hashItem . permitTopicExtendLocalGrant . entityVal) <$>
selectList [PermitTopicExtendLocalPermit ==. sendID] [Asc PermitTopicExtendLocalId]
return return
( permitID ( gestureID
, role , role
, delegator
, localActorType topic , localActorType topic
, Left (topic, actor) , Left (topic, actor)
, exts
) )
remotes <- do remotes <- do
rs <- E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do rs <- E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do
@ -167,23 +182,34 @@ getHomeR = do
E.where_ $ permit E.^. PermitPerson E.==. E.val pid E.where_ $ permit E.^. PermitPerson E.==. E.val pid
E.orderBy [E.asc $ enable E.^. PermitTopicEnableRemoteId] E.orderBy [E.asc $ enable E.^. PermitTopicEnableRemoteId]
return return
( permit E.^. PermitId ( enable E.^. PermitTopicEnableRemotePermit
, permit E.^. PermitRole , permit E.^. PermitRole
, topic E.^. PermitTopicRemoteActor , topic E.^. PermitTopicRemoteActor
) )
for rs $ \ (E.Value permitID, E.Value role, E.Value remoteActorID) -> do for rs $ \ (E.Value gestureID, E.Value role, E.Value remoteActorID) -> do
remoteActor <- getJust remoteActorID remoteActor <- getJust remoteActorID
remoteObject <- getJust $ remoteActorIdent remoteActor remoteObject <- getJust $ remoteActorIdent remoteActor
inztance <- getJust $ remoteObjectInstance remoteObject inztance <- getJust $ remoteObjectInstance remoteObject
delegator <- getKeyBy $ UniquePermitPersonSendDelegator gestureID
exts <-
case delegator of
Nothing -> pure []
Just sendID -> do
es <- selectList [PermitTopicExtendRemotePermit ==. sendID] [Asc PermitTopicExtendRemoteId]
for es $ \ (Entity _ (PermitTopicExtendRemote _ _ grantID)) -> do
grant <- getJust grantID
getRemoteActivityURI grant
return return
( permitID ( gestureID
, role , role
, delegator
, remoteActorType remoteActor , remoteActorType remoteActor
, Right (inztance, remoteObject, remoteActor) , Right (inztance, remoteObject, remoteActor)
, exts
) )
return $ locals ++ remotes return $ locals ++ remotes
let (people, repos, decks, looms, projects, groups, others) = let (people, repos, decks, looms, projects, groups, others) =
partitionByActorType (view _3) (view _1) permits partitionByActorType (view _4) (view _1) permits
if null people if null people
then pure () then pure ()
else error "Bug: Person as a PermitTopic" else error "Bug: Person as a PermitTopic"
@ -207,12 +233,22 @@ getHomeR = do
x = deleteFirstsBy ((==) `on` key) xs (p ++ r ++ d ++ l ++ j ++ g) x = deleteFirstsBy ((==) `on` key) xs (p ++ r ++ d ++ l ++ j ++ g)
in (p, r, d, l, j, g, x) in (p, r, d, l, j, g, x)
item (_permitID, role, _typ, actor) = item (_permitID, role, deleg, _typ, actor, exts) =
[whamlet| [whamlet|
[ <span>
#{show role} [
] #{show role}
^{actorLinkFedW actor} ] #
$maybe _ <- deleg
\ [D] #
$nothing
\ [_] #
^{actorLinkFedW actor}
<ul>
$forall u <- exts
<li>
<a href="#{renderObjURI u}">
#{renderObjURI u}
|] |]
getBrowseR :: Handler Html getBrowseR :: Handler Html