diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs
index 71cfa34..0c3019a 100644
--- a/src/Vervis/Handler/Client.hs
+++ b/src/Vervis/Handler/Client.hs
@@ -137,77 +137,143 @@ getHomeR = do
where
personalOverview :: Entity Person -> Handler Html
personalOverview (Entity pid _person) = do
- permits <- runDB $ do
- locals <- do
- ls <- 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 pid
- E.orderBy [E.asc $ enable E.^. PermitTopicEnableLocalId]
- return
- ( enable E.^. PermitTopicEnableLocalPermit
- , permit E.^. PermitRole
- , topic E.^. PermitTopicLocalId
- )
- for ls $ \ (E.Value gestureID, E.Value role, 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
- 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
- ( gestureID
- , role
- , delegator
- , localActorType topic
- , Left (topic, actor)
- , exts
- )
- remotes <- do
- rs <- 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 pid
- E.orderBy [E.asc $ enable E.^. PermitTopicEnableRemoteId]
- return
- ( enable E.^. PermitTopicEnableRemotePermit
- , permit E.^. PermitRole
- , topic E.^. PermitTopicRemoteActor
- )
- for rs $ \ (E.Value gestureID, E.Value role, E.Value remoteActorID) -> do
- remoteActor <- getJust remoteActorID
- remoteObject <- getJust $ remoteActorIdent remoteActor
- 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
- ( gestureID
- , role
- , delegator
- , remoteActorType remoteActor
- , Right (inztance, remoteObject, remoteActor)
- , exts
- )
- return $ locals ++ remotes
+ (permits, invites) <- runDB $ do
+ permits <- do
+ locals <- do
+ ls <- 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 pid
+ E.orderBy [E.asc $ enable E.^. PermitTopicEnableLocalId]
+ return
+ ( enable E.^. PermitTopicEnableLocalPermit
+ , permit E.^. PermitRole
+ , topic E.^. PermitTopicLocalId
+ )
+ for ls $ \ (E.Value gestureID, E.Value role, 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
+ 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
+ ( gestureID
+ , role
+ , delegator
+ , localActorType topic
+ , Left (topic, actor)
+ , exts
+ )
+ remotes <- do
+ rs <- 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 pid
+ E.orderBy [E.asc $ enable E.^. PermitTopicEnableRemoteId]
+ return
+ ( enable E.^. PermitTopicEnableRemotePermit
+ , permit E.^. PermitRole
+ , topic E.^. PermitTopicRemoteActor
+ )
+ for rs $ \ (E.Value gestureID, E.Value role, E.Value remoteActorID) -> do
+ remoteActor <- getJust remoteActorID
+ remoteObject <- getJust $ remoteActorIdent remoteActor
+ 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
+ ( gestureID
+ , role
+ , delegator
+ , remoteActorType remoteActor
+ , Right (inztance, remoteObject, remoteActor)
+ , exts
+ )
+ 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) =
partitionByActorType (view _4) (view _1) permits
if null people
@@ -251,6 +317,23 @@ getHomeR = do
#{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 = do
(people, groups, repos, decks, looms, projects) <- runDB $
diff --git a/templates/personal-overview.hamlet b/templates/personal-overview.hamlet
index 7cbc5fb..dd73cc0 100644
--- a/templates/personal-overview.hamlet
+++ b/templates/personal-overview.hamlet
@@ -105,3 +105,10 @@ $# Comment on a ticket or merge request
$forall i <- others
<li>
^{item i}
+
+<h2>Your invites
+
+<ul>
+ $forall i <- invites
+ <li>
+ ^{invite i}