diff --git a/config/models b/config/models index 3241569..ea94bba 100644 --- a/config/models +++ b/config/models @@ -130,12 +130,14 @@ FollowerSet Follow person PersonId target FollowerSetId + manual Bool UniqueFollow person target RemoteFollow actor RemoteActorId target FollowerSetId + manual Bool UniqueRemoteFollow actor target diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index 5aa1d5c..8a87b72 100644 --- a/src/Vervis/Federation.hs +++ b/src/Vervis/Federation.hs @@ -731,7 +731,7 @@ handleProjectInbox now shrRecip prjRecip iidSender hSender raidSender body raw a mremotesHttp <- runDBExcept $ do (sid, fsid, jid, did, meparent) <- getContextAndParent num mparent lift $ join <$> do - mmid <- insertToDiscussion luNote published did meparent + mmid <- insertToDiscussion luNote published did meparent fsid for mmid $ \ (ractid, mid) -> do updateOrphans luNote did mid for msig $ \ sig -> do @@ -808,7 +808,7 @@ handleProjectInbox now shrRecip prjRecip iidSender hSender raidSender body raw a return mid Nothing -> return $ Right $ l2f hParent luParent return (sid, ticketFollowers t, jid, did, meparent) - insertToDiscussion luNote published did meparent = do + insertToDiscussion luNote published did meparent fsid = do ractid <- either entityKey id <$> insertBy' RemoteActivity { remoteActivityInstance = iidSender , remoteActivityIdent = activityId activity @@ -839,7 +839,9 @@ handleProjectInbox now shrRecip prjRecip iidSender hSender raidSender body raw a Nothing -> do delete mid return Nothing - Just _ -> return $ Just (ractid, mid) + Just _ -> do + insertUnique_ $ RemoteFollow raidSender fsid False + return $ Just (ractid, mid) updateOrphans luNote did mid = do let uNote = l2f hSender luNote related <- selectOrphans uNote (E.==.) @@ -1088,7 +1090,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) + lift $ insertUnique_ $ Follow pid (ticketFollowers t) False return (did, Left <$> mmidParent, Just (sid, ticketFollowers t)) Nothing -> do (rd, rdnew) <- lift $ do diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 29e1da4..833b2d1 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -259,6 +259,10 @@ changes = , addFieldPrimRequired "Delivery" True "forwarding" -- 66 , addEntities model_2019_05_03 + -- 67 + , addFieldPrimRequired "Follow" False "manual" + -- 68 + , addFieldPrimRequired "RemoteFollow" False "manual" ] migrateDB :: MonadIO m => ReaderT SqlBackend m (Either Text (Int, Int))