S2S: sharerCreateNoteF caches note and does inbox fwd if sharer is ticket owner

config/models

@@ -115,12 +115,23 @@ Forwarding
     recipient   RemoteActorId
     activity    RemoteActivityId
     activityRaw ByteString
-    sender      ProjectId
     signature   ByteString
     running     Bool
 
     UniqueForwarding recipient activity
 
+ForwarderSharer
+    task   ForwardingId
+    sender SharerId
+
+    UniqueForwarderSharer task
+
+ForwarderProject
+    task   ForwardingId
+    sender ProjectId
+
+    UniqueForwarderProject task
+
 VerifKey
     ident    LocalRefURI
     instance InstanceId

migrations/2020_05_12_fwd_sender.model

@@ -0,0 +1,11 @@
+ForwarderSharer
+    task   ForwardingId
+    sender SharerId
+
+    UniqueForwarderSharer task
+
+ForwarderProject
+    task   ForwardingId
+    sender ProjectId
+
+    UniqueForwarderProject task

migrations/2020_05_12_fwd_sender_mig.model

@@ -0,0 +1,21 @@
+RemoteActor
+
+RemoteActivity
+
+Project
+
+Forwarding
+    recipient   RemoteActorId
+    activity    RemoteActivityId
+    activityRaw ByteString
+    sender      ProjectId
+    signature   ByteString
+    running     Bool
+
+    UniqueForwarding recipient activity
+
+ForwarderProject
+    task   ForwardingId
+    sender ProjectId
+
+    UniqueForwarderProject task

src/Data/Tuple/Local.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2019 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -16,8 +16,10 @@
 module Data.Tuple.Local
     ( fst3
     , fst4
+    , fst5
     , thd3
     , fourth4
+    , fourth5
     )
 where
 
@@ -27,8 +29,14 @@ fst3 (x, _, _) = x
 fst4 :: (a, b, c, d) -> a
 fst4 (x, _, _, _) = x
 
+fst5 :: (a, b, c, d, e) -> a
+fst5 (x, _, _, _, _) = x
+
 thd3 :: (a, b, c) -> c
 thd3 (_, _, z) = z
 
 fourth4 :: (a, b, c, d) -> d
 fourth4 (_, _, _, w) = w
+
+fourth5 :: (a, b, c, d, e) -> d
+fourth5 (_, _, _, w, _) = w

src/Vervis/ActivityPub.hs

@@ -32,8 +32,10 @@ module Vervis.ActivityPub
     , isInstanceErrorG
     , deliverHttp
     , deliverHttpBL
-    , deliverRemoteDB
+    , deliverRemoteDB_J
-    , deliverRemoteHTTP
+    , deliverRemoteDB_S
+    , deliverRemoteHTTP_J
+    , deliverRemoteHTTP_S
     , checkForward
     , parseTarget
     --, checkDep
@@ -59,6 +61,7 @@ import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.Reader
 import Data.Bifunctor
+import Data.Bitraversable
 import Data.ByteString (ByteString)
 import Data.Either
 import Data.Foldable
@@ -312,45 +315,67 @@ deliverHttpBL
 deliverHttpBL body mfwd h luInbox =
     deliverActivityBL' (ObjURI h luInbox) (ObjURI h <$> mfwd) body
 
-deliverRemoteDB
+deliverRemoteDB_
+    :: PersistRecordBackend fwder SqlBackend
+    => (ForwardingId -> Key sender -> fwder)
+    -> BL.ByteString
+    -> RemoteActivityId
+    -> Key sender
+    -> ByteString
+    -> [((InstanceId, Host), NonEmpty RemoteRecipient)]
+    -> AppDB
+        [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, ForwardingId, Key fwder))]
+deliverRemoteDB_ makeFwder body ractid senderKey sig recips = do
+    let body' = BL.toStrict body
+        makeFwd (RemoteRecipient raid _ _ msince) =
+            Forwarding raid ractid body' sig (isNothing msince)
+    fetchedDeliv <- for recips $ bitraverse pure $ \ rs -> do
+        fwds <- insertMany' makeFwd rs
+        insertMany' (flip makeFwder senderKey . snd) fwds
+    return $ takeNoError5 fetchedDeliv
+    where
+    takeNoError noError = mapMaybe $ \ (i, rs) -> (i,) <$> nonEmpty (mapMaybe noError $ NE.toList rs)
+    takeNoError5 = takeNoError noError
+        where
+        noError ((RemoteRecipient ak luA luI Nothing , fwid), fwrid) = Just (ak, luA, luI, fwid, fwrid)
+        noError ((RemoteRecipient _  _   _   (Just _), _   ), _    ) = Nothing
+
+deliverRemoteDB_J
     :: BL.ByteString
     -> RemoteActivityId
     -> ProjectId
     -> ByteString
     -> [((InstanceId, Host), NonEmpty RemoteRecipient)]
     -> AppDB
-        [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, ForwardingId))]
+        [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, ForwardingId, ForwarderProjectId))]
-deliverRemoteDB body ractid jid sig recips = do
+deliverRemoteDB_J = deliverRemoteDB_ ForwarderProject
-    let body' = BL.toStrict body
-        deliv raid msince = Forwarding raid ractid body' jid sig $ isNothing msince
-    fetchedDeliv <- for recips $ \ (i, rs) ->
-        (i,) <$> insertMany' (\ (RemoteRecipient raid _ _ msince) -> deliv raid msince) rs
-    return $ takeNoError4 fetchedDeliv
-    where
-    takeNoError noError = mapMaybe $ \ (i, rs) -> (i,) <$> nonEmpty (mapMaybe noError $ NE.toList rs)
-    takeNoError4 = takeNoError noError
-        where
-        noError (RemoteRecipient ak luA luI Nothing , dlk) = Just (ak, luA, luI, dlk)
-        noError (RemoteRecipient _  _   _   (Just _), _  ) = Nothing
 
