From 970fa240fc56971e076de0e9a19b4c08e5b54c59 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Sun, 9 Jun 2019 21:06:26 +0000 Subject: [PATCH] Deliver to project inbox in postOutboxR and postProjectInboxR --- src/Vervis/Federation.hs | 41 +++++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 17 deletions(-) diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index 1a51dff..8c10141 100644 --- a/src/Vervis/Federation.hs +++ b/src/Vervis/Federation.hs @@ -725,9 +725,9 @@ handleProjectInbox now shrRecip prjRecip iidSender hSender raidSender body raw a hLocal <- getsYesod $ appInstanceHost . appSettings let colls = findRelevantCollections hLocal num audience mremotesHttp <- runDBExcept $ do - (sid, fsid, jid, did, meparent) <- getContextAndParent num mparent + (sid, fsid, jid, ibid, did, meparent) <- getContextAndParent num mparent lift $ join <$> do - mmid <- insertToDiscussion luNote published did meparent fsid + mmid <- insertToDiscussion luNote published ibid did meparent fsid for mmid $ \ (ractid, mid) -> do updateOrphans luNote did mid for msig $ \ sig -> do @@ -784,9 +784,10 @@ handleProjectInbox now shrRecip prjRecip iidSender hSender raidSender body raw a getContextAndParent num mparent = do mt <- lift $ do sid <- getKeyBy404 $ UniqueSharer shrRecip - jid <- getKeyBy404 $ UniqueProject prjRecip sid - fmap (jid,sid,) <$> getValBy (UniqueTicket jid num) - (jid, sid, t) <- fromMaybeE mt "Context: No such local ticket" + Entity jid j <- getBy404 $ UniqueProject prjRecip sid + fmap (jid, projectInbox j, sid ,) <$> + getValBy (UniqueTicket jid num) + (jid, ibid, sid, t) <- fromMaybeE mt "Context: No such local ticket" let did = ticketDiscuss t meparent <- for mparent $ \ parent -> case parent of @@ -803,8 +804,8 @@ handleProjectInbox now shrRecip prjRecip iidSender hSender raidSender body raw a throwE "Remote parent belongs to a different discussion" return mid Nothing -> return $ Right $ l2f hParent luParent - return (sid, ticketFollowers t, jid, did, meparent) - insertToDiscussion luNote published did meparent fsid = do + return (sid, ticketFollowers t, jid, ibid, did, meparent) + insertToDiscussion luNote published ibid did meparent fsid = do ractid <- either entityKey id <$> insertBy' RemoteActivity { remoteActivityInstance = iidSender , remoteActivityIdent = activityId activity @@ -838,6 +839,8 @@ handleProjectInbox now shrRecip prjRecip iidSender hSender raidSender body raw a return Nothing Just _ -> do insertUnique_ $ RemoteFollow raidSender fsid False + ibiid <- insert $ InboxItem False + insert_ $ InboxItemRemote ibid ractid ibiid return $ Just (ractid, mid) updateOrphans luNote did mid = do let uNote = l2f hSender luNote @@ -1079,10 +1082,10 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished s Just (shr, prj, num) -> do mt <- lift $ runMaybeT $ do sid <- MaybeT $ getKeyBy $ UniqueSharer shr - jid <- MaybeT $ getKeyBy $ UniqueProject prj sid + Entity jid j <- MaybeT $ getBy $ UniqueProject prj sid t <- MaybeT $ getValBy $ UniqueTicket jid num - return (sid, t) - (sid, t) <- fromMaybeE mt "Context: No such local ticket" + return (sid, projectInbox j, t) + (sid, ibidProject, t) <- fromMaybeE mt "Context: No such local ticket" let did = ticketDiscuss t mmidParent <- for mparent $ \ parent -> case parent of @@ -1098,7 +1101,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished s throwE "Remote parent belongs to a different discussion" return mid lift $ insertUnique_ $ Follow pid (ticketFollowers t) False - return (did, Left <$> mmidParent, Just (sid, ticketFollowers t)) + return (did, Left <$> mmidParent, Just (sid, ticketFollowers t, ibidProject)) Nothing -> do (rd, rdnew) <- lift $ do let (hContext, luContext) = f2l uContext @@ -1386,7 +1389,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished s :: PersonId -> OutboxItemId -> [ShrIdent] - -> Maybe (SharerId, FollowerSetId) + -> Maybe (SharerId, FollowerSetId, InboxId) -> ExceptT Text AppDB [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))] deliverLocal pidAuthor obid recips mticket = do recipPids <- traverse getPersonId $ nub recips @@ -1395,7 +1398,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished s (morePids, remotes) <- lift $ case mticket of Nothing -> return ([], []) - Just (sid, fsid) -> do + Just (sid, fsid, _) -> do (teamPids, teamRemotes) <- getTicketTeam sid (fsPids, fsRemotes) <- getFollowers fsid return @@ -1440,10 +1443,14 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished s -- lists have the same instance. , map (second $ NE.nubBy ((==) `on` fst4)) $ mergeConcat teamRemotes fsRemotes ) - lift $ for_ (union recipPids morePids) $ \ pid -> do - ibid <- personInbox <$> getJust pid - ibiid <- insert $ InboxItem True - insert_ $ InboxItemLocal ibid obid ibiid + lift $ do + for_ mticket $ \ (_, _, ibidProject) -> do + ibiid <- insert $ InboxItem False + insert_ $ InboxItemLocal ibidProject obid ibiid + for_ (union recipPids morePids) $ \ pid -> do + ibid <- personInbox <$> getJust pid + ibiid <- insert $ InboxItem True + insert_ $ InboxItemLocal ibid obid ibiid return remotes where getPersonId :: ShrIdent -> ExceptT Text AppDB PersonId