C2S: Reimplement offerTicketC using the new tools

src/Vervis/API.hs

@@ -115,33 +115,6 @@ import Vervis.Settings
 import Vervis.Patch
 import Vervis.Ticket
 
-verifyIsLoggedInUser
-    :: LocalURI
-    -> Text
-    -> ExceptT Text AppDB (PersonId, OutboxId, ShrIdent)
-verifyIsLoggedInUser lu t = do
-    Entity pid p <- requireVerifiedAuth
-    s <- lift $ getJust $ personIdent p
-    route2local <- getEncodeRouteLocal
-    let shr = sharerIdent s
-    if route2local (SharerR shr) == lu
-        then return (pid, personOutbox p, shr)
-        else throwE t
-
-verifyAuthor
-    :: ShrIdent
-    -> LocalURI
-    -> Text
-    -> ExceptT Text AppDB (PersonId, OutboxId)
-verifyAuthor shr lu t = ExceptT $ do
-    Entity sid s <- getBy404 $ UniqueSharer shr
-    Entity pid p <- getBy404 $ UniquePersonIdent sid
-    encodeRouteLocal <- getEncodeRouteLocal
-    return $
-        if encodeRouteLocal (SharerR shr) == lu
-            then Right (pid, personOutbox p)
-            else Left t
-
 parseComment :: LocalURI -> ExceptT Text Handler (ShrIdent, LocalMessageId)
 parseComment luParent = do
     route <- case decodeRouteLocal luParent of
@@ -508,6 +481,20 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge
         update obiidCreate [OutboxItemActivity =. persistJSONObjectFromDoc create]
         return create
 
+checkFederation remoteRecips = do
+    federation <- asksSite $ appFederation . appSettings
+    unless (federation || null remoteRecips) $
+        throwE "Federation disabled, but remote recipients found"
+
+verifyProjectRecip (Right _)         _           = return ()
+verifyProjectRecip (Left (shr, prj)) localRecips =
+    fromMaybeE verify "Local context project isn't listed as a recipient"
+    where
+    verify = do
+        sharerSet <- lookup shr localRecips
+        projectSet <- lookup prj $ localRecipProjectRelated sharerSet
+        guard $ localRecipProject $ localRecipProjectDirect projectSet
+
 -- | Handle a Ticket submitted by a local user to their outbox. The ticket's
 -- context project may be local or remote. Return an error message if the
 -- Ticket is rejected, otherwise the new 'TicketAuthorLocalId'.
@@ -602,20 +589,6 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
                     _ -> throwE "Ticket context isn't a project route"
             else return $ Right u
 
-    checkFederation remoteRecips = do
-        federation <- asksSite $ appFederation . appSettings
-        unless (federation || null remoteRecips) $
-            throwE "Federation disabled, but remote recipients found"
-
-    verifyProjectRecip (Right _)         _           = return ()
-    verifyProjectRecip (Left (shr, prj)) localRecips =
-        fromMaybeE verify "Local context project isn't listed as a recipient"
-        where
-        verify = do
-            sharerSet <- lookup shr localRecips
-            projectSet <- lookup prj $ localRecipProjectRelated sharerSet
-            guard $ localRecipProject $ localRecipProjectDirect projectSet
-
     fetchTracker c u@(ObjURI h lu) = do
         hl <- hostIsLocal h
         case (hl, c) of
@@ -639,14 +612,6 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
                             return (iid, era)
                 return (iid, era, if lu == lu' then Nothing else Just lu')
 
-    insertEmptyOutboxItem obid now = do
-        h <- asksSite siteInstanceHost
-        insert OutboxItem
-            { outboxItemOutbox    = obid
-            , outboxItemActivity  = persistJSONObjectFromDoc $ Doc h emptyActivity
-            , outboxItemPublished = now
-            }
-
     prepareProject now (Left (shr, prj)) = Left <$> do
         mej <- lift $ runMaybeT $ do
             sid <- MaybeT $ getKeyBy $ UniqueSharer shr
