From c7b6ad643beeeab4817223cb964ba8e4900271f6 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Wed, 27 May 2020 11:39:19 +0000 Subject: [PATCH] S2S: Support following sharer-patch and repo-patch Also fixed a bug in which trying to follow a ticket with nonexistent ltkhid/talkhid would result with 404 as if the actor inbox is nonexistent. Now, there's a friendly message reported. --- src/Vervis/Federation/Offer.hs | 135 ++++++++++++++++++++------------- 1 file changed, 81 insertions(+), 54 deletions(-) diff --git a/src/Vervis/Federation/Offer.hs b/src/Vervis/Federation/Offer.hs index cc04966..4a05bf8 100644 --- a/src/Vervis/Federation/Offer.hs +++ b/src/Vervis/Federation/Offer.hs @@ -80,6 +80,8 @@ import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Ticket +import Vervis.Patch +import Vervis.Ticket sharerAcceptF :: ShrIdent @@ -240,7 +242,7 @@ sharerRejectF shr now author body (Reject (ObjURI hOffer luOffer)) = do followF :: (Route App -> Maybe a) -> Route App - -> (a -> AppDB b) + -> (a -> AppDB (Maybe b)) -> (b -> InboxId) -> (b -> OutboxId) -> (b -> FollowerSetId) @@ -267,30 +269,33 @@ followF (activityId $ actbActivity body) "Follow without 'id'" emsg <- lift $ runDB $ do - recip <- getRecip obj - newItem <- insertToInbox luFollow $ recipInbox recip - case newItem of - Nothing -> return $ Left "Activity already exists in inbox, not using" - Just ractid -> do - let raidAuthor = remoteAuthorId author - ra <- getJust raidAuthor - ro <- getJust $ remoteActorIdent ra - (obiid, doc) <- - insertAcceptToOutbox - ra - luFollow - (recipOutbox recip) - newFollow <- insertFollow ractid obiid $ recipFollowers recip - if newFollow - then Right <$> do - let raInfo = RemoteRecipient raidAuthor (remoteObjectIdent ro) (remoteActorInbox ra) (remoteActorErrorSince ra) - iidAuthor = remoteAuthorInstance author - hAuthor = objUriAuthority $ remoteAuthorURI author - hostSection = ((iidAuthor, hAuthor), raInfo :| []) - (obiid, doc,) <$> deliverRemoteDB' dont obiid [] [hostSection] - else do - delete obiid - return $ Left "You're already a follower of me" + mrecip <- getRecip obj + case mrecip of + Nothing -> return $ Left "Follow object not found, ignoring activity" + Just recip -> do + newItem <- insertToInbox luFollow $ recipInbox recip + case newItem of + Nothing -> return $ Left "Activity already exists in inbox, not using" + Just ractid -> do + let raidAuthor = remoteAuthorId author + ra <- getJust raidAuthor + ro <- getJust $ remoteActorIdent ra + (obiid, doc) <- + insertAcceptToOutbox + ra + luFollow + (recipOutbox recip) + newFollow <- insertFollow ractid obiid $ recipFollowers recip + if newFollow + then Right <$> do + let raInfo = RemoteRecipient raidAuthor (remoteObjectIdent ro) (remoteActorInbox ra) (remoteActorErrorSince ra) + iidAuthor = remoteAuthorInstance author + hAuthor = objUriAuthority $ remoteAuthorURI author + hostSection = ((iidAuthor, hAuthor), raInfo :| []) + (obiid, doc,) <$> deliverRemoteDB' dont obiid [] [hostSection] + else do + delete obiid + return $ Left "You're already a follower of me" case emsg of Left msg -> return msg Right (obiid, doc, remotesHttp) -> do @@ -382,23 +387,31 @@ sharerFollowF shr = objRoute (SharerR shr') | shr == shr' = Just Nothing objRoute (SharerTicketR shr' talkhid) - | shr == shr' = Just $ Just talkhid + | shr == shr' = Just $ Just (talkhid, False) + objRoute (SharerPatchR shr' talkhid) + | shr == shr' = Just $ Just (talkhid, True) objRoute _ = Nothing getRecip mtalkhid = do sid <- getKeyBy404 $ UniqueSharer shr - Entity pid p <- getBy404 $ UniquePersonIdent sid - mt <- for mtalkhid $ \ talkhid -> do - talid <- decodeKeyHashid404 talkhid - tal <- get404 talid - unless (ticketAuthorLocalAuthor tal == pid) notFound - mtup <- getBy $ UniqueTicketUnderProjectAuthor talid - unless (isNothing mtup) notFound - getJust $ ticketAuthorLocalTicket tal - return (p, mt) + p <- getValBy404 $ UniquePersonIdent sid + mmt <- for mtalkhid $ \ (talkhid, patch) -> runMaybeT $ do + talid <- decodeKeyHashidM talkhid + if patch + then do + (_, Entity _ lt, _, _, _) <- MaybeT $ getSharerPatch shr talid + return lt + else do + (_, Entity _ lt, _, _) <- MaybeT $ getSharerTicket shr talid + return lt + return $ + case mmt of + Nothing -> Just (p, Nothing) + Just Nothing -> Nothing + Just (Just t) -> Just (p, Just t) - followers (p, Nothing) = personFollowers p - followers (_, Just lt) = localTicketFollowers lt + followers (p, Nothing) = personFollowers p + followers (_, Just lt) = localTicketFollowers lt projectFollowF :: ShrIdent @@ -426,17 +439,16 @@ projectFollowF shr prj = getRecip mltkhid = do sid <- getKeyBy404 $ UniqueSharer shr - Entity jid j <- getBy404 $ UniqueProject prj sid - mt <- for mltkhid $ \ ltkhid -> do - ltid <- decodeKeyHashid404 ltkhid - lt <- get404 ltid - tclid <- - getKeyBy404 $ UniqueTicketContextLocal $ localTicketTicket lt - tpl <- - getValBy404 $ UniqueTicketProjectLocal tclid - unless (ticketProjectLocalProject tpl == jid) notFound + j <- getValBy404 $ UniqueProject prj sid + mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do + ltid <- decodeKeyHashidM ltkhid + (_, _, _, Entity _ lt, _, _, _) <- MaybeT $ getProjectTicket shr prj ltid return lt - return (j, mt) + return $ + case mmt of + Nothing -> Just (j, Nothing) + Just Nothing -> Nothing + Just (Just t) -> Just (j, Just t) followers (j, Nothing) = projectFollowers j followers (_, Just lt) = localTicketFollowers lt @@ -454,17 +466,32 @@ repoFollowF shr rp = objRoute (RepoR shr rp) getRecip - repoInbox - repoOutbox - repoFollowers + (repoInbox . fst) + (repoOutbox . fst) + followers (RepoOutboxItemR shr rp) where - objRoute (RepoR shr' rp') | shr == shr' && rp == rp' = Just () - objRoute _ = Nothing + objRoute (RepoR shr' rp') + | shr == shr' && rp == rp' = Just Nothing + objRoute (RepoPatchR shr' rp' ltkhid) + | shr == shr' && rp == rp' = Just $ Just ltkhid + objRoute _ = Nothing - getRecip () = do + getRecip mltkhid = do sid <- getKeyBy404 $ UniqueSharer shr - getValBy404 $ UniqueRepo rp sid + r <- getValBy404 $ UniqueRepo rp sid + mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do + ltid <- decodeKeyHashidM ltkhid + (_, _, _, Entity _ lt, _, _, _, _) <- MaybeT $ getRepoPatch shr rp ltid + return lt + return $ + case mmt of + Nothing -> Just (r, Nothing) + Just Nothing -> Nothing + Just (Just t) -> Just (r, Just t) + + followers (r, Nothing) = repoFollowers r + followers (_, Just lt) = localTicketFollowers lt undoF :: Route App