From dae57c394da2f74101703a3af423a29403c93a3c Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Sat, 13 Apr 2024 15:34:26 +0300 Subject: [PATCH] UI: Personal Overview: Display info of received permits, not just the Grant URI --- src/Vervis/Data/Actor.hs | 28 +++++++++++++++-- src/Vervis/Handler/Client.hs | 59 +++++++++++++++++++++++++++++++----- src/Vervis/Persist/Actor.hs | 21 +++++++++++-- src/Vervis/Persist/Collab.hs | 5 +-- 4 files changed, 99 insertions(+), 14 deletions(-) diff --git a/src/Vervis/Data/Actor.hs b/src/Vervis/Data/Actor.hs index 1184435..8d7586e 100644 --- a/src/Vervis/Data/Actor.hs +++ b/src/Vervis/Data/Actor.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2022, 2023 by fr33domlover . + - Written in 2022, 2023, 2024 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -26,6 +26,8 @@ module Vervis.Data.Actor , parseFedURIOld , parseLocalActorE , parseLocalActorE' + , parseActorURI + , parseActorURI' ) where @@ -35,6 +37,7 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Logger.CallStack import Control.Monad.Trans.Except +import Data.Bitraversable import Data.Text (Text) import Database.Persist.Types import UnliftIO.Exception (try, SomeException, displayException) @@ -186,7 +189,9 @@ parseFedURIOld u@(ObjURI h lu) = do then Left <$> parseLocalURI lu else pure $ Right u -parseLocalActorE :: Route App -> ExceptT Text Handler (LocalActorBy Key) +parseLocalActorE + :: (MonadSite m, YesodHashids (SiteEnv m)) + => Route App -> ExceptT Text m (LocalActorBy Key) parseLocalActorE route = do actorByHash <- fromMaybeE (parseLocalActor route) "Not an actor route" unhashLocalActorE actorByHash "Invalid actor keyhashid" @@ -195,3 +200,22 @@ parseLocalActorE' :: Route App -> VA.ActE (LocalActorBy Key) parseLocalActorE' route = do actorByHash <- fromMaybeE (parseLocalActor route) "Not an actor route" VA.unhashLocalActorE actorByHash "Invalid actor keyhashid" + +parseActorURI + :: (MonadSite m, SiteEnv m ~ App) + => FedURI + -> ExceptT Text m (Either (LocalActorBy Key) FedURI) +parseActorURI u = do + routeOrRemote <- parseFedURIOld u + bitraverse + parseLocalActorE + pure + routeOrRemote + +parseActorURI' :: FedURI -> VA.ActE (Either (LocalActorBy Key) FedURI) +parseActorURI' u = do + routeOrRemote <- parseFedURI u + bitraverse + parseLocalActorE' + pure + routeOrRemote diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs index e614341..5fe9b92 100644 --- a/src/Vervis/Handler/Client.hs +++ b/src/Vervis/Handler/Client.hs @@ -145,7 +145,30 @@ getHomeR = do case mp of Just p -> personalOverview p Nothing -> redirect BrowseR + where + + getExtInfo extID = do + (_doc, g) <- getGrantActivityBody extID + topicE <- runExceptT $ do + a <- parseActorURI $ AP.grantContext g + bitraverse + (\ byK -> do + byE <- getLocalActorEntityE byK "No such local actor in DB" + actor <- lift $ getJust $ localActorID byE + return (byK, actor) + ) + (\ u -> + over _3 entityVal <$> + getRemoteActorE u "No such RemoteActor in DB" + ) + a + return + ( AP.grantObject g + , topicE + , AP.grantContext g + ) + personalOverview :: Entity Person -> Handler Html personalOverview (Entity pid _person) = do (permits, invites) <- runDB $ do @@ -161,6 +184,7 @@ getHomeR = do , permit E.^. PermitRole , topic E.^. PermitTopicLocalId ) + encodeRouteHome <- getEncodeRouteHome for ls $ \ (E.Value gestureID, E.Value role, E.Value topicID) -> do topic <- getPermitTopicLocal topicID actorID <- do @@ -176,9 +200,15 @@ getHomeR = do Just sendID -> do topicHash <- VR.hashLocalActor topic hashItem <- getEncodeKeyHashid - encodeRouteHome <- getEncodeRouteHome - map (encodeRouteHome . activityRoute topicHash . hashItem . permitTopicExtendLocalGrant . entityVal) <$> - selectList [PermitTopicExtendLocalPermit ==. sendID] [Asc PermitTopicExtendLocalId] + extIDs <- + map (permitTopicExtendLocalGrant . entityVal) <$> + selectList [PermitTopicExtendLocalPermit ==. sendID] [Asc PermitTopicExtendLocalId] + for extIDs $ \ extID -> do + info <- getExtInfo $ Left extID + return + ( encodeRouteHome $ activityRoute topicHash $ hashItem extID + , info + ) return ( gestureID , role @@ -208,9 +238,11 @@ getHomeR = do Nothing -> pure [] Just sendID -> do es <- selectList [PermitTopicExtendRemotePermit ==. sendID] [Asc PermitTopicExtendRemoteId] - for es $ \ (Entity _ (PermitTopicExtendRemote _ _ grantID)) -> do - grant <- getJust grantID - getRemoteActivityURI grant + for es $ \ (Entity _ (PermitTopicExtendRemote _ _ extID)) -> do + ext <- getJust extID + u <- getRemoteActivityURI ext + info <- getExtInfo $ Right extID + return (u, info) return ( gestureID , role @@ -326,10 +358,21 @@ getHomeR = do \ [_] # ^{actorLinkFedW actor}