@@ -997,279 +962,198 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = do
         insert_ $ InboxItemLocal ibidAuthor obiidAccept ibiid
 
 offerTicketC
-    :: ShrIdent
+    :: Entity Person
+    -> Sharer
     -> Maybe TextHtml
     -> Audience URIMode
     -> AP.Ticket URIMode
     -> FedURI
     -> ExceptT Text Handler OutboxItemId
-offerTicketC shrUser summary audience ticket uTarget = do
+offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTarget = do
-    (hProject, shrProject, prjProject) <- parseTarget uTarget
+    let shrUser = sharerIdent sharerUser
-    {-deps <- -}
+    (title, desc, source, target) <- checkTicket shrUser ticket uTarget
-    checkOffer hProject shrProject prjProject
     (localRecips, remoteRecips) <- do
         mrecips <- parseAudience audience
-        fromMaybeE mrecips "Offer with no recipients"
+        fromMaybeE mrecips "Offer Ticket with no recipients"
     federation <- asksSite $ appFederation . appSettings
     unless (federation || null remoteRecips) $
         throwE "Federation disabled, but remote recipients specified"
-    checkRecips hProject shrProject prjProject localRecips
+    verifyProjectRecip target localRecips
     now <- liftIO getCurrentTime
-    (obiid, doc, remotesHttp) <- runDBExcept $ do
+    (obiidOffer, docOffer, remotesHttpOffer, maybeAccept) <- runDBExcept $ do
-        (pidAuthor, obidAuthor) <-
+        mproject <-
-            verifyAuthor
+            case target of
-                shrUser
+                Left (shr, prj) -> Just <$> do
-                (AP.ticketAttributedTo ticket)
+                    mproj <- lift $ runMaybeT $ do
-                "Ticket attributed to different actor"
+                        Entity sid s <- MaybeT $ getBy $ UniqueSharer shr
-        mprojAndDeps <- do
+                        ej <- MaybeT $ getBy $ UniqueProject prj sid
-            targetIsLocal <- hostIsLocal hProject
+                        return (s, ej)
-            if targetIsLocal
+                    fromMaybeE mproj "Offer target no such local project in DB"
-                then Just <$> getProjectAndDeps shrProject prjProject {-deps-}
+                Right _ -> return Nothing
-                else return Nothing
+        (obiid, doc, luOffer) <- lift $ insertOfferToOutbox shrUser now (personOutbox personUser)
-        (obiid, doc, luOffer) <- lift $ insertToOutbox now obidAuthor
+        remotesHttpOffer <- do
-        moreRemotes <-
+            let sieve =
-            lift $ deliverLocal pidAuthor shrProject prjProject now mprojAndDeps obiid luOffer localRecips
+                    case target of
-        unless (federation || null moreRemotes) $
+                        Left (shr, prj) ->
-            throwE "Federation disabled but remote collection members found"
+                            makeRecipientSet
-        remotesHttp <- lift $ deliverRemoteDB' hProject obiid remoteRecips moreRemotes
+                                [ LocalActorProject shr prj
-        return (obiid, doc, remotesHttp)
+                                ]
-    lift $ forkWorker "Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp hProject obiid doc remotesHttp
+                                [ LocalPersonCollectionSharerFollowers shrUser
-    return obiid
+                                , LocalPersonCollectionProjectTeam shr prj
+                                , LocalPersonCollectionProjectFollowers shr prj
+                                ]
+                        Right _ ->
+                            makeRecipientSet
+                                []
+                                [LocalPersonCollectionSharerFollowers shrUser]
+            moreRemoteRecips <-
+                lift $
+                    deliverLocal'
+                        True
+                        (LocalActorSharer shrUser)
+                        (personInbox personUser)
+                        obiid
+                        (localRecipSieve sieve False localRecips)
+            unless (federation || null moreRemoteRecips) $
+                throwE "Federation disabled, but recipient collection remote members found"
+            lift $ deliverRemoteDB' (objUriAuthority uTarget) obiid remoteRecips moreRemoteRecips
+        maccept <- lift $ for mproject $ \ (s, Entity jid j) -> do
+            let shrJ = sharerIdent s
+                prj = projectIdent j
+            obiidAccept <- insertEmptyOutboxItem (projectOutbox j) now
+            ltid <- insertTicket pidUser now title desc source jid obiid obiidAccept
+            (docAccept, localRecipsAccept) <- insertAccept shrUser luOffer shrJ prj obiidAccept ltid
+            knownRemoteRecipsAccept <-
+                deliverLocal'
+                    False
+                    (LocalActorProject shrJ prj)
+                    (projectInbox j)
+                    obiidAccept
+                    localRecipsAccept
+            (obiidAccept,docAccept,) <$> deliverRemoteDB'' [] obiidAccept [] knownRemoteRecipsAccept
+        return (obiid, doc, remotesHttpOffer, maccept)
+    lift $ do
+        forkWorker "offerTicketC: async HTTP Offer delivery" $ deliverRemoteHttp (objUriAuthority uTarget) obiidOffer docOffer remotesHttpOffer
+        for_ maybeAccept $ \ (obiidAccept, docAccept, remotesHttpAccept) ->
+            forkWorker "offerTicketC: async HTTP Accept delivery" $ deliverRemoteHttp' [] obiidAccept docAccept remotesHttpAccept
+    return obiidOffer
     where
