From fc2ace3370a10ab78968a8b8b2ef51a08d3ceb88 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Thu, 18 Apr 2019 23:37:33 +0000
Subject: [PATCH] Insert ticket commenter to ticket followers, and never
 deliver to themselves

---
 src/Vervis/Federation.hs | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs
index a2b510c..217674d 100644
--- a/src/Vervis/Federation.hs
+++ b/src/Vervis/Federation.hs
@@ -58,6 +58,7 @@ import UnliftIO.Exception (try)
 import Yesod.Core hiding (logError, logWarn, logInfo)
 import Yesod.Persist.Core
 
+import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
 import qualified Data.List.Ordered as LO
 import qualified Data.Text as T
@@ -67,7 +68,7 @@ import Network.HTTP.Signature
 
 import Database.Persist.JSON
 import Network.FedURI
-import Web.ActivityPub
+import Web.ActivityPub hiding (Follow)
 import Yesod.Auth.Unverified
 import Yesod.FedURI
 import Yesod.Hashids
@@ -444,6 +445,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c
                             unless (messageRoot m == did) $
                                 throwE "Remote parent belongs to a different discussion"
                             return mid
+                lift $ insertUnique_ $ Follow pid (ticketFollowers t)
                 return (did, Left <$> mmidParent, Just (sid, ticketFollowers t))
             Nothing -> do
                 (rd, rdnew) <- lift $ do
@@ -481,7 +483,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c
                                     return mid
                 return (did, meparent, Nothing)
         (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) $
             throwE "Federation disabled but remote collection members found"
         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
     -- list of remote actors found in them.
     deliverLocal
-        :: OutboxItemId
+        :: PersonId
+        -> OutboxItemId
         -> [ShrIdent]
         -> Maybe (SharerId, FollowerSetId)
         -> 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
+        when (pidAuthor `elem` recipPids) $
+            throwE "Note addressed to note author"
         (morePids, remotes) <-
             lift $ case mticket of
                 Nothing -> return ([], [])
@@ -755,7 +760,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c
                     (teamPids, teamRemotes) <- getTicketTeam sid
                     (fsPids, fsRemotes) <- getFollowers fsid
                     return
-                        ( union teamPids fsPids
+                        ( L.delete pidAuthor $ union teamPids fsPids
                           -- TODO this is inefficient! The way this combines
                           -- same-host sharer lists is:
                           --