-deliverRemoteHTTP
+deliverRemoteDB_S
-    :: (MonadSite m, SiteEnv m ~ App)
+    :: BL.ByteString
+    -> RemoteActivityId
+    -> SharerId
+    -> ByteString
+    -> [((InstanceId, Host), NonEmpty RemoteRecipient)]
+    -> AppDB
+        [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, ForwardingId, ForwarderSharerId))]
+deliverRemoteDB_S = deliverRemoteDB_ ForwarderSharer
+
+deliverRemoteHTTP'
+    :: (MonadSite m, SiteEnv m ~ App, PersistRecordBackend fwder SqlBackend)
     => UTCTime
-    -> ShrIdent
+    -> LocalActor
-    -> PrjIdent
     -> BL.ByteString
     -> ByteString
-    -> [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, ForwardingId))]
+    -> [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, ForwardingId, Key fwder))]
     -> m ()
-deliverRemoteHTTP now shrRecip prjRecip body sig fetched = do
+deliverRemoteHTTP' now sender body sig fetched = do
     let deliver h inbox =
-            let sender = ProjectR shrRecip prjRecip
+            forwardActivity (ObjURI h inbox) sig (renderLocalActor sender) body
-            in  forwardActivity (ObjURI h inbox) sig sender body
     traverse_ (fork . deliverFetched deliver now) fetched
     where
     fork = forkWorker "Inbox forwarding to remote members of local collections: delivery failed"
     deliverFetched deliver now ((_, h), recips@(r :| rs)) = do
-        let (raid, _luActor, luInbox, fwid) = r
+        let (raid, _luActor, luInbox, fwid, forwarderKey) = r
         e <- deliver h luInbox
         let e' = case e of
                     Left err ->
@@ -361,16 +386,18 @@ deliverRemoteHTTP now shrRecip prjRecip body sig fetched = do
         case e' of
             Nothing -> runSiteDB $ do
                 let recips' = NE.toList recips
-                updateWhere [RemoteActorId <-. map fst4 recips', RemoteActorErrorSince ==. Nothing] [RemoteActorErrorSince =. Just now]
+                updateWhere [RemoteActorId <-. map fst5 recips', RemoteActorErrorSince ==. Nothing] [RemoteActorErrorSince =. Just now]
-                updateWhere [ForwardingId <-. map fourth4 recips'] [ForwardingRunning =. False]
+                updateWhere [ForwardingId <-. map fourth5 recips'] [ForwardingRunning =. False]
             Just success -> do
                 runSiteDB $
                     if success
-                        then delete fwid
+                        then do
+                            delete forwarderKey
+                            delete fwid
                         else do
                             updateWhere [RemoteActorId ==. raid, RemoteActorErrorSince ==. Nothing] [RemoteActorErrorSince =. Just now]
                             update fwid [ForwardingRunning =. False]
-                for_ rs $ \ (raid, _luActor, luInbox, fwid) ->
+                for_ rs $ \ (raid, _luActor, luInbox, fwid, forwarderKey) ->
                     fork $ do
                         e <- deliver h luInbox
                         runSiteDB $
@@ -378,9 +405,33 @@ deliverRemoteHTTP now shrRecip prjRecip body sig fetched = do
                                 Left _err -> do
                                     updateWhere [RemoteActorId ==. raid, RemoteActorErrorSince ==. Nothing] [RemoteActorErrorSince =. Just now]
                                     update fwid [ForwardingRunning =. False]
-                                Right _resp -> delete fwid
+                                Right _resp -> do
+                                    delete forwarderKey
+                                    delete fwid
 
-checkForward shrRecip prjRecip = join <$> do
+deliverRemoteHTTP_J
+    :: (MonadSite m, SiteEnv m ~ App)
+    => UTCTime
+    -> ShrIdent
+    -> PrjIdent
+    -> BL.ByteString
+    -> ByteString
+    -> [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, ForwardingId, ForwarderProjectId))]
+    -> m ()
+deliverRemoteHTTP_J now shr prj =
+    deliverRemoteHTTP' now $ LocalActorProject shr prj
+
+deliverRemoteHTTP_S
+    :: (MonadSite m, SiteEnv m ~ App)
+    => UTCTime
+    -> ShrIdent
+    -> BL.ByteString
+    -> ByteString
+    -> [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, ForwardingId, ForwarderSharerId))]
+    -> m ()
+deliverRemoteHTTP_S now shr = deliverRemoteHTTP' now $ LocalActorSharer shr
+
+checkForward recip = join <$> do
     let hSig = hForwardingSignature
     msig <- maybeHeader hSig
     for msig $ \ sig -> do
@@ -389,9 +440,8 @@ checkForward shrRecip prjRecip = join <$> do
             in  prepareToVerifyHttpSigWith hSig False requires [] Nothing
         forwarder <- requireHeader hActivityPubForwarder
         renderUrl <- getUrlRender
-        let project = renderUrl $ ProjectR shrRecip prjRecip
         return $
-            if forwarder == encodeUtf8 project
+            if forwarder == encodeUtf8 (renderUrl $ renderLocalActor recip)
                 then Just sig
                 else Nothing
     where

src/Vervis/Federation.hs

@@ -373,6 +373,14 @@ fixRunningDeliveries = do
         , " forwarding deliveries"
         ]
 
+data Fwder = FwderProject ForwarderProjectId | FwderSharer ForwarderSharerId
+
+partitionFwders :: [Fwder] -> ([ForwarderProjectId], [ForwarderSharerId])
+partitionFwders = foldl' f ([], [])
+    where
+    f (js, ss) (FwderProject j) = (j : js, ss)
+    f (js, ss) (FwderSharer s)  = (js    , s : ss)
+
 retryOutboxDelivery :: Worker ()
 retryOutboxDelivery = do
     logInfo "Periodic delivery starting"
@@ -440,9 +448,14 @@ retryOutboxDelivery = do
         let (linkedOld, linkedNew) = partitionEithers $ map (decideBySinceDL dropAfter now . adaptLinked) linked
         deleteWhere [DeliveryId <-. linkedOld]
         -- Same for forwarding deliveries, which are always linked
