UI: HomeR: Display personal invites
This commit is contained in:
Pere Lev
parent
e65563cd19
commit
ce1e542401
2 changed files with 161 additions and 71 deletions
|
|
@ -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 $
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
|
|
|||
Loading…
Reference in a new issue