From b4ebd08c5ab7d272b304a4ede517c2b566658c77 Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Mon, 5 Jun 2023 11:34:58 +0300 Subject: [PATCH] Person: Port Undo{Follow} handler --- src/Vervis/Actor/Person.hs | 102 ++++++++++++++++++++++- src/Vervis/Federation/Offer.hs | 144 +-------------------------------- 2 files changed, 100 insertions(+), 146 deletions(-) diff --git a/src/Vervis/Actor/Person.hs b/src/Vervis/Actor/Person.hs index 5557a21..03dc16a 100644 --- a/src/Vervis/Actor/Person.hs +++ b/src/Vervis/Actor/Person.hs @@ -29,6 +29,7 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader +import Data.Bifunctor import Data.Bitraversable import Data.ByteString (ByteString) import Data.Foldable @@ -217,6 +218,101 @@ personFollow now recipPersonID author body mfwd luFollow follow = do (\ () -> pure []) now recipPersonID author body mfwd luFollow follow +-- Meaning: A remote actor is undoing some previous action +-- Behavior: +-- * Insert to my inbox +-- * If they're undoing their Following of me: +-- * Record it in my DB +-- * Publish and send an Accept only to the sender +personUndo + :: UTCTime + -> PersonId + -> RemoteAuthor + -> ActivityBody + -> Maybe (RecipientRoutes, ByteString) + -> LocalURI + -> AP.Undo URIMode + -> ActE (Text, Act (), Next) +personUndo now recipPersonID author body _mfwd luUndo (AP.Undo uObject) = do + + -- Check input + undone <- + first (\ (actor, _, item) -> (actor, item)) <$> + parseActivityURI' uObject + + maybeUndo <- withDBExcept $ do + + -- Grab recipient person from DB + (personRecip, actorRecip) <- lift $ do + p <- getJust recipPersonID + (p,) <$> getJust (personActor p) + + -- Insert the Undo to person's inbox + mractid <- lift $ insertToInbox now author body (actorInbox actorRecip) luUndo False + for mractid $ \ undoID -> do + + maybeUndo <- runMaybeT $ do + + -- Find the undone activity in our DB + undoneDB <- MaybeT $ getActivity undone + + let followers = actorFollowers actorRecip + tryUnfollow followers undoneDB + + for maybeUndo $ \ () -> do + + -- Prepare an Accept activity and insert to person's outbox + acceptID <- lift $ insertEmptyOutboxItem' (actorOutbox actorRecip) now + accept@(actionAccept, _, _, _) <- lift $ lift prepareAccept + _luAccept <- lift $ updateOutboxItem' (LocalActorPerson recipPersonID) acceptID actionAccept + + return (personActor personRecip, acceptID, accept) + + case maybeUndo of + Nothing -> done "I already have this activity in my inbox" + Just Nothing -> done "Unrelated to me, just inserted to inbox" + Just (Just (actorID, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept))) -> do + lift $ sendActivity + (LocalActorPerson recipPersonID) actorID localRecipsAccept + remoteRecipsAccept fwdHostsAccept acceptID + EventAcceptRemoteFollow actionAccept + done "Undid the Follow and published Accept" + + where + + tryUnfollow _ (Left _) = mzero + tryUnfollow personFollowersID (Right remoteActivityID) = do + Entity remoteFollowID remoteFollow <- + MaybeT $ lift $ getBy $ UniqueRemoteFollowFollow remoteActivityID + let followerID = remoteFollowActor remoteFollow + followerSetID = remoteFollowTarget remoteFollow + guard $ followerSetID == personFollowersID + unless (followerID == remoteAuthorId author) $ + lift $ throwE "You're trying to Undo someone else's Follow" + lift $ lift $ delete remoteFollowID + + prepareAccept = do + encodeRouteHome <- getEncodeRouteHome + + let ObjURI hAuthor luAuthor = remoteAuthorURI author + audSender = AudRemote hAuthor [luAuthor] [] + (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = + collectAudience [audSender] + + recips = map encodeRouteHome audLocal ++ audRemote + action = AP.Action + { AP.actionCapability = Nothing + , AP.actionSummary = Nothing + , AP.actionAudience = AP.Audience recips [] [] [] [] [] + , AP.actionFulfills = [] + , AP.actionSpecific = AP.AcceptActivity AP.Accept + { AP.acceptObject = ObjURI hAuthor luUndo + , AP.acceptResult = Nothing + } + } + + return (action, recipientSet, remoteActors, fwdHosts) + -- Meaning: A remote actor accepted something -- Behavior: -- * Insert to my inbox @@ -620,10 +716,8 @@ personBehavior now personID (Right (VerseRemote author body mfwd luActivity)) = personInvite now personID author body mfwd luActivity invite AP.JoinActivity join -> personJoin now personID author body mfwd luActivity join - {- - AP.UndoActivity undo -> - (,Nothing) <$> personUndoA now personID author body mfwd luActivity undo - -} AP.RejectActivity reject -> personReject now personID author body mfwd luActivity reject + AP.UndoActivity undo -> + personUndo now personID author body mfwd luActivity undo _ -> throwE "Unsupported activity type for Person" diff --git a/src/Vervis/Federation/Offer.hs b/src/Vervis/Federation/Offer.hs index 1b158b6..6c23e41 100644 --- a/src/Vervis/Federation/Offer.hs +++ b/src/Vervis/Federation/Offer.hs @@ -25,8 +25,8 @@ module Vervis.Federation.Offer --, loomFollowF --, repoFollowF - personUndoF - , deckUndoF + --personUndoF + deckUndoF , loomUndoF , repoUndoF ) @@ -550,146 +550,6 @@ repoFollowF now recipRepoHash = recipRepoHash -} -personUndoF - :: UTCTime - -> KeyHashid Person - -> RemoteAuthor - -> ActivityBody - -> Maybe (RecipientRoutes, ByteString) - -> LocalURI - -> AP.Undo URIMode - -> ExceptT Text Handler Text -personUndoF now recipPersonHash author body mfwd luUndo (AP.Undo uObject) = do - - -- Check input - recipPersonID <- decodeKeyHashid404 recipPersonHash - undone <- - first (\ (actor, _, item) -> (actor, item)) <$> - parseActivityURI uObject - - -- Verify the capability URI, if provided, is one of: - -- * Outbox item URI of a local actor, i.e. a local activity - -- * A remote URI - maybeCapability <- - for (AP.activityCapability $ actbActivity body) $ \ uCap -> - nameExceptT "Undo capability" $ - first (\ (actor, _, item) -> (actor, item)) <$> - parseActivityURI uCap - - maybeHttp <- runDBExcept $ do - - -- Find recipient person in DB, returning 404 if doesn't exist because we're - -- in the person's inbox post handler - (recipPersonActorID, recipPersonActor) <- lift $ do - person <- get404 recipPersonID - let actorID = personActor person - (actorID,) <$> getJust actorID - - -- Insert the Undo to person's inbox - mractid <- lift $ insertToInbox now author body (actorInbox recipPersonActor) luUndo False - for mractid $ \ undoID -> do - - maybeUndo <- runMaybeT $ do - - -- Find the undone activity in our DB - undoneDB <- MaybeT $ getActivity undone - - let followers = actorFollowers recipPersonActor - MaybeT $ lift $ runMaybeT $ tryUnfollow followers undoneDB - - for maybeUndo $ \ (remoteFollowID, followerID) -> do - - (sieve, acceptAudience) <- do - (audSenderOnly, _audSenderAndFollowers) <- do - ra <- lift $ getJust $ remoteAuthorId author - let ObjURI hAuthor luAuthor = remoteAuthorURI author - return - ( AudRemote hAuthor [luAuthor] [] - , AudRemote hAuthor - [luAuthor] - (maybeToList $ remoteActorFollowers ra) - ) - unless (followerID == remoteAuthorId author) $ - throwE "Trying to undo someone else's Follow" - lift $ delete remoteFollowID - return - ( makeRecipientSet [] [] - , [audSenderOnly] - ) - - -- Forward the Undo activity to relevant local stages, and - -- schedule delivery for unavailable remote members of them - maybeHttpFwdUndo <- lift $ for mfwd $ \ (localRecips, sig) -> - forwardActivityDB - (actbBL body) localRecips sig recipPersonActorID - (LocalActorPerson recipPersonHash) sieve undoID - - - -- Prepare an Accept activity and insert to person's outbox - acceptID <- lift $ insertEmptyOutboxItem (actorOutbox recipPersonActor) now - (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <- - lift . lift $ prepareAccept acceptAudience - _luAccept <- lift $ updateOutboxItem (LocalActorPerson recipPersonID) acceptID actionAccept - - -- Deliver the Accept to local recipients, and schedule delivery - -- for unavailable remote recipients - deliverHttpAccept <- - deliverActivityDB - (LocalActorPerson recipPersonHash) recipPersonActorID - localRecipsAccept remoteRecipsAccept fwdHostsAccept - acceptID actionAccept - - -- Return instructions for HTTP inbox-forwarding of the Undo - -- activity, and for HTTP delivery of the Accept activity to - -- remote recipients - return (maybeHttpFwdUndo, deliverHttpAccept) - - -- Launch asynchronous HTTP forwarding of the Undo activity and HTTP - -- delivery of the Accept activity - case maybeHttp of - Nothing -> return "I already have this activity in my inbox, doing nothing" - Just Nothing -> return "Unrelated to me, just inserted to inbox" - Just (Just (maybeHttpFwdUndo, deliverHttpAccept)) -> do - forkWorker "personUndoF Accept HTTP delivery" deliverHttpAccept - case maybeHttpFwdUndo of - Nothing -> return "Undid, no inbox-forwarding to do" - Just forwardHttpUndo -> do - forkWorker "personUndoF inbox-forwarding" forwardHttpUndo - return "Undid and ran inbox-forwarding of the Undo" - - where - - tryUnfollow _ (Left _) = mzero - tryUnfollow personFollowersID (Right remoteActivityID) = do - Entity remoteFollowID remoteFollow <- - MaybeT $ getBy $ UniqueRemoteFollowFollow remoteActivityID - let followerID = remoteFollowActor remoteFollow - followerSetID = remoteFollowTarget remoteFollow - guard $ followerSetID == personFollowersID - return (remoteFollowID, followerID) - - prepareAccept audience = do - encodeRouteHome <- getEncodeRouteHome - - let ObjURI hAuthor _ = remoteAuthorURI author - - (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = - collectAudience audience - - recips = map encodeRouteHome audLocal ++ audRemote - action = AP.Action - { AP.actionCapability = Nothing - , AP.actionSummary = Nothing - , AP.actionAudience = AP.Audience recips [] [] [] [] [] - , AP.actionFulfills = [] - , AP.actionSpecific = AP.AcceptActivity AP.Accept - { AP.acceptObject = ObjURI hAuthor luUndo - , AP.acceptResult = Nothing - } - } - - return (action, recipientSet, remoteActors, fwdHosts) - deckUndoF :: UTCTime -> KeyHashid Deck