-        forwarding <- E.select $ E.from $ \ (fw `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i `E.InnerJoin` j `E.InnerJoin` s) -> do
+        forwarding <- E.select $ E.from $ \ (fw `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i `E.LeftOuterJoin` (fwj `E.InnerJoin` j `E.InnerJoin` s) `E.LeftOuterJoin` (fws `E.InnerJoin` s2)) -> do
-            E.on $ j E.^. ProjectSharer E.==. s E.^. SharerId
+            E.on $ fws E.?. ForwarderSharerSender E.==. s2 E.?. SharerId
-            E.on $ fw E.^. ForwardingSender E.==. j E.^. ProjectId
+            E.on $ E.just (fw E.^. ForwardingId) E.==. fws E.?. ForwarderSharerTask
+
+            E.on $ j E.?. ProjectSharer E.==. s E.?. SharerId
+            E.on $ fwj E.?. ForwarderProjectSender E.==. j E.?. ProjectId
+            E.on $ E.just (fw E.^. ForwardingId) E.==. fwj E.?. ForwarderProjectTask
+
             E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId
             E.on $ ra E.^. RemoteActorIdent E.==. ro E.^. RemoteObjectId
             E.on $ fw E.^. ForwardingRecipient E.==. ra E.^. RemoteActorId
@@ -456,12 +469,22 @@ retryOutboxDelivery = do
                 , ra E.^. RemoteActorErrorSince
                 , fw E.^. ForwardingId
                 , fw E.^. ForwardingActivityRaw
-                , j E.^. ProjectIdent
+
-                , s E.^. SharerIdent
+                , fwj E.?. ForwarderProjectId
+                , s E.?. SharerIdent
+                , j E.?. ProjectIdent
+
+                , fws E.?. ForwarderSharerId
+                , s2 E.?. SharerIdent
+
                 , fw E.^. ForwardingSignature
                 )
         let (forwardingOld, forwardingNew) = partitionEithers $ map (decideBySinceFW dropAfter now . adaptForwarding) forwarding
-        deleteWhere [ForwardingId <-. forwardingOld]
+            (fwidsOld, fwdersOld) = unzip forwardingOld
+            (fwjidsOld, fwsidsOld) = partitionFwders fwdersOld
+        deleteWhere [ForwarderProjectId <-. fwjidsOld]
+        deleteWhere [ForwarderSharerId <-. fwsidsOld]
+        deleteWhere [ForwardingId <-. fwidsOld]
         return (groupUnlinked lonelyNew, groupLinked linkedNew, groupForwarding forwardingNew)
     let deliver = deliverHttpBL
     logInfo "Periodic delivery prepared DB, starting async HTTP POSTs"
@@ -548,19 +571,44 @@ retryOutboxDelivery = do
         = map (second $ groupWithExtractBy1 ((==) `on` fst) fst snd)
         . groupWithExtractBy ((==) `on` fst) fst snd
     adaptForwarding
-        (E.Value iid, E.Value h, E.Value raid, E.Value inbox, E.Value since, E.Value fwid, E.Value body, E.Value prj, E.Value shr, E.Value sig) =
+        ( E.Value iid, E.Value h, E.Value raid, E.Value inbox, E.Value since
+        , E.Value fwid, E.Value body
+        , E.Value mfwjid, E.Value mprj, E.Value mshr
+        , E.Value mfwsid, E.Value mshr2
+        , E.Value sig
+        ) =
             ( ( (iid, h)
-              , ((raid, inbox), (fwid, BL.fromStrict body, ProjectR shr prj, sig))
+              , ( (raid, inbox)
+                , ( fwid
+                  , BL.fromStrict body
+                  , let project = together3 mfwjid mprj mshr
+                        sharer = together2 mfwsid mshr2
+                    in  case (project, sharer) of
+                            (Just (fwjid, shr, prj), Nothing) ->
+                                (FwderProject fwjid, ProjectR shr prj)
+                            (Nothing, Just (fwsid, shr)) ->
+                                (FwderSharer fwsid, SharerR shr)
+                            _ -> error $ "Non-single fwder for fw#" ++ show fwid
+                  , sig
+                  )
+                )
               )
             , since
             )
-    decideBySinceFW dropAfter now (fw@(_, (_, (fwid, _, _, _))), msince) =
+        where
+        together2 (Just x) (Just y) = Just (x, y)
+        together2 Nothing Nothing = Nothing
+        together2 _ _ = error $ "Got weird forwarder for fw#" ++ show fwid
+        together3 (Just x) (Just y) (Just z) = Just (x, y, z)
+        together3 Nothing Nothing Nothing = Nothing
+        together3 _ _ _ = error $ "Got weird forwarder for fw#" ++ show fwid
+    decideBySinceFW dropAfter now (fw@(_, (_, (fwid, _, (fwder, _), _))), msince) =
         case msince of
             Nothing -> Right fw
             Just since ->
                 if relevant dropAfter now since
                     then Right fw
-                    else Left fwid
+                    else Left (fwid, fwder)
     groupForwarding
         = map (second $ groupWithExtractBy1 ((==) `on` fst) fst snd)
         . groupWithExtractBy ((==) `on` fst) fst snd
@@ -648,12 +696,16 @@ retryOutboxDelivery = do
             logDebug $
                 "Periodic deliver starting forwarding for inbox " <>
                 renderObjURI (ObjURI h inbox)
-            waitsD <- for delivs $ \ (fwid, body, sender, sig) -> fork $ do
+            waitsD <- for delivs $ \ (fwid, body, (fwder, sender), sig) -> fork $ do
                 e <- forwardActivity (ObjURI h inbox) sig sender body
                 case e of
                     Left _err -> return False
                     Right _resp -> do
-                        runSiteDB $ delete fwid
+                        runSiteDB $ do
+                            case fwder of
+                                FwderProject k -> delete k
+                                FwderSharer k -> delete k
+                            delete fwid
                         return True
             results <- sequence waitsD
             runSiteDB $

src/Vervis/Federation/Discussion.hs

@@ -73,113 +73,18 @@ import Vervis.Model.Ident
 import Vervis.Settings
 import Vervis.Ticket
 
