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

src/Vervis/Handler/Client.hs

@@ -79,6 +79,7 @@ import Network.FedURI
 import Web.Text
 import Yesod.ActivityPub
 import Yesod.Auth.Unverified
+import Yesod.FedURI
 import Yesod.Hashids
 import Yesod.MonadSite
 import Yesod.RenderSource
@@ -108,6 +109,8 @@ import Vervis.Settings
 import Vervis.Web.Actor
 import Vervis.Widget.Tracker
 
+import qualified Vervis.Recipient as VR
+
 -- | Account verification email resend form
 getResendVerifyEmailR :: Handler Html
 getResendVerifyEmailR = do
@@ -142,11 +145,11 @@ getHomeR = do
                     E.where_ $ permit E.^. PermitPerson E.==. E.val pid
                     E.orderBy [E.asc $ enable E.^. PermitTopicEnableLocalId]
                     return
-                        ( permit E.^. PermitId
+                        ( enable E.^. PermitTopicEnableLocalPermit
                         , permit E.^. PermitRole
                         , 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
                     actorID <- do
                         ma <- getLocalActorEntity topic
@@ -154,11 +157,23 @@ getHomeR = do
                             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
-                        ( permitID
+                        ( gestureID
                         , role
+                        , delegator
                         , localActorType topic
                         , Left (topic, actor)
+                        , exts
                         )
             remotes <- 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.orderBy [E.asc $ enable E.^. PermitTopicEnableRemoteId]
                     return
-                        ( permit E.^. PermitId
+                        ( enable E.^. PermitTopicEnableRemotePermit
                         , permit E.^. PermitRole
                         , 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
                     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
-                        ( permitID
+                        ( gestureID
                         , role
+                        , delegator
                         , remoteActorType remoteActor
                         , Right (inztance, remoteObject, remoteActor)
+                        , exts
                         )
             return $ locals ++ remotes
         let (people, repos, decks, looms, projects, groups, others) =
-                partitionByActorType (view _3) (view _1) permits
+                partitionByActorType (view _4) (view _1) permits
         if null people
             then pure ()
             else error "Bug: Person as a PermitTopic"
@@ -207,12 +233,22 @@ getHomeR = do
                 x = deleteFirstsBy ((==) `on` key) xs (p ++ r ++ d ++ l ++ j ++ g)
             in  (p, r, d, l, j, g, x)
 
-        item (_permitID, role, _typ, actor) =
+        item (_permitID, role, deleg, _typ, actor, exts) =
             [whamlet|
+                <span>
                   [
                   #{show role}
-                ]
+                  ] #
+                  $maybe _ <- deleg
+                    \ [D] #
+                  $nothing
+                    \ [_] #
                   ^{actorLinkFedW actor}
+                <ul>
+                  $forall u <- exts
+                    <li>
+                      <a href="#{renderObjURI u}">
+                        #{renderObjURI u}
             |]
 
 getBrowseR :: Handler Html