Insert ticket commenter to ticket followers, and never deliver to themselves
This commit is contained in:
parent
dedb9834e3
commit
fc2ace3370
1 changed files with 10 additions and 5 deletions
|
@ -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:
|
||||||
--
|
--
|
||||||
|
|
Loading…
Reference in a new issue