forge/Vervis
1
0
Fork 0
Code Pull requests Activity

UI: HomeR: Display personal invites

Browse source
This commit is contained in:
Pere Lev 2023-12-09 08:55:39 +02:00
parent e65563cd19
commit ce1e542401
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
2 changed files with 161 additions and 71 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -137,77 +137,143 @@ getHomeR = do
where where
personalOverview :: Entity Person -> Handler Html personalOverview :: Entity Person -> Handler Html
personalOverview (Entity pid _person) = do personalOverview (Entity pid _person) = do
permits <- runDB $ do (permits, invites) <- runDB $ do
locals <- do permits <- do
ls <- E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do locals <- do
E.on $ topic E.^. PermitTopicLocalId E.==. enable E.^. PermitTopicEnableLocalTopic ls <- E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do
E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicLocalPermit E.on $ topic E.^. PermitTopicLocalId E.==. enable E.^. PermitTopicEnableLocalTopic
E.where_ $ permit E.^. PermitPerson E.==. E.val pid E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicLocalPermit
E.orderBy [E.asc $ enable E.^. PermitTopicEnableLocalId] E.where_ $ permit E.^. PermitPerson E.==. E.val pid
return E.orderBy [E.asc $ enable E.^. PermitTopicEnableLocalId]
( enable E.^. PermitTopicEnableLocalPermit return
, permit E.^. PermitRole ( enable E.^. PermitTopicEnableLocalPermit
, topic E.^. PermitTopicLocalId , permit E.^. PermitRole
) , topic E.^. PermitTopicLocalId
for ls $ \ (E.Value gestureID, E.Value role, E.Value topicID) -> do )
topic <- getPermitTopicLocal topicID for ls $ \ (E.Value gestureID, E.Value role, E.Value topicID) -> do
actorID <- do topic <- getPermitTopicLocal topicID
ma <- getLocalActorEntity topic actorID <- do
case ma of ma <- getLocalActorEntity topic
Nothing -> error "Impossible, we should have found the local actor in DB" case ma of
Just a -> pure $ localActorID a Nothing -> error "Impossible, we should have found the local actor in DB"
actor <- getJust actorID Just a -> pure $ localActorID a
delegator <- getKeyBy $ UniquePermitPersonSendDelegator gestureID actor <- getJust actorID
exts <- delegator <- getKeyBy $ UniquePermitPersonSendDelegator gestureID
case delegator of exts <-
Nothing -> pure [] case delegator of
Just sendID -> do Nothing -> pure []
topicHash <- VR.hashLocalActor topic Just sendID -> do
hashItem <- getEncodeKeyHashid topicHash <- VR.hashLocalActor topic
encodeRouteHome <- getEncodeRouteHome hashItem <- getEncodeKeyHashid
map (encodeRouteHome . activityRoute topicHash . hashItem . permitTopicExtendLocalGrant . entityVal) <$> encodeRouteHome <- getEncodeRouteHome
selectList [PermitTopicExtendLocalPermit ==. sendID] [Asc PermitTopicExtendLocalId] map (encodeRouteHome . activityRoute topicHash . hashItem . permitTopicExtendLocalGrant . entityVal) <$>
return selectList [PermitTopicExtendLocalPermit ==. sendID] [Asc PermitTopicExtendLocalId]
( gestureID return
, role ( gestureID
, delegator , role
, localActorType topic , delegator
, Left (topic, actor) , localActorType topic
, exts , Left (topic, actor)
) , exts
remotes <- do )
rs <- E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do remotes <- do
E.on $ topic E.^. PermitTopicRemoteId E.==. enable E.^. PermitTopicEnableRemoteTopic rs <- E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do
E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicRemotePermit E.on $ topic E.^. PermitTopicRemoteId E.==. enable E.^. PermitTopicEnableRemoteTopic
E.where_ $ permit E.^. PermitPerson E.==. E.val pid E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicRemotePermit
E.orderBy [E.asc $ enable E.^. PermitTopicEnableRemoteId] E.where_ $ permit E.^. PermitPerson E.==. E.val pid
return E.orderBy [E.asc $ enable E.^. PermitTopicEnableRemoteId]
( enable E.^. PermitTopicEnableRemotePermit return
, permit E.^. PermitRole ( enable E.^. PermitTopicEnableRemotePermit
, topic E.^. PermitTopicRemoteActor , permit E.^. PermitRole
) , topic E.^. PermitTopicRemoteActor
for rs $ \ (E.Value gestureID, E.Value role, E.Value remoteActorID) -> do )
remoteActor <- getJust remoteActorID for rs $ \ (E.Value gestureID, E.Value role, E.Value remoteActorID) -> do
remoteObject <- getJust $ remoteActorIdent remoteActor remoteActor <- getJust remoteActorID
inztance <- getJust $ remoteObjectInstance remoteObject remoteObject <- getJust $ remoteActorIdent remoteActor
delegator <- getKeyBy $ UniquePermitPersonSendDelegator gestureID inztance <- getJust $ remoteObjectInstance remoteObject
exts <- delegator <- getKeyBy $ UniquePermitPersonSendDelegator gestureID
case delegator of exts <-
Nothing -> pure [] case delegator of
Just sendID -> do Nothing -> pure []
es <- selectList [PermitTopicExtendRemotePermit ==. sendID] [Asc PermitTopicExtendRemoteId] Just sendID -> do
for es $ \ (Entity _ (PermitTopicExtendRemote _ _ grantID)) -> do es <- selectList [PermitTopicExtendRemotePermit ==. sendID] [Asc PermitTopicExtendRemoteId]
grant <- getJust grantID for es $ \ (Entity _ (PermitTopicExtendRemote _ _ grantID)) -> do
getRemoteActivityURI grant grant <- getJust grantID
return getRemoteActivityURI grant
( gestureID return
, role ( gestureID
, delegator , role
, remoteActorType remoteActor , delegator
, Right (inztance, remoteObject, remoteActor) , remoteActorType remoteActor
, exts , Right (inztance, remoteObject, remoteActor)
) , exts
return $ locals ++ remotes )
return $ locals ++ remotes
invites <- do
locals <- do
ls <- E.select $ E.from $ \ (permit `E.InnerJoin` fulfills `E.InnerJoin` topic `E.LeftOuterJoin` enable `E.LeftOuterJoin` valid `E.LeftOuterJoin` accept) -> do
E.on $ E.just (permit E.^. PermitId) E.==. accept E.?. PermitPersonGesturePermit
E.on $ E.just (topic E.^. PermitTopicLocalId) E.==. valid E.?. PermitTopicAcceptLocalTopic
E.on $ E.just (topic E.^. PermitTopicLocalId) E.==. enable E.?. PermitTopicEnableLocalTopic
E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicLocalPermit
E.on $ permit E.^. PermitId E.==. fulfills E.^. PermitFulfillsInvitePermit
E.where_ $
permit E.^. PermitPerson E.==. E.val pid E.&&.
E.isNothing (enable E.?. PermitTopicEnableLocalId)
E.orderBy [E.asc $ permit E.^. PermitId]
return
( fulfills E.^. PermitFulfillsInviteId
, permit E.^. PermitRole
, valid E.?. PermitTopicAcceptLocalId
, accept E.?. PermitPersonGestureId
, topic E.^. PermitTopicLocalId
)
for ls $ \ (E.Value fulfillsID, E.Value role, E.Value valid, E.Value accept, E.Value topicID) -> do
topic <- getPermitTopicLocal topicID
actorID <- do
ma <- getLocalActorEntity topic
case ma of
Nothing -> error "Impossible, we should have found the local actor in DB"
Just a -> pure $ localActorID a
actor <- getJust actorID
return
( fulfillsID
, role
, () <$ valid
, accept
, Left (topic, actor)
)
remotes <- do
rs <- E.select $ E.from $ \ (permit `E.InnerJoin` fulfills `E.InnerJoin` topic `E.LeftOuterJoin` enable `E.LeftOuterJoin` valid `E.LeftOuterJoin` accept) -> do
E.on $ E.just (permit E.^. PermitId) E.==. accept E.?. PermitPersonGesturePermit
E.on $ E.just (topic E.^. PermitTopicRemoteId) E.==. valid E.?. PermitTopicAcceptRemoteTopic
E.on $ E.just (topic E.^. PermitTopicRemoteId) E.==. enable E.?. PermitTopicEnableRemoteTopic
E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicRemotePermit
E.on $ permit E.^. PermitId E.==. fulfills E.^. PermitFulfillsInvitePermit
E.where_ $
permit E.^. PermitPerson E.==. E.val pid E.&&.
E.isNothing (enable E.?. PermitTopicEnableRemoteId)
E.orderBy [E.asc $ permit E.^. PermitId]
return
( fulfills E.^. PermitFulfillsInviteId
, permit E.^. PermitRole
, valid E.?. PermitTopicAcceptRemoteId
, accept E.?. PermitPersonGestureId
, topic E.^. PermitTopicRemoteActor
)
for rs $ \ (E.Value fulfillsID, E.Value role, E.Value valid, E.Value accept, E.Value remoteActorID) -> do
remoteActor <- getJust remoteActorID
remoteObject <- getJust $ remoteActorIdent remoteActor
inztance <- getJust $ remoteObjectInstance remoteObject
return
( fulfillsID
, role
, () <$ valid
, accept
, Right (inztance, remoteObject, remoteActor)
)
return $ sortOn (view _1) $ locals ++ remotes
return (permits, invites)
let (people, repos, decks, looms, projects, groups, others) = let (people, repos, decks, looms, projects, groups, others) =
partitionByActorType (view _4) (view _1) permits partitionByActorType (view _4) (view _1) permits
if null people if null people
@ -251,6 +317,23 @@ getHomeR = do
#{renderObjURI u} #{renderObjURI u}
|] |]
invite (_fulfillsID, role, valid, accept, actor) =
[whamlet|
<span>
[
#{show role}
] #
$maybe _ <- valid
\ [Valid] #
$nothing
\ [Not validated] #
$maybe _ <- accept
\ [You've accepted] #
$nothing
\ [Accept Button] [Reject Button] #
^{actorLinkFedW actor}
|]
getBrowseR :: Handler Html getBrowseR :: Handler Html
getBrowseR = do getBrowseR = do
(people, groups, repos, decks, looms, projects) <- runDB $ (people, groups, repos, decks, looms, projects) <- runDB $

7
templates/personal-overview.hamlet
View file

@ -105,3 +105,10 @@ $# Comment on a ticket or merge request
$forall i <- others $forall i <- others
<li> <li>
^{item i} ^{item i}
<h2>Your invites
<ul>
$forall i <- invites
<li>
^{invite i}