-sharerCreateNoteF
+-- | Check the note in the remote Create Note activity delivered to us.
-    :: UTCTime
+checkNote
-    -> ShrIdent
+    :: Note URIMode
-    -> RemoteAuthor
+    -> ExceptT Text Handler
-    -> ActivityBody
+        ( LocalURI
-    -> Note URIMode
+        , UTCTime
-    -> ExceptT Text Handler Text
+        , Either NoteContext FedURI
-sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext mpublished _ _) = do
+        , Maybe (Either (ShrIdent, LocalMessageId) FedURI)
-    luCreate <-
+        , Text
-        fromMaybeE (activityId $ actbActivity body) "Create without 'id'"
+        , Text
-    _luNote <- fromMaybeE mluNote "Note without note id"
+        )
-    _published <- fromMaybeE mpublished "Note without 'published' field"
+checkNote (Note mluNote _ _ muParent muCtx mpub source content) = do
-    uContext <- fromMaybeE muContext "Note without context"
-    context <- parseContext uContext
-    mparent <-
-        case muParent of
-            Nothing -> return Nothing
-            Just uParent ->
-                if uParent == uContext
-                    then return Nothing
-                    else Just <$> parseParent uParent
-    ExceptT $ runDB $ do
-        personRecip <- do
-            sid <- getKeyBy404 $ UniqueSharer shrRecip
-            getValBy404 $ UniquePersonIdent sid
-        valid <- checkContextParent context mparent
-        case valid of
-            Left e -> return $ Left e
-            Right _ ->
-                Right <$> insertToInbox luCreate (personInbox personRecip)
-    where
-    checkContextParent (Left context) mparent = runExceptT $ do
-        did <-
-            case context of
-                NoteContextSharerTicket shr talid -> do
-                    (_, Entity _ lt, _, project) <- do
-                        mticket <- lift $ getSharerTicket shr talid
-                        fromMaybeE mticket "Note context no such local sharer-hosted ticket"
-                    return $ localTicketDiscuss lt
-                NoteContextProjectTicket shr prj ltid -> do
-                    (_, _, _, Entity _ lt, _, _) <- do
-                        mticket <- lift $ getProjectTicket shr prj ltid
-                        fromMaybeE mticket "Note context no such local project-hosted ticket"
-                    return $ localTicketDiscuss lt
-        for_ mparent $ \ parent ->
-            case parent of
-                Left (shrP, lmidP) ->
-                    void $ getLocalParentMessageId did shrP lmidP
-                Right (ObjURI hParent luParent) -> do
-                    mrm <- lift $ runMaybeT $ do
-                        iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
-                        roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent
-                        MaybeT $ getValBy $ UniqueRemoteMessageIdent roid
-                    for_ mrm $ \ rm -> do
-                        let mid = remoteMessageRest rm
-                        m <- lift $ getJust mid
-                        unless (messageRoot m == did) $
-                            throwE "Remote parent belongs to a different discussion"
-    checkContextParent (Right (ObjURI hContext luContext)) mparent = runExceptT $ do
-        mdid <- lift $ runMaybeT $ do
-            iid <- MaybeT $ getKeyBy $ UniqueInstance hContext
-            roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luContext
-            rd <- MaybeT $ getValBy $ UniqueRemoteDiscussionIdent roid
-            return $ remoteDiscussionDiscuss rd
-        for_ mparent $ \ parent ->
-            case parent of
-                Left (shrP, lmidP) -> do
-                    did <- fromMaybeE mdid "Local parent inexistent, no RemoteDiscussion"
-                    void $ getLocalParentMessageId did shrP lmidP
-                Right (ObjURI hParent luParent) -> do
-                    mrm <- lift $ runMaybeT $ do
-                        iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
-                        roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent
-                        MaybeT $ getValBy $ UniqueRemoteMessageIdent roid
-                    for_ mrm $ \ rm -> do
-                        let mid = remoteMessageRest rm
-                        m <- lift $ getJust mid
-                        did <- fromMaybeE mdid "Remote parent known, but no context RemoteDiscussion"
-                        unless (messageRoot m == did) $
-                            throwE "Remote parent belongs to a different discussion"
-    insertToInbox luCreate ibidRecip = do
-        let iidAuthor = remoteAuthorInstance author
-        roid <-
-            either entityKey id <$> insertBy' (RemoteObject iidAuthor luCreate)
-        let jsonObj = persistJSONFromBL $ actbBL body
-            ract = RemoteActivity roid jsonObj now
-        ractid <- either entityKey id <$> insertBy' ract
-        ibiid <- insert $ InboxItem True
-        mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid
-        let recip = shr2text shrRecip
-        case mibrid of
-            Nothing -> do
-                delete ibiid
-                return $ "Activity already exists in inbox of /s/" <> recip
-            Just _ -> return $ "Activity inserted to inbox of /s/" <> recip
-
-projectCreateNoteF
-    :: UTCTime
-    -> ShrIdent
-    -> PrjIdent
-    -> RemoteAuthor
-    -> ActivityBody
-    -> Note URIMode
-    -> ExceptT Text Handler Text
-projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent muCtx mpub src content) = do
-    luCreate <-
-        fromMaybeE (activityId $ actbActivity body) "Create without 'id'"
     luNote <- fromMaybeE mluNote "Note without note id"
     published <- fromMaybeE mpub "Note without 'published' field"
     uContext <- fromMaybeE muCtx "Note without context"
@@ -191,93 +96,19 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
                 if uParent == uContext
                     then return Nothing
                     else Just <$> parseParent uParent
