From 59e99f405adc862d253e7da819cadeaf29b380c7 Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Fri, 9 Jun 2023 09:40:10 +0300 Subject: [PATCH] Deck: Port Join handler --- src/Vervis/Actor.hs | 3 ++ src/Vervis/Actor/Common.hs | 83 +++++++++++++++++++++++++++++++ src/Vervis/Actor/Deck.hs | 23 ++++++++- src/Vervis/Actor/Person.hs | 13 +++++ src/Vervis/Federation/Collab.hs | 87 ++------------------------------- 5 files changed, 125 insertions(+), 84 deletions(-) diff --git a/src/Vervis/Actor.hs b/src/Vervis/Actor.hs index 75b37bd..e308629 100644 --- a/src/Vervis/Actor.hs +++ b/src/Vervis/Actor.hs @@ -335,6 +335,9 @@ data Event -- ^ An authorized remote actor sent an Invite-to-a-local-topic, and the -- local topic is forwarding the Invite to me because I'm following the -- topic + | EventRemoteJoinLocalTopicFwdToFollower RemoteActivityId + -- ^ A remote actor asked to Join a local topic, and the local topic is + -- forwarding the Join to me because I'm following the topic | EventUnknown deriving Show diff --git a/src/Vervis/Actor/Common.hs b/src/Vervis/Actor/Common.hs index b846dc5..616ea4d 100644 --- a/src/Vervis/Actor/Common.hs +++ b/src/Vervis/Actor/Common.hs @@ -20,6 +20,7 @@ module Vervis.Actor.Common , topicAccept , topicReject , topicInvite + , topicJoin ) where @@ -821,3 +822,85 @@ topicInvite grabActor topicResource topicField topicCollabField collabTopicCtor insert_ $ CollabRecipLocal collabID personID Right remoteActorID -> insert_ $ CollabRecipRemote collabID remoteActorID + +topicJoin + :: ( PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic + , PersistRecordBackend ct SqlBackend + ) + => (topic -> ActorId) + -> (forall f. f topic -> GrantResourceBy f) + -> EntityField ct (Key topic) + -> EntityField ct CollabId + -> (CollabId -> Key topic -> ct) + -> UTCTime + -> Key topic + -> RemoteAuthor + -> ActivityBody + -> Maybe (RecipientRoutes, ByteString) + -> LocalURI + -> AP.Join URIMode + -> ActE (Text, Act (), Next) +topicJoin grabActor topicResource topicField topicCollabField collabTopicCtor now topicKey author body mfwd luJoin join = do + + -- Check input + resource <- parseJoin join + unless (resource == Left (topicResource topicKey)) $ + throwE "Join's object isn't me, don't need this Join" + + maybeNew <- withDBExcept $ do + + -- Grab topic from DB + (topicActorID, topicActor) <- lift $ do + recip <- getJust topicKey + let actorID = grabActor recip + (actorID,) <$> getJust actorID + + -- Verify that target doesn't already have a Collab for me + existingCollabIDs <- lift $ do + let targetID = remoteAuthorId author + E.select $ E.from $ \ (topic `E.InnerJoin` recipr) -> do + E.on $ + topic E.^. topicCollabField E.==. + recipr E.^. CollabRecipRemoteCollab + E.where_ $ + topic E.^. topicField E.==. E.val topicKey E.&&. + recipr E.^. CollabRecipRemoteActor E.==. E.val targetID + return $ recipr E.^. CollabRecipRemoteCollab + case existingCollabIDs of + [] -> pure () + [_] -> throwE "I already have a Collab for the target" + _ -> error "Multiple collabs found for target" + + mractid <- lift $ insertToInbox now author body (actorInbox topicActor) luJoin False + lift $ for mractid $ \ joinID -> do + + -- Insert Collab record to DB + insertCollab joinID + + -- Prepare forwarding Join to my followers + sieve <- do + topicHash <- encodeKeyHashid topicKey + let topicByHash = + grantResourceLocalActor $ topicResource topicHash + return $ makeRecipientSet [] [localActorFollowers topicByHash] + return (topicActorID, joinID, sieve) + + case maybeNew of + Nothing -> done "I already have this activity in my inbox" + Just (topicActorID, joinID, sieve) -> do + let topicByID = grantResourceLocalActor $ topicResource topicKey + lift $ for_ mfwd $ \ (localRecips, sig) -> do + forwardActivity + (actbBL body) localRecips sig topicActorID topicByID sieve + (EventRemoteJoinLocalTopicFwdToFollower joinID) + done "Recorded and forwarded the Join" + + where + + insertCollab joinID = do + collabID <- insert Collab + fulfillsID <- insert $ CollabFulfillsJoin collabID + insert_ $ collabTopicCtor collabID topicKey + let authorID = remoteAuthorId author + recipID <- insert $ CollabRecipRemote collabID authorID + insert_ $ CollabRecipRemoteJoin recipID fulfillsID joinID diff --git a/src/Vervis/Actor/Deck.hs b/src/Vervis/Actor/Deck.hs index 376509c..27a2731 100644 --- a/src/Vervis/Actor/Deck.hs +++ b/src/Vervis/Actor/Deck.hs @@ -171,7 +171,6 @@ deckReject -> ActE (Text, Act (), Next) deckReject = topicReject deckActor GrantResourceDeck - -- Meaning: A remote actor A invited someone B to a resource -- Behavior: -- * Verify the resource is me @@ -194,6 +193,26 @@ deckInvite = deckActor GrantResourceDeck CollabTopicDeckDeck CollabTopicDeckCollab CollabTopicDeck +-- Meaning: A remote actor A asked to join a resource +-- Behavior: +-- * Verify the resource is me +-- * Verify A doesn't already have an invite/join/grant for me +-- * Remember the join in DB +-- * Forward the Join to my followers +deckJoin + :: UTCTime + -> DeckId + -> RemoteAuthor + -> ActivityBody + -> Maybe (RecipientRoutes, ByteString) + -> LocalURI + -> AP.Join URIMode + -> ActE (Text, Act (), Next) +deckJoin = + topicJoin + deckActor GrantResourceDeck + CollabTopicDeckDeck CollabTopicDeckCollab CollabTopicDeck + ------------------------------------------------------------------------------ -- Ambiguous: Following/Resolving ------------------------------------------------------------------------------ @@ -417,6 +436,8 @@ deckBehavior now deckID (Right (VerseRemote author body mfwd luActivity)) = deckFollow now deckID author body mfwd luActivity follow AP.InviteActivity invite -> deckInvite now deckID author body mfwd luActivity invite + AP.JoinActivity join -> + deckJoin now deckID author body mfwd luActivity join AP.RejectActivity reject -> deckReject now deckID author body mfwd luActivity reject AP.UndoActivity undo -> diff --git a/src/Vervis/Actor/Person.hs b/src/Vervis/Actor/Person.hs index 82bbcd9..0240a0c 100644 --- a/src/Vervis/Actor/Person.hs +++ b/src/Vervis/Actor/Person.hs @@ -710,6 +710,19 @@ personBehavior now personID (Left event) = itemID <- insert $ InboxItem True now insert_ $ InboxItemRemote inboxID inviteID itemID done "Inserted Invite to inbox" + -- Meaning: A remote actor sent a Join on a local resource, I'm being + -- forwarded as a follower of the resource + -- + -- Behavior: Insert the Join to my inbox + EventRemoteJoinLocalTopicFwdToFollower joinID -> do + lift $ withDB $ do + (_personRecip, actorRecip) <- do + p <- getJust personID + (p,) <$> getJust (personActor p) + let inboxID = actorInbox actorRecip + itemID <- insert $ InboxItem True now + insert_ $ InboxItemRemote inboxID joinID itemID + done "Inserted Invite to inbox" _ -> throwE $ "Unsupported event for Person: " <> T.pack (show event) personBehavior now personID (Right (VerseRemote author body mfwd luActivity)) = case AP.activitySpecific $ actbActivity body of diff --git a/src/Vervis/Federation/Collab.hs b/src/Vervis/Federation/Collab.hs index d61295f..a8c2544 100644 --- a/src/Vervis/Federation/Collab.hs +++ b/src/Vervis/Federation/Collab.hs @@ -19,9 +19,9 @@ module Vervis.Federation.Collab ( --personInviteF --topicInviteF - repoJoinF - , deckJoinF - , loomJoinF + -- repoJoinF + --, deckJoinF + --, loomJoinF --, repoAcceptF --, deckAcceptF @@ -90,87 +90,7 @@ import Vervis.Persist.Collab import Vervis.Recipient import Vervis.RemoteActorStore -topicJoinF - :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic) - => (topic -> ActorId) - -> (forall f. f topic -> GrantResourceBy f) - -> UTCTime - -> KeyHashid topic - -> RemoteAuthor - -> ActivityBody - -> Maybe (RecipientRoutes, ByteString) - -> LocalURI - -> AP.Join URIMode - -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text)) -topicJoinF topicActor topicResource now recipHash author body mfwd luJoin join = (,Nothing) <$> do - error "Temporarily disabled due to switch to new actor system" {- - -- Check input - recipKey <- decodeKeyHashid404 recipHash - verifyNothingE - (AP.activityCapability $ actbActivity body) - "Capability not needed" - resource <- parseJoin join - unless (resource == Left (topicResource recipKey)) $ - throwE "Join's object isn't me, don't need this Join" - - maybeHttp <- lift $ runDB $ do - - -- Find recipient topic in DB, returning 404 if doesn't exist because - -- we're in the topic's inbox post handler - (recipActorID, recipActor) <- do - topic <- get404 recipKey - let actorID = topicActor topic - (actorID,) <$> getJust actorID - - -- Insert the Join to topic's inbox - mractid <- insertToInbox now author body (actorInbox recipActor) luJoin False - for mractid $ \ joinID -> do - - -- Insert Collab record to DB - insertCollab (topicResource recipKey) joinID - - -- Forward the Join activity to relevant local stages, - -- and schedule delivery for unavailable remote members of - -- them - for mfwd $ \ (localRecips, sig) -> do - let recipByHash = - grantResourceLocalActor $ topicResource recipHash - sieve = - makeRecipientSet - [] - [localActorFollowers recipByHash] - forwardActivityDB - (actbBL body) localRecips sig recipActorID recipByHash - sieve joinID - - -- Launch asynchronous HTTP forwarding of the Join activity - case maybeHttp of - Nothing -> return "I already have this activity in my inbox, doing nothing" - Just maybeForward -> do - traverse_ (forkWorker "topicJoinF inbox-forwarding") maybeForward - return $ - case maybeForward of - Nothing -> "Inserted Collab to DB, no inbox-forwarding to do" - Just _ -> "Inserted Collab to DB and ran inbox-forwarding of the Join" - - where - - insertCollab topic joinID = do - collabID <- insert Collab - fulfillsID <- insert $ CollabFulfillsJoin collabID - case topic of - GrantResourceRepo repoID -> - insert_ $ CollabTopicRepo collabID repoID - GrantResourceDeck deckID -> - insert_ $ CollabTopicDeck collabID deckID - GrantResourceLoom loomID -> - insert_ $ CollabTopicLoom collabID loomID - let authorID = remoteAuthorId author - recipID <- insert $ CollabRecipRemote collabID authorID - insert_ $ CollabRecipRemoteJoin recipID fulfillsID joinID --} - repoJoinF :: UTCTime -> KeyHashid Repo @@ -203,6 +123,7 @@ loomJoinF -> AP.Join URIMode -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text)) loomJoinF = topicJoinF loomActor GrantResourceLoom +-} {- repoAcceptF