-    checkOffer hProject shrProject prjProject = do
+    checkTicket
-        verifyNothingE (AP.ticketLocal ticket) "Ticket with 'id'"
+        shrUser
-        verifyNothingE (AP.ticketPublished ticket) "Ticket with 'published'"
+        (AP.Ticket mlocal attrib mpublished mupdated muContext summary
-        verifyNothingE (AP.ticketUpdated ticket) "Ticket with 'updated'"
+         content source muAssigned resolved mmr)
-        -- verifyNothingE (AP.ticketName ticket) "Ticket with 'name'"
+        uTarget = do
-        verifyNothingE (AP.ticketAssignedTo ticket) "Ticket with 'assignedTo'"
+            verifyNothingE mlocal "Ticket with 'id'"
-        when (AP.ticketIsResolved ticket) $ throwE "Ticket resolved"
+            shrAttrib <- do
-    checkRecips hProject shrProject prjProject localRecips = do
+                route <- fromMaybeE (decodeRouteLocal attrib) "Ticket attrib not a valid route"
-        local <- hostIsLocal hProject
+                case route of
-        if local
+                    SharerR shr -> return shr
-            then traverse (verifyOfferRecips shrProject prjProject) localRecips
+                    _ -> throwE "Ticket attrib not a sharer route"
-            else traverse (verifyOnlySharer . snd) localRecips
+            unless (shrAttrib == shrUser) $
+                throwE "Ticket attibuted to someone else"
+            verifyNothingE (AP.ticketPublished ticket) "Ticket with 'published'"
+            verifyNothingE (AP.ticketUpdated ticket) "Ticket with 'updated'"
+            for_ muContext $ \ uContext ->
+                unless (uContext == uTarget) $ throwE "Offer target != ticket context"
+            verifyNothingE muAssigned "Ticket has 'assignedTo'"
+            when resolved $ throwE "Ticket is resolved"
+            verifyNothingE mmr "Ticket has 'attachment'"
+            target <- parseTarget uTarget
+            return (summary, content, source, target)
         where
