Insert ticket commenter to ticket followers, and never deliver to themselves

This commit is contained in:
fr33domlover 2019-04-18 23:37:33 +00:00
parent dedb9834e3
commit fc2ace3370

View file

@ -58,6 +58,7 @@ import UnliftIO.Exception (try)
import Yesod.Core hiding (logError, logWarn, logInfo) import Yesod.Core hiding (logError, logWarn, logInfo)
import Yesod.Persist.Core import Yesod.Persist.Core
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
import qualified Data.List.Ordered as LO import qualified Data.List.Ordered as LO
import qualified Data.Text as T import qualified Data.Text as T
@ -67,7 +68,7 @@ import Network.HTTP.Signature
import Database.Persist.JSON import Database.Persist.JSON
import Network.FedURI import Network.FedURI
import Web.ActivityPub import Web.ActivityPub hiding (Follow)
import Yesod.Auth.Unverified import Yesod.Auth.Unverified
import Yesod.FedURI import Yesod.FedURI
import Yesod.Hashids import Yesod.Hashids
@ -444,6 +445,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c
unless (messageRoot m == did) $ unless (messageRoot m == did) $
throwE "Remote parent belongs to a different discussion" throwE "Remote parent belongs to a different discussion"
return mid return mid
lift $ insertUnique_ $ Follow pid (ticketFollowers t)
return (did, Left <$> mmidParent, Just (sid, ticketFollowers t)) return (did, Left <$> mmidParent, Just (sid, ticketFollowers t))
Nothing -> do Nothing -> do
(rd, rdnew) <- lift $ do (rd, rdnew) <- lift $ do
@ -481,7 +483,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c
return mid return mid
return (did, meparent, Nothing) return (did, meparent, Nothing)
(lmid, obid, doc) <- lift $ insertMessage luAttrib shrUser pid uContext did muParent meparent content (lmid, obid, doc) <- lift $ insertMessage luAttrib shrUser pid uContext did muParent meparent content
moreRemotes <- deliverLocal obid localRecips mcollections moreRemotes <- deliverLocal pid obid localRecips mcollections
unless (federation || null moreRemotes) $ unless (federation || null moreRemotes) $
throwE "Federation disabled but remote collection members found" throwE "Federation disabled but remote collection members found"
remotesHttp <- lift $ deliverRemoteDB obid remoteRecips moreRemotes remotesHttp <- lift $ deliverRemoteDB obid remoteRecips moreRemotes
@ -742,12 +744,15 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c
-- For local collections, expand them, deliver to local users, and return a -- For local collections, expand them, deliver to local users, and return a
-- list of remote actors found in them. -- list of remote actors found in them.
deliverLocal deliverLocal
:: OutboxItemId :: PersonId
-> OutboxItemId
-> [ShrIdent] -> [ShrIdent]
-> Maybe (SharerId, FollowerSetId) -> Maybe (SharerId, FollowerSetId)
-> ExceptT Text AppDB [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, Maybe UTCTime))] -> ExceptT Text AppDB [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, Maybe UTCTime))]
deliverLocal obid recips mticket = do deliverLocal pidAuthor obid recips mticket = do
recipPids <- traverse getPersonId $ nub recips recipPids <- traverse getPersonId $ nub recips
when (pidAuthor `elem` recipPids) $
throwE "Note addressed to note author"
(morePids, remotes) <- (morePids, remotes) <-
lift $ case mticket of lift $ case mticket of
Nothing -> return ([], []) Nothing -> return ([], [])
@ -755,7 +760,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c
(teamPids, teamRemotes) <- getTicketTeam sid (teamPids, teamRemotes) <- getTicketTeam sid
(fsPids, fsRemotes) <- getFollowers fsid (fsPids, fsRemotes) <- getFollowers fsid
return return
( union teamPids fsPids ( L.delete pidAuthor $ union teamPids fsPids
-- TODO this is inefficient! The way this combines -- TODO this is inefficient! The way this combines
-- same-host sharer lists is: -- same-host sharer lists is:
-- --