From ee91a6403e4249391ca01fd61ae9f010b3813e6b Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Sat, 9 Dec 2023 10:24:20 +0200 Subject: [PATCH] UI: Add 'Accept' button to invites you haven't yet accepted --- src/Vervis/Actor/Project.hs | 2 +- src/Vervis/Client.hs | 42 +++++++++++++++++++++++ src/Vervis/Foundation.hs | 3 ++ src/Vervis/Handler/Client.hs | 66 ++++++++++++++++++++++++++++++++---- th/routes | 2 ++ 5 files changed, 108 insertions(+), 7 deletions(-) diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs index a80bdd8..65ea074 100644 --- a/src/Vervis/Actor/Project.hs +++ b/src/Vervis/Actor/Project.hs @@ -295,7 +295,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do case (collab, acceptDB) of (Left (fulfillsID, Left recipID), Left (_, _, acceptID)) -> do maybeAccept <- lift $ insertUnique $ CollabRecipLocalAccept recipID fulfillsID acceptID - unless (isNothing maybeAccept) $ + unless (isJust maybeAccept) $ throwE "This Invite already has an Accept by recip" (Left (fulfillsID, Right recipID), Right (_, _, acceptID)) -> do maybeAccept <- lift $ insertUnique $ CollabRecipRemoteAccept recipID fulfillsID acceptID diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index d1afb26..261c9bd 100644 --- a/src/Vervis/Client.hs +++ b/src/Vervis/Client.hs @@ -43,6 +43,7 @@ module Vervis.Client , remove , inviteComponent , acceptProjectInvite + , acceptPersonalInvite ) where @@ -1410,3 +1411,44 @@ acceptProjectInvite personID component project uInvite = do audience = [audComp, audProject, audAuthor] return (Nothing, audience, activity) + +acceptPersonalInvite + :: PersonId + -> Either (LocalActorBy Key) RemoteActorId + -> FedURI + -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Accept URIMode) +acceptPersonalInvite personID resource uInvite = do + + encodeRouteHome <- getEncodeRouteHome + resource' <- bitraverse VR.hashLocalActor pure resource + + let activity = AP.Accept uInvite Nothing + + -- If resource is remote, get it from DB to determine its followers + -- collection + resourceDB <- + bitraverse + pure + (\ remoteActorID -> lift $ runDB $ do + ra <- getJust remoteActorID + u <- getRemoteActorURI ra + return (ra, u) + ) + resource' + + senderHash <- encodeKeyHashid personID + + let audResource = + case resourceDB of + Left la -> + AudLocal [la] [localActorFollowers la] + Right (remoteActor, ObjURI h lu) -> + AudRemote h + [lu] + (maybeToList $ remoteActorFollowers remoteActor) + audAuthor = + AudLocal [] [LocalStagePersonFollowers senderHash] + + audience = [audResource, audAuthor] + + return (Nothing, audience, activity) diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 0468b93..809aba7 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -160,6 +160,7 @@ type SigKeyKeyHashid = KeyHashid SigKey type ProjectKeyHashid = KeyHashid Project type CollabEnableKeyHashid = KeyHashid CollabEnable type StemKeyHashid = KeyHashid Stem +type PermitFulfillsInviteKeyHashid = KeyHashid PermitFulfillsInvite -- This is where we define all of the routes in our application. For a full -- explanation of the syntax, please see: @@ -856,6 +857,8 @@ instance YesodBreadcrumbs App where PublishRemoveR -> ("Remove someone from a resource", Just HomeR) PublishResolveR -> ("Close a ticket", Just HomeR) + AcceptInviteR _ -> ("", Nothing) + PersonR p -> ("Person ~" <> keyHashidText p, Just HomeR) PersonInboxR p -> ("Inbox", Just $ PersonR p) PersonOutboxR p -> ("Outbox", Just $ PersonR p) diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs index 0c3019a..65c7f09 100644 --- a/src/Vervis/Handler/Client.hs +++ b/src/Vervis/Handler/Client.hs @@ -44,6 +44,8 @@ module Vervis.Handler.Client , getPublishResolveR , postPublishResolveR + + , postAcceptInviteR ) where @@ -59,6 +61,7 @@ import Data.Text (Text) import Data.Time.Clock import Data.Traversable import Database.Persist +import Network.HTTP.Types.Method import Text.Blaze.Html (preEscapedToHtml) import Optics.Core import Yesod.Auth @@ -107,8 +110,10 @@ import Vervis.Persist.Collab import Vervis.Recipient import Vervis.Settings import Vervis.Web.Actor +import Vervis.Widget import Vervis.Widget.Tracker +import qualified Vervis.Client as C import qualified Vervis.Recipient as VR -- | Account verification email resend form @@ -236,11 +241,13 @@ getHomeR = do Nothing -> error "Impossible, we should have found the local actor in DB" Just a -> pure $ localActorID a actor <- getJust actorID + fulfillsHash <- encodeKeyHashid fulfillsID return ( fulfillsID , role , () <$ valid , accept + , fulfillsHash , Left (topic, actor) ) remotes <- do @@ -265,11 +272,13 @@ getHomeR = do remoteActor <- getJust remoteActorID remoteObject <- getJust $ remoteActorIdent remoteActor inztance <- getJust $ remoteObjectInstance remoteObject + fulfillsHash <- encodeKeyHashid fulfillsID return ( fulfillsID , role , () <$ valid , accept + , fulfillsHash , Right (inztance, remoteObject, remoteActor) ) return $ sortOn (view _1) $ locals ++ remotes @@ -299,7 +308,7 @@ getHomeR = do x = deleteFirstsBy ((==) `on` key) xs (p ++ r ++ d ++ l ++ j ++ g) in (p, r, d, l, j, g, x) - item (_permitID, role, deleg, _typ, actor, exts) = + item (_gestureID, role, deleg, _typ, actor, exts) = [whamlet| [ @@ -317,7 +326,7 @@ getHomeR = do #{renderObjURI u} |] - invite (_fulfillsID, role, valid, accept, actor) = + invite (_fulfillsID, role, valid, accept, fulfillsHash, actor) = [whamlet| [ @@ -330,7 +339,8 @@ getHomeR = do $maybe _ <- accept \ [You've accepted] # $nothing - \ [Accept Button] [Reject Button] # + ^{buttonW POST "Accept" (AcceptInviteR fulfillsHash)} + $#\ [Reject Button] # ^{actorLinkFedW actor} |] @@ -1397,9 +1407,6 @@ getPublishInviteR = do postPublishInviteR :: Handler () postPublishInviteR = do - federation <- getsYesod $ appFederation . appSettings - unless federation badMethod - (uRecipient, uResourceCollabs, role, (uCap, cap)) <- runFormPostRedirect PublishInviteR inviteForm @@ -1499,3 +1506,50 @@ postPublishResolveR = do Right _ -> do setMessage "Resolve activity sent" redirect HomeR + +postAcceptInviteR :: KeyHashid PermitFulfillsInvite -> Handler () +postAcceptInviteR fulfillsHash = do + fulfillsID <- decodeKeyHashid404 fulfillsHash + + personEntity@(Entity personID person) <- requireAuth + personHash <- encodeKeyHashid personID + encodeRouteHome <- getEncodeRouteHome + + result <- runExceptT $ do + (uInvite, topic) <- lift $ runDB $ do + PermitFulfillsInvite permitID <- get404 fulfillsID + Permit p _ <- getJust permitID + unless (p == personID) notFound + uInvite <- do + i <- + requireEitherAlt + (getValBy $ UniquePermitTopicGestureLocal fulfillsID) + (getValBy $ UniquePermitTopicGestureRemote fulfillsID) + "Invite not found" + "Multiple invites" + case i of + Left (PermitTopicGestureLocal _ inviteID) -> do + outboxID <- outboxItemOutbox <$> getJust inviteID + actorID <- getKeyByJust $ UniqueActorOutbox outboxID + actor <- getLocalActor actorID + actorHash <- VR.hashLocalActor actor + inviteHash <- encodeKeyHashid inviteID + return $ encodeRouteHome $ + activityRoute actorHash inviteHash + Right (PermitTopicGestureRemote _ _ inviteID) -> do + invite <- getJust inviteID + getRemoteActivityURI invite + topic <- bimap snd snd <$> getPermitTopic permitID + return (uInvite, topic) + (maybeSummary, audience, accept) <- + C.acceptPersonalInvite personID topic uInvite + (localRecips, remoteRecips, fwdHosts, action) <- + C.makeServerInput Nothing maybeSummary audience $ + AP.AcceptActivity accept + handleViaActor + personID Nothing localRecips remoteRecips fwdHosts action + + case result of + Left e -> setMessage $ toHtml e + Right _acceptID -> setMessage "Accept sent" + redirect HomeR diff --git a/th/routes b/th/routes index 2f1cebe..c305a95 100644 --- a/th/routes +++ b/th/routes @@ -136,6 +136,8 @@ /publish/remove PublishRemoveR GET POST /publish/resolve PublishResolveR GET POST +/accept-invite/#PermitFulfillsInviteKeyHashid AcceptInviteR POST + ---- Person ------------------------------------------------------------------ /people/#PersonKeyHashid PersonR GET