-        verifyOfferRecips shr prj (shr', lsrSet) =
+        parseTarget u@(ObjURI h lu) = do
-            if shr == shr'
+            hl <- hostIsLocal h
-                then unless (lsrSet == offerRecips prj) $
+            if hl
-                        throwE "Unexpected offer target recipient set"
+                then Left <$> do
-                else verifyOnlySharer lsrSet
+                    route <- fromMaybeE (decodeRouteLocal lu) "Offer target is local but not a valid route"
-            where
+                    case route of
-            offerRecips prj = LocalSharerRelatedSet
+                        ProjectR shr prj -> return (shr, prj)
-                { localRecipSharerDirect        = LocalSharerDirectSet False False
+                        RepoR _ _ -> throwE "Offering patch to repo not implemented yet"
-                , localRecipSharerTicketRelated = []
+                        _ -> throwE "Offer target is local but isn't a project/repo route"
-                , localRecipProjectRelated      =
+                else return $ Right u
-                    [ ( prj
+    insertOfferToOutbox shrUser now obid = do
-                      , LocalProjectRelatedSet
-                            { localRecipProjectDirect =
-                                LocalProjectDirectSet True True True
-                            , localRecipProjectTicketRelated = []
-                            }
-                      )
-                    ]
-                , localRecipRepoRelated         = []
-                }
-        verifyOnlySharer lsrSet = do
-            unless (null $ localRecipProjectRelated lsrSet) $
-                throwE "Unexpected recipients unrelated to offer target"
-            unless (null $ localRecipRepoRelated lsrSet) $
-                throwE "Unexpected recipients unrelated to offer target"
-    insertToOutbox now obid = do
         hLocal <- asksSite siteInstanceHost
-        let activity mluAct = Doc hLocal Activity
+        obiid <- insertEmptyOutboxItem obid now
-                { activityId       = mluAct
+        encodeRouteLocal <- getEncodeRouteLocal
-                , activityActor    = AP.ticketAttributedTo ticket
+        obikhid <- encodeKeyHashid obiid
-                , activitySummary  = Just summary
+        let luAct = encodeRouteLocal $ SharerOutboxItemR shrUser obikhid
+            doc = Doc hLocal Activity
+                { activityId       = Just luAct
+                , activityActor    = encodeRouteLocal $ SharerR shrUser
+                , activitySummary  = summary
                 , activityAudience = audience
                 , activitySpecific =
                     OfferActivity $ Offer (OfferTicket ticket) uTarget
                 }
-        obiid <- insert OutboxItem
-            { outboxItemOutbox    = obid
-            , outboxItemActivity  =
-                persistJSONObjectFromDoc $ activity Nothing
-            , outboxItemPublished = now
-            }
-        encodeRouteLocal <- getEncodeRouteLocal
-        obikhid <- encodeKeyHashid obiid
-        let luAct = encodeRouteLocal $ SharerOutboxItemR shrUser obikhid
-            doc = activity $ Just luAct
         update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]
         return (obiid, doc, luAct)
-    deliverLocal pidAuthor shrProject prjProject now mprojAndDeps obiid luOffer recips = do
+    insertTicket pidAuthor now title desc source jid obiid obiidAccept = do
-        (pids, remotes) <- forCollect recips $ \ (shr, LocalSharerRelatedSet sharer _ _ projects _) -> do
+        did <- insert Discussion
-            (pids, remotes) <-
+        fsid <- insert FollowerSet
-                traverseCollect (uncurry $ deliverLocalProject shr) projects
+        tid <- insert Ticket
-            pids' <- do
+            { ticketNumber      = Nothing
-                mpid <-
+            , ticketCreated     = now
-                    if localRecipSharer sharer
+            , ticketTitle       = unTextHtml title
-                        then runMaybeT $ do
+            , ticketSource      = unTextPandocMarkdown source
-                            sid <- MaybeT $ getKeyBy $ UniqueSharer shr
+            , ticketDescription = unTextHtml desc
-                            MaybeT $ getKeyBy $ UniquePersonIdent sid
+            , ticketAssignee    = Nothing
-                        else return Nothing
+            , ticketStatus      = TSNew
-                return $
+            , ticketClosed      = UTCTime (ModifiedJulianDay 0) 0
-                    case mpid of
+            , ticketCloser      = Nothing
-                        Nothing -> pids
+            }
-                        Just pid -> LO.insertSet pid pids
+        ltid <- insert LocalTicket
-            return (pids', remotes)
+            { localTicketTicket    = tid
-        for_ (L.delete pidAuthor pids) $ \ pid -> do
+            , localTicketDiscuss   = did
-            ibid <- personInbox <$> getJust pid
+            , localTicketFollowers = fsid
-            ibiid <- insert $ InboxItem True
+            }
-            insert_ $ InboxItemLocal ibid obiid ibiid
+        tclid <- insert TicketContextLocal
-        return remotes
+            { ticketContextLocalTicket = tid
-        where
+            , ticketContextLocalAccept = obiidAccept
-        traverseCollect action values =
+            }
-            bimap collectPids collectRemotes . unzip <$> traverse action values
+        insert_ TicketProjectLocal
-            where
+            { ticketProjectLocalContext = tclid
-            collectPids = foldl' LO.union []
+            , ticketProjectLocalProject = jid
-            collectRemotes = foldl' unionRemotes []
+            }
-        forCollect = flip traverseCollect
+        talid <- insert TicketAuthorLocal
-        deliverLocalProject shr prj (LocalProjectRelatedSet project _) =
+            { ticketAuthorLocalTicket = ltid
-            case mprojAndDeps of
+            , ticketAuthorLocalAuthor = pidAuthor
-                Just (sid, jid, ibid, fsid{-, tids-})
+            , ticketAuthorLocalOpen   = obiid
-                    | shr == shrProject &&
+            }
-                      prj == prjProject &&
+        insert_ TicketUnderProject
-                      localRecipProject project -> do
+            { ticketUnderProjectProject = tclid
-                        insertToInbox ibid
+            , ticketUnderProjectAuthor  = talid
-                        {-
+            }
-                        num <-
+        return ltid
-                            ((subtract 1) . projectNextTicket) <$>
+    insertAccept shrUser luOffer shrJ prj obiidAccept ltid = do
-                                updateGet jid [ProjectNextTicket +=. 1]
+        encodeRouteLocal <- getEncodeRouteLocal
-                        -}
+        encodeRouteHome <- getEncodeRouteHome
-                        obiidAccept <- do
+        hLocal <- asksSite siteInstanceHost
-                            obidProject <- projectOutbox <$> getJust jid
+        obikhidAccept <- encodeKeyHashid obiidAccept
-                            now <- liftIO getCurrentTime
+        ltkhid <- encodeKeyHashid ltid
-                            hLocal <- asksSite siteInstanceHost
+        let actors = [LocalActorSharer shrUser]
-                            insert OutboxItem
+            collections =
-                                { outboxItemOutbox    = obidProject
+                [ LocalPersonCollectionProjectTeam shrJ prj
-                                , outboxItemActivity  =
+                , LocalPersonCollectionProjectFollowers shrJ prj
-                                    persistJSONObjectFromDoc $ Doc hLocal emptyActivity
+                ]
-                                , outboxItemPublished = now
+            recips =
-                                }
+                map encodeRouteHome $
-                        ltid <- insertTicket jid {-tids-} {-num-} obiidAccept
+                    map renderLocalActor actors ++
-                        docAccept <- insertAccept pidAuthor sid jid fsid luOffer obiidAccept ltid
+                    map renderLocalPersonCollection collections
-                        publishAccept pidAuthor sid jid fsid luOffer {-num-} obiidAccept docAccept
+            doc = Doc hLocal Activity
-                        (pidsTeam, remotesTeam) <-
+                { activityId       =
-                            if localRecipProjectTeam project
+                    Just $ encodeRouteLocal $
-                                then getProjectTeam sid
+                        ProjectOutboxItemR shrJ prj obikhidAccept
-                                else return ([], [])
+                , activityActor    = encodeRouteLocal $ ProjectR shrJ prj
-                        (pidsFollowers, remotesFollowers) <-
+                , activitySummary  = Nothing
-                            if localRecipProjectFollowers project
+                , activityAudience = Audience recips [] [] [] [] []
-                                then getFollowers fsid
+                , activitySpecific = AcceptActivity Accept
-                                else return ([], [])
+                    { acceptObject = ObjURI hLocal luOffer
-                        return
+                    , acceptResult =
-                            ( LO.union pidsTeam pidsFollowers
+                        Just $ encodeRouteLocal $ ProjectTicketR shrJ prj ltkhid
-                            , unionRemotes remotesTeam remotesFollowers
-                            )
-                _ -> return ([], [])
-            where
-            insertToInbox ibid = do
-                ibiid <- insert $ InboxItem False
-                insert_ $ InboxItemLocal ibid obiid ibiid
-            insertAccept pidAuthor sid jid fsid luOffer obiid ltid = do
-                ltkhid <- encodeKeyHashid ltid
-                summary <-
-                    TextHtml . TL.toStrict . renderHtml <$>
-                        withUrlRenderer
-                            [hamlet|
-                                <p>
-                                  <a href=@{SharerR shrUser}>
-                                    #{shr2text shrUser}
-                                  's ticket accepted by project #
-                                  <a href=@{ProjectR shrProject prjProject}>
-                                    ./s/#{shr2text shrProject}/p/#{prj2text prjProject}
-                                  : #
-                                  <a href=@{ProjectTicketR shrProject prjProject ltkhid}>
-                                    #{preEscapedToHtml $ unTextHtml $ AP.ticketSummary ticket}.
-                            |]
-                hLocal <- asksSite siteInstanceHost
-                encodeRouteLocal <- getEncodeRouteLocal
-                encodeRouteHome <- getEncodeRouteHome
-                obikhid <- encodeKeyHashid obiid
-                let recips =
-                        map encodeRouteHome
-                            [ SharerR shrUser
-                            , ProjectTeamR shrProject prjProject
-                            , ProjectFollowersR shrProject prjProject
-                            ]
-                    doc = Doc hLocal Activity
-                        { activityId       =
-                            Just $ encodeRouteLocal $
-                                ProjectOutboxItemR shrProject prjProject obikhid
-                        , activityActor    =
-                            encodeRouteLocal $ ProjectR shrProject prjProject
-                        , activitySummary  = Just summary
-                        , activityAudience = Audience recips [] [] [] [] []
-                        , activitySpecific = AcceptActivity Accept
-                            { acceptObject = ObjURI hLocal luOffer
-                            , acceptResult =
-                                Just $ encodeRouteLocal $
-                                    ProjectTicketR shrProject prjProject ltkhid
-                            }
-                        }
-                update
-                    obiid
-                    [OutboxItemActivity =. persistJSONObjectFromDoc doc]
-                return doc
-            insertTicket jid {-tidsDeps-} {-next-} obiidAccept = do
-                did <- insert Discussion
-                fsid <- insert FollowerSet
-                tid <- insert Ticket
-                    { ticketNumber      = Nothing
-                    , ticketCreated     = now
-                    , ticketTitle       = unTextHtml $ AP.ticketSummary ticket
-                    , ticketSource      =
-                        unTextPandocMarkdown $ AP.ticketSource ticket
-                    , ticketDescription = unTextHtml $ AP.ticketContent ticket
-                    , ticketAssignee    = Nothing
-                    , ticketStatus      = TSNew
-                    , ticketClosed      = UTCTime (ModifiedJulianDay 0) 0
-                    , ticketCloser      = Nothing
                     }
-                ltid <- insert LocalTicket
+                }
-                    { localTicketTicket    = tid
+        update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
-                    , localTicketDiscuss   = did
+        return (doc, makeRecipientSet actors collections)
-                    , localTicketFollowers = fsid
-                    }
-                tclid <- insert TicketContextLocal
-                    { ticketContextLocalTicket = tid
-                    , ticketContextLocalAccept = obiidAccept
-                    }
-                insert_ TicketProjectLocal
-                    { ticketProjectLocalContext = tclid
-                    , ticketProjectLocalProject = jid
-                    }
-                talid <- insert TicketAuthorLocal
-                    { ticketAuthorLocalTicket = ltid
-                    , ticketAuthorLocalAuthor = pidAuthor
-                    , ticketAuthorLocalOpen   = obiid
-                    }
-                insert_ TicketUnderProject
-                    { ticketUnderProjectProject = tclid
-                    , ticketUnderProjectAuthor  = talid
-                    }
-                --insertMany_ $ map (TicketDependency tid) tidsDeps
-                -- insert_ $ Follow pidAuthor fsid False True
-                return ltid
-            publishAccept pidAuthor sid jid fsid luOffer {-num-} obiid doc = do
-                now <- liftIO getCurrentTime
-                let dont = Authority "dont-do.any-forwarding" Nothing
-                remotesHttp <- do
-                    moreRemotes <- deliverLocal now sid fsid obiid
-                    deliverRemoteDB' dont obiid [] moreRemotes
-                site <- askSite
-                liftIO $ runWorker (deliverRemoteHttp dont obiid doc remotesHttp) site
-                where
-                deliverLocal now sid fsid obiid = do
-                    (pidsTeam, remotesTeam) <- getProjectTeam sid
-                    (pidsFollowers, remotesFollowers) <- getFollowers fsid
-                    let pids = LO.insertSet pidAuthor $ LO.union pidsTeam pidsFollowers
-                        remotes = unionRemotes remotesTeam remotesFollowers
-                    for_ pids $ \ pid -> do
-                        ibid <- personInbox <$> getJust pid
-                        ibiid <- insert $ InboxItem True
-                        insert_ $ InboxItemLocal ibid obiid ibiid
-                    return remotes
 
 undoC
     :: ShrIdent

src/Vervis/Handler/Client.hs

@@ -301,7 +301,7 @@ postSharerOutboxR shr = do
             OfferActivity (Offer obj target) ->
                 case obj of
                     OfferTicket ticket ->
-                        offerTicketC shr summary audience ticket target
+                        offerTicketC eperson sharer summary audience ticket target
                     _ -> throwE "Unsupported Offer 'object' type"
             UndoActivity undo ->
                 undoC shr summary audience undo
@@ -336,7 +336,7 @@ postPublishR = do
                 FormMissing -> throwE "Field(s) missing"
                 FormFailure _l -> throwE "Invalid input, see below"
                 FormSuccess r -> return r
-        bitraverse (bitraverse (publishComment ep s) (publishTicket ep s)) (bitraverse (openTicket shrAuthor) (follow shrAuthor)) input
+        bitraverse (bitraverse (publishComment ep s) (publishTicket ep s)) (bitraverse (openTicket ep s) (follow shrAuthor)) input
     case eid of
         Left err -> setMessage $ toHtml err
         Right id_ ->
@@ -412,11 +412,12 @@ postPublishR = do
                     _ -> error "Create object isn't a ticket"
             target = createTarget create
         createTicketC eperson sharer (Just summary) audience ticket target
-    openTicket shrAuthor ((h, shr, prj), TextHtml title, TextPandocMarkdown desc) = do
+    openTicket eperson sharer ((h, shr, prj), TextHtml title, TextPandocMarkdown desc) = do
         encodeRouteLocal <- getEncodeRouteLocal
         encodeRouteFed <- getEncodeRouteFed
         local <- hostIsLocal h
         descHtml <- ExceptT . pure $ renderPandocMarkdown desc
+        let shrAuthor = sharerIdent sharer
         summary <-
             TextHtml . TL.toStrict . renderHtml <$>
                 withUrlRenderer
@@ -459,7 +460,7 @@ postPublishR = do
                 , audienceGeneral   = []
                 , audienceNonActors = map (encodeRouteFed h) recipsC
                 }
-        offerTicketC shrAuthor (Just summary) audience ticketAP target
+        offerTicketC eperson sharer (Just summary) audience ticketAP target
     follow shrAuthor (uObject@(ObjURI hObject luObject), uRecip) = do
         (summary, audience, followAP) <-
             C.follow shrAuthor uObject uRecip False
@@ -788,7 +789,7 @@ postProjectTicketsR shr prj = do
             then Right <$> do
                 (summary, audience, ticket, target) <-
                     ExceptT $ offerTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) shr prj
-                obiid <- offerTicketC shrAuthor (Just summary) audience ticket target
+                obiid <- offerTicketC eperson sharer (Just summary) audience ticket target
                 ExceptT $ runDB $ do
                     mtal <- getValBy $ UniqueTicketAuthorLocalOpen obiid
                     return $