-    (localRecips, _remoteRecips) <- do
+    return (luNote, published, context, mparent, source, content)
-        mrecips <- parseAudience $ activityAudience $ actbActivity body
+
-        fromMaybeE mrecips "Create Note with no recipients"
+-- | Insert a remote activity delivered to us into our inbox. Return its
-    msig <- checkForward shrRecip prjRecip
+-- database ID if the activity wasn't already in our inbox.
-    case context of
+insertToInbox
-        Right _ -> return "Not using; context isn't local"
+    :: UTCTime
-        Left (NoteContextSharerTicket shr talid) -> do
+    -> RemoteAuthor
-            mremotesHttp <- runDBExcept $ do
+    -> ActivityBody
-                (jid, ibid) <- lift getProjectRecip404
+    -> InboxId
-                (_, _, _, project) <- do
+    -> LocalURI
-                    mticket <- lift $ getSharerTicket shr talid
+    -> Bool
-                    fromMaybeE mticket "Context: No such sharer-ticket"
+    -> AppDB (Maybe RemoteActivityId)
-                case project of
+insertToInbox now author body ibid luCreate unread = do
-                    Left (Entity _ tpl)
-                        | ticketProjectLocalProject tpl == jid -> do
-                            mractid <- lift $ insertToProjectInbox ibid luCreate
-                            case mractid of
-                                Nothing -> return $ Left "Activity already in my inbox"
-                                Just ractid ->
-                                    case msig of
-                                        Nothing ->
-                                            return $ Left
-                                                "Context is a sharer-ticket, \
-                                                \but no inbox forwarding \
-                                                \header for me, so doing \
-                                                \nothing, just storing in inbox"
-                                        Just sig -> lift $ Right <$> do
-                                            let sieve =
-                                                    makeRecipientSet
-                                                        []
-                                                        [ LocalPersonCollectionProjectFollowers shrRecip prjRecip
-                                                        , LocalPersonCollectionProjectTeam shrRecip prjRecip
-                                                        ]
-                                            remoteRecips <- insertRemoteActivityToLocalInboxes False ractid $ localRecipSieve' sieve False False localRecips
-                                            (sig,) <$> deliverRemoteDB (actbBL body) ractid jid sig remoteRecips
-                    _ -> return $ Left "Context is a sharer-ticket of another project"
-            case mremotesHttp of
-                Left msg -> return msg
-                Right (sig, remotesHttp) -> do
-                    forkWorker "projectCreateNoteF inbox forwarding by http" $ deliverRemoteHTTP now shrRecip prjRecip (actbBL body) sig remotesHttp
-                    return "Stored to inbox and did inbox forwarding"
-        Left (NoteContextProjectTicket shr prj ltid) -> do
-            mremotesHttp <- runDBExcept $ do
-                (jid, ibid) <- lift getProjectRecip404
-                (_, _, _, Entity _ lt, Entity _ tpl, _) <- do
-                    mticket <- lift $ getProjectTicket shr prj ltid
-                    fromMaybeE mticket "Context: No such project-ticket"
-                if ticketProjectLocalProject tpl == jid
-                    then do
-                        mractid <- lift $ insertToProjectInbox ibid luCreate
-                        case mractid of
-                            Nothing -> return $ Left "Activity already in my inbox"
-                            Just ractid -> do
-                                let did = localTicketDiscuss lt
-                                meparent <- traverse (getParent did) mparent
-                                mmid <- lift $ insertToDiscussion luNote published did meparent ractid
-                                case mmid of
-                                    Nothing -> return $ Left "I already have this comment, just storing in inbox"
-                                    Just mid -> lift $ do
-                                        updateOrphans luNote did mid
-                                        case msig of
-                                            Nothing ->
-                                                return $ Left "Storing in inbox, caching comment, no inbox forwarding header"
-                                            Just sig -> Right <$> do
-                                                ltkhid <- encodeKeyHashid ltid
-                                                let sieve =
-                                                        makeRecipientSet
-                                                            []
-                                                            [ LocalPersonCollectionProjectFollowers shrRecip prjRecip
-                                                            , LocalPersonCollectionProjectTeam shrRecip prjRecip
-                                                            , LocalPersonCollectionProjectTicketFollowers shrRecip prjRecip ltkhid
-                                                            , LocalPersonCollectionProjectTicketTeam shrRecip prjRecip ltkhid
-                                                            ]
-                                                remoteRecips <- insertRemoteActivityToLocalInboxes False ractid $ localRecipSieve' sieve False False localRecips
-                                                (sig,) <$> deliverRemoteDB (actbBL body) ractid jid sig remoteRecips
-                    else return $ Left "Context is a project-ticket of another project"
-            case mremotesHttp of
-                Left msg -> return msg
-                Right (sig, remotesHttp) -> do
-                    forkWorker "projectCreateNoteF inbox forwarding by http" $ deliverRemoteHTTP now shrRecip prjRecip (actbBL body) sig remotesHttp
-                    return "Stored to inbox, cached comment, and did inbox forwarding"
-    where
-    getProjectRecip404 = do
-        sid <- getKeyBy404 $ UniqueSharer shrRecip
-        Entity jid j <- getBy404 $ UniqueProject prjRecip sid
-        return (jid, projectInbox j)
-    insertToProjectInbox ibid luCreate = do
     let iidAuthor = remoteAuthorInstance author
     roid <-
         either entityKey id <$> insertBy' (RemoteObject iidAuthor luCreate)
@@ -286,14 +117,22 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
         , remoteActivityContent  = persistJSONFromBL $ actbBL body
         , remoteActivityReceived = now
         }
-        ibiid <- insert $ InboxItem False
+    ibiid <- insert $ InboxItem unread
     new <- isRight <$> insertBy' (InboxItemRemote ibid ractid ibiid)
     return $
         if new
             then Just ractid
             else Nothing
-    getParent did (Left (shrParent, lmidParent)) = Left <$> getLocalParentMessageId did shrParent lmidParent
+
-    getParent did (Right p@(ObjURI hParent luParent)) = do
+-- | Given the parent specified by the Note we received, check if we already
+-- know and have this parent note in the DB, and whether the child and parent
+-- belong to the same discussion root.
+getParent
+    :: DiscussionId
+    -> Either (ShrIdent, LocalMessageId) FedURI
+    -> ExceptT Text AppDB (Either MessageId FedURI)
+getParent did (Left (shr, lmid)) = Left <$> getLocalParentMessageId did shr lmid
+getParent did (Right p@(ObjURI hParent luParent)) = do
     mrm <- lift $ runMaybeT $ do
         iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
         roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent
@@ -306,12 +145,26 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
                 throwE "Remote parent belongs to a different discussion"
             return mid
         Nothing -> return $ Right p
-    insertToDiscussion luNote published did meparent ractid = do
+
+-- | Insert the new remote comment into the discussion tree. If we didn't have
+-- this comment before, return the database ID of the newly created cached
+-- comment.
+insertToDiscussion
+    :: RemoteAuthor
+    -> LocalURI
+    -> UTCTime
+    -> Text
+    -> Text
+    -> DiscussionId
+    -> Maybe (Either MessageId FedURI)
+    -> RemoteActivityId
+    -> AppDB (Maybe MessageId)
+insertToDiscussion author luNote published source content did meparent ractid = do
     let iidAuthor = remoteAuthorInstance author
         raidAuthor = remoteAuthorId author
     mid <- insert Message
         { messageCreated = published
-            , messageSource  = src
+        , messageSource  = source
         , messageContent = content
         , messageParent  =
             case meparent of
@@ -336,7 +189,17 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
             delete mid
             return Nothing
         Just _ -> return $ Just mid
-    updateOrphans luNote did mid = do
+
+-- | Look for known remote comments in the database, whose parent was unknown
+-- but turns out to be the new comment we just received. Fix that in the
+-- database and log warnings about it.
+updateOrphans
+    :: RemoteAuthor
+    -> LocalURI
+    -> DiscussionId
+    -> MessageId
+    -> AppDB ()
+updateOrphans author luNote did mid = do
     let hAuthor = objUriAuthority $ remoteAuthorURI author
         uNote = ObjURI hAuthor luNote
     related <- selectOrphans uNote (E.==.)
@@ -366,3 +229,208 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
                 rm E.^. RemoteMessageLostParent E.==. E.just (E.val uNote) E.&&.
                 m E.^. MessageRoot `op` E.val did
             return (rm E.^. RemoteMessageId, m E.^. MessageId)
+
+sharerCreateNoteF
+    :: UTCTime
+    -> ShrIdent
+    -> RemoteAuthor
+    -> ActivityBody
+    -> Note URIMode
+    -> ExceptT Text Handler Text
+sharerCreateNoteF now shrRecip author body note = do
+    luCreate <-
+        fromMaybeE (activityId $ actbActivity body) "Create without 'id'"
+    (luNote, published, context, mparent, source, content) <- checkNote note
+    (localRecips, _remoteRecips) <- do
+        mrecips <- parseAudience $ activityAudience $ actbActivity body
+        fromMaybeE mrecips "Create Note with no recipients"
+    msig <- checkForward $ LocalActorSharer shrRecip
+    case context of
+        Right uContext -> runDBExcept $ do
+            personRecip <- lift $ do
+                sid <- getKeyBy404 $ UniqueSharer shrRecip
+                getValBy404 $ UniquePersonIdent sid
+            checkContextParent uContext mparent
+            mractid <- lift $ insertToInbox now author body (personInbox personRecip) luCreate True
+            return $
+                case mractid of
+                    Nothing -> "I already have this activity in my inbox, doing nothing"
+                    Just _ -> "Context is remote, so just inserting to my inbox"
+        Left (NoteContextSharerTicket shr talid) -> do
+            mremotesHttp <- runDBExcept $ do
+                (sid, pid, ibid) <- lift getRecip404
+                (Entity _ tal, Entity _ lt, _, _) <- do
+                    mticket <- lift $ getSharerTicket shr talid
+                    fromMaybeE mticket "Context: No such sharer-ticket"
+                if ticketAuthorLocalAuthor tal == pid
+                    then do
+                        mractid <- lift $ insertToInbox now author body ibid luCreate True
+                        case mractid of
+                            Nothing -> return $ Left "Activity already in my inbox"
+                            Just ractid -> do
+                                let did = localTicketDiscuss lt
+                                meparent <- traverse (getParent did) mparent
+                                mmid <- lift $ insertToDiscussion author luNote published source content did meparent ractid
+                                case mmid of
+                                    Nothing -> return $ Left "I already have this comment, just storing in inbox"
+                                    Just mid -> lift $ do
+                                        updateOrphans author luNote did mid
+                                        case msig of
+                                            Nothing ->
+                                                return $ Left "Storing in inbox, caching comment, no inbox forwarding header"
+                                            Just sig -> Right <$> do
+                                                talkhid <- encodeKeyHashid talid
+                                                let sieve =
+                                                        makeRecipientSet
+                                                            []
+                                                            [ LocalPersonCollectionSharerTicketFollowers shrRecip talkhid
+                                                            , LocalPersonCollectionSharerTicketTeam shrRecip talkhid
+                                                            ]
+                                                remoteRecips <- insertRemoteActivityToLocalInboxes False ractid $ localRecipSieve' sieve False False localRecips
+                                                (sig,) <$> deliverRemoteDB_S (actbBL body) ractid sid sig remoteRecips
+                    else return $ Left "Context is a sharer-ticket of another sharer"
+            case mremotesHttp of
+                Left msg -> return msg
+                Right (sig, remotesHttp) -> do
+                    forkWorker "sharerCreateNoteF inbox forwarding by http" $ deliverRemoteHTTP_S now shrRecip (actbBL body) sig remotesHttp
+                    return "Stored to inbox, cached comment, and did inbox forwarding"
+        Left (NoteContextProjectTicket shr prj ltid) -> runDBExcept $ do
+            personRecip <- lift $ do
+                sid <- getKeyBy404 $ UniqueSharer shrRecip
+                getValBy404 $ UniquePersonIdent sid
+            (_, _, _, Entity _ lt, _, _) <- do
+                mticket <- lift $ getProjectTicket shr prj ltid
+                fromMaybeE mticket "Context: No such project-ticket"
+            let did = localTicketDiscuss lt
+            _ <- traverse (getParent did) mparent
+            mractid <- lift $ insertToInbox now author body (personInbox personRecip) luCreate True
+            return $
+                case mractid of
+                    Nothing -> "I already have this activity in my inbox, doing nothing"
+                    Just _ -> "Context is a project-ticket, so just inserting to my inbox"
+    where
+    getRecip404 = do
+        sid <- getKeyBy404 $ UniqueSharer shrRecip
+        Entity pid p <- getBy404 $ UniquePersonIdent sid
+        return (sid, pid, personInbox p)
+    checkContextParent (ObjURI hContext luContext) mparent = do
+        mdid <- lift $ runMaybeT $ do
+            iid <- MaybeT $ getKeyBy $ UniqueInstance hContext
+            roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luContext
+            rd <- MaybeT $ getValBy $ UniqueRemoteDiscussionIdent roid
+            return $ remoteDiscussionDiscuss rd
+        for_ mparent $ \ parent ->
+            case parent of
+                Left (shrP, lmidP) -> do
+                    did <- fromMaybeE mdid "Local parent inexistent, no RemoteDiscussion"
+                    void $ getLocalParentMessageId did shrP lmidP
+                Right (ObjURI hParent luParent) -> do
+                    mrm <- lift $ runMaybeT $ do
+                        iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
+                        roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent
+                        MaybeT $ getValBy $ UniqueRemoteMessageIdent roid
+                    for_ mrm $ \ rm -> do
+                        let mid = remoteMessageRest rm
+                        m <- lift $ getJust mid
+                        did <- fromMaybeE mdid "Remote parent known, but no context RemoteDiscussion"
+                        unless (messageRoot m == did) $
+                            throwE "Remote parent belongs to a different discussion"
+
+projectCreateNoteF
+    :: UTCTime
+    -> ShrIdent
+    -> PrjIdent
+    -> RemoteAuthor
+    -> ActivityBody
+    -> Note URIMode
+    -> ExceptT Text Handler Text
+projectCreateNoteF now shrRecip prjRecip author body note = do
+    luCreate <-
+        fromMaybeE (activityId $ actbActivity body) "Create without 'id'"
+    (luNote, published, context, mparent, source, content) <- checkNote note
+    (localRecips, _remoteRecips) <- do
+        mrecips <- parseAudience $ activityAudience $ actbActivity body
+        fromMaybeE mrecips "Create Note with no recipients"
+    msig <- checkForward $ LocalActorProject shrRecip prjRecip
+    case context of
+        Right _ -> return "Not using; context isn't local"
+        Left (NoteContextSharerTicket shr talid) -> do
+            mremotesHttp <- runDBExcept $ do
+                (jid, ibid) <- lift getProjectRecip404
+                (_, _, _, project) <- do
+                    mticket <- lift $ getSharerTicket shr talid
+                    fromMaybeE mticket "Context: No such sharer-ticket"
+                case project of
+                    Left (Entity _ tpl)
+                        | ticketProjectLocalProject tpl == jid -> do
+                            mractid <- lift $ insertToInbox now author body ibid luCreate False
+                            case mractid of
+                                Nothing -> return $ Left "Activity already in my inbox"
+                                Just ractid ->
+                                    case msig of
+                                        Nothing ->
+                                            return $ Left
+                                                "Context is a sharer-ticket, \
+                                                \but no inbox forwarding \
+                                                \header for me, so doing \
+                                                \nothing, just storing in inbox"
+                                        Just sig -> lift $ Right <$> do
+                                            let sieve =
+                                                    makeRecipientSet
+                                                        []
+                                                        [ LocalPersonCollectionProjectFollowers shrRecip prjRecip
+                                                        , LocalPersonCollectionProjectTeam shrRecip prjRecip
+                                                        ]
+                                            remoteRecips <- insertRemoteActivityToLocalInboxes False ractid $ localRecipSieve' sieve False False localRecips
+                                            (sig,) <$> deliverRemoteDB_J (actbBL body) ractid jid sig remoteRecips
+                    _ -> return $ Left "Context is a sharer-ticket of another project"
+            case mremotesHttp of
+                Left msg -> return msg
+                Right (sig, remotesHttp) -> do
+                    forkWorker "projectCreateNoteF inbox forwarding by http" $ deliverRemoteHTTP_J now shrRecip prjRecip (actbBL body) sig remotesHttp
+                    return "Stored to inbox and did inbox forwarding"
+        Left (NoteContextProjectTicket shr prj ltid) -> do
+            mremotesHttp <- runDBExcept $ do
+                (jid, ibid) <- lift getProjectRecip404
+                (_, _, _, Entity _ lt, Entity _ tpl, _) <- do
+                    mticket <- lift $ getProjectTicket shr prj ltid
+                    fromMaybeE mticket "Context: No such project-ticket"
+                if ticketProjectLocalProject tpl == jid
+                    then do
+                        mractid <- lift $ insertToInbox now author body ibid luCreate False
+                        case mractid of
+                            Nothing -> return $ Left "Activity already in my inbox"
+                            Just ractid -> do
+                                let did = localTicketDiscuss lt
+                                meparent <- traverse (getParent did) mparent
+                                mmid <- lift $ insertToDiscussion author luNote published source content did meparent ractid
+                                case mmid of
+                                    Nothing -> return $ Left "I already have this comment, just storing in inbox"
+                                    Just mid -> lift $ do
+                                        updateOrphans author luNote did mid
+                                        case msig of
+                                            Nothing ->
+                                                return $ Left "Storing in inbox, caching comment, no inbox forwarding header"
+                                            Just sig -> Right <$> do
+                                                ltkhid <- encodeKeyHashid ltid
+                                                let sieve =
+                                                        makeRecipientSet
+                                                            []
+                                                            [ LocalPersonCollectionProjectFollowers shrRecip prjRecip
+                                                            , LocalPersonCollectionProjectTeam shrRecip prjRecip
+                                                            , LocalPersonCollectionProjectTicketFollowers shrRecip prjRecip ltkhid
+                                                            , LocalPersonCollectionProjectTicketTeam shrRecip prjRecip ltkhid
+                                                            ]
+                                                remoteRecips <- insertRemoteActivityToLocalInboxes False ractid $ localRecipSieve' sieve False False localRecips
+                                                (sig,) <$> deliverRemoteDB_J (actbBL body) ractid jid sig remoteRecips
+                    else return $ Left "Context is a project-ticket of another project"
+            case mremotesHttp of
+                Left msg -> return msg
+                Right (sig, remotesHttp) -> do
+                    forkWorker "projectCreateNoteF inbox forwarding by http" $ deliverRemoteHTTP_J now shrRecip prjRecip (actbBL body) sig remotesHttp
+                    return "Stored to inbox, cached comment, and did inbox forwarding"
+    where
+    getProjectRecip404 = do
+        sid <- getKeyBy404 $ UniqueSharer shrRecip
+        Entity jid j <- getBy404 $ UniqueProject prjRecip sid
+        return (jid, projectInbox j)

src/Vervis/Federation/Ticket.hs

@@ -211,7 +211,7 @@ projectOfferTicketF
                 hLocal <- getsYesod siteInstanceHost
                 {-deps <- -}
                 checkOffer ticket hLocal shrRecip prjRecip
-                msig <- checkForward shrRecip prjRecip
+                msig <- checkForward $ LocalActorProject shrRecip prjRecip
                 let colls =
                         findRelevantCollections shrRecip prjRecip hLocal $
                             activityAudience $ actbActivity body
@@ -225,13 +225,13 @@ projectOfferTicketF
                         for mticket $ \ (ractid, obiidAccept, docAccept) -> do
                             msr <- for msig $ \ sig -> do
                                 remoteRecips <- deliverFwdLocal ractid colls sid fsid
-                                (sig,) <$> deliverRemoteDB (actbBL body) ractid jid sig remoteRecips
+                                (sig,) <$> deliverRemoteDB_J (actbBL body) ractid jid sig remoteRecips
                             return (msr, obiidAccept, docAccept)
                 lift $ for_ mremotesHttp $ \ (msr, obiidAccept, docAccept) -> do
                     let handler e = logError $ "Project Accept sender: delivery failed! " <> T.pack (displayException e)
                     for msr $ \ (sig, remotesHttp) -> do
                         forkHandler handler $
-                            deliverRemoteHTTP now shrRecip prjRecip (actbBL body) sig remotesHttp
+                            deliverRemoteHTTP_J now shrRecip prjRecip (actbBL body) sig remotesHttp
                     forkHandler handler $ publishAccept luOffer obiidAccept docAccept
                 return $ recip <> " inserted new ticket"
     where
@@ -541,7 +541,7 @@ projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do
     case targetAndContext of
         Left (_, shrContext, prjContext)
             | shrRecip == shrContext && prjRecip == prjContext -> do
-                msig <- checkForward shrRecip prjRecip
+                msig <- checkForward $ LocalActorProject shrRecip prjRecip
                 msgOrRecips <- lift $ runDB $ do
                     (sidProject, jid, obidProject, ibidProject, fsidProject) <- getProject
                     mractidCreate <- insertCreate luCreate ibidProject
@@ -562,7 +562,7 @@ projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do
                                     let colls = findRelevantCollections shrRecip prjRecip hLocal $ activityAudience $ actbActivity body
                                     mremoteRecipsHttpCreateFwd <- for msig $ \ sig -> do
                                         remoteRecips <- deliverFwdLocal ractidCreate colls sidProject fsidProject
-                                        (sig,) <$> deliverRemoteDB (actbBL body) ractidCreate jid sig remoteRecips
+                                        (sig,) <$> deliverRemoteDB_J (actbBL body) ractidCreate jid sig remoteRecips
                                     remoteRecipsHttpAccept <- do
                                         moreRemoteRecipsAccept <- deliverLocal' False (LocalActorProject shrRecip prjRecip) ibidProject obiidAccept localRecipsAccept
                                         deliverRemoteDB' fwdAccept obiidAccept remoteRecipsAccept moreRemoteRecipsAccept
@@ -570,7 +570,7 @@ projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do
                 case msgOrRecips of
                     Left msg -> return msg
                     Right (mremoteRecipsHttpCreateFwd, remoteRecipsHttpAccept, obiidAccept, docAccept, fwdAccept) -> do
-                        for_ mremoteRecipsHttpCreateFwd $ \ (sig, recips) -> forkWorker "projectCreateTicketF inbox forwarding" $ deliverRemoteHTTP now shrRecip prjRecip (actbBL body) sig recips
+                        for_ mremoteRecipsHttpCreateFwd $ \ (sig, recips) -> forkWorker "projectCreateTicketF inbox forwarding" $ deliverRemoteHTTP_J now shrRecip prjRecip (actbBL body) sig recips
                         forkWorker "projectCreateTicketF deliver Accept" $ deliverRemoteHttp fwdAccept obiidAccept docAccept remoteRecipsHttpAccept
                         return "Accepting and listing new remote author hosted ticket"
         _ -> return "Create/Ticket against different project, ignoring"

src/Vervis/Migration.hs

@@ -1552,6 +1552,16 @@ changes hLocal ctx =
         "RemoteDiscussion"
       -- 239
     , addUnique "RemoteTicket" $ Unique "UniqueRemoteTicketDiscuss" ["discuss"]
+      -- 240
+    , addEntities model_2020_05_12
+      -- 241
+    , unchecked $ lift $ do
+        fwds <- selectList ([] :: [Filter Forwarding241]) []
+        let makeSender (Entity fwdid fwd) =
+                ForwarderProject241 fwdid (forwarding241Sender fwd)
+        insertMany_ $ map makeSender fwds
+      -- 242
+    , removeField "Forwarding" "sender"
     ]
 
 migrateDB

src/Vervis/Migration/Model.hs

@@ -189,6 +189,10 @@ module Vervis.Migration.Model
     , RemoteObject238Generic (..)
     , Discussion238Generic (..)
     , RemoteDiscussion238Generic (..)
+    , model_2020_05_12
+    , Forwarding241
+    , Forwarding241Generic (..)
+    , ForwarderProject241Generic (..)
     )
 where
 
@@ -371,3 +375,9 @@ model_2020_04_09 :: [Entity SqlBackend]
 model_2020_04_09 = $(schema "2020_04_09_rt")
 
 makeEntitiesMigration "238" $(modelFile "migrations/2020_04_10_rt_rd.model")
+
+model_2020_05_12 :: [Entity SqlBackend]
+model_2020_05_12 = $(schema "2020_05_12_fwd_sender")
+
+makeEntitiesMigration "241"
+    $(modelFile "migrations/2020_05_12_fwd_sender_mig.model")