C2S: createTicketC: Allow to submit MRs i.e. Ticket with a Patch attached

config/models

@@ -415,6 +415,8 @@ TicketProjectRemote
     ticket  TicketAuthorLocalId
     tracker RemoteActorId
     project RemoteObjectId Maybe -- specify if not same as tracker
+                                 -- For MRs it may be either a remote repo or
+                                 -- a branch of it
 
     UniqueTicketProjectRemote ticket
 

src/Vervis/API.hs

@@ -489,15 +489,6 @@ checkFederation remoteRecips = do
     unless (federation || null remoteRecips) $
         throwE "Federation disabled, but remote recipients found"
 
-verifyProjectRecipOld (Right _) _ = return ()
-verifyProjectRecipOld (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
-
 verifyProjectRecip (Right _) _ = return ()
 verifyProjectRecip (Left (WTTProject shr prj)) localRecips =
     fromMaybeE verify "Local context project isn't listed as a recipient"
@@ -527,24 +518,23 @@ createTicketC
     -> ExceptT Text Handler OutboxItemId
 createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muTarget = do
     let shrUser = sharerIdent sharerUser
-    ticketData@(uContext, title, desc, source, uTarget) <- checkTicket shrUser ticket muTarget
+    (context, title, desc, source) <- checkCreateTicket shrUser ticket muTarget
-    context <- parseTicketContext uContext
     ParsedAudience localRecips remoteRecips blinded fwdHosts <- do
         mrecips <- parseAudience audience
         fromMaybeE mrecips "Create Ticket with no recipients"
     checkFederation remoteRecips
-    verifyProjectRecipOld context localRecips
+    verifyProjectRecip context localRecips
-    tracker <- fetchTracker context uTarget
+    tracker <- bitraverse pure fetchTracker context
     now <- liftIO getCurrentTime
     (_talid, obiidCreate, docCreate, remotesHttpCreate, maybeAccept) <- runDBExcept $ do
         obiidCreate <- lift $ insertEmptyOutboxItem (personOutbox personUser) now
         project <- prepareProject now tracker
-        talid <- lift $ insertTicket now pidUser title desc source obiidCreate project
+        (talid, mptid) <- lift $ insertTicket now pidUser title desc source obiidCreate project
-        docCreate <- lift $ insertCreateToOutbox shrUser blinded ticketData now obiidCreate talid
+        docCreate <- lift $ insertCreateToOutbox shrUser blinded context title desc source now obiidCreate talid mptid
         remoteRecipsHttpCreate <- do
             let sieve =
-                    case tracker of
+                    case context of
-                        Left (shr, prj) ->
+                        Left (WTTProject shr prj) ->
                             makeRecipientSet
                                 [ LocalActorProject shr prj
                                 ]
@@ -552,27 +542,55 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
                                 , LocalPersonCollectionProjectTeam shr prj
                                 , LocalPersonCollectionProjectFollowers shr prj
                                 ]
+                        Left (WTTRepo shr rp _ _ _) ->
+                            makeRecipientSet
+                                [ LocalActorRepo shr rp
+                                ]
+                                [ LocalPersonCollectionSharerFollowers shrUser
+                                , LocalPersonCollectionRepoTeam shr rp
+                                , LocalPersonCollectionRepoFollowers shr rp
+                                ]
                         Right _ ->
                             makeRecipientSet
                                 []
                                 [LocalPersonCollectionSharerFollowers shrUser]
-            moreRemoteRecips <- lift $ deliverLocal' True (LocalActorSharer shrUser) (personInbox personUser) obiidCreate $ localRecipSieve sieve False localRecips
+            moreRemoteRecips <-
+                lift $
+                    deliverLocal' True (LocalActorSharer shrUser) (personInbox personUser) obiidCreate $
+                        localRecipSieve sieve False localRecips
             checkFederation moreRemoteRecips
             lift $ deliverRemoteDB'' fwdHosts obiidCreate remoteRecips moreRemoteRecips
         maccept <-
             case project of
-                Left proj@(shr, Entity _ j, obiidAccept) -> Just <$> do
+                Left proj@(shr, ent, obiidAccept) -> Just <$> do
-                    let prj = projectIdent j
+                    let recipsA =
-                        recipsA =
                             [ LocalActorSharer shrUser
                             ]
-                        recipsC =
+                        (recipsC, ibid, actor) =
-                            [ LocalPersonCollectionProjectTeam shr prj
+                            case ent of
-                            , LocalPersonCollectionProjectFollowers shr prj
+                                Left (Entity _ j) ->
-                            , LocalPersonCollectionSharerFollowers shrUser
+                                    let prj = projectIdent j
-                            ]
+                                    in  ( [ LocalPersonCollectionProjectTeam shr prj
+                                          , LocalPersonCollectionProjectFollowers shr prj
+                                          , LocalPersonCollectionSharerFollowers shrUser
+                                          ]
+                                        , projectInbox j
+                                        , LocalActorProject shr prj
+                                        )
+                                Right (Entity _ r, _, _) ->
+                                    let rp = repoIdent r
+                                    in  ( [ LocalPersonCollectionRepoTeam shr rp
+                                          , LocalPersonCollectionRepoFollowers shr rp
+                                          , LocalPersonCollectionSharerFollowers shrUser
+                                          ]
+                                        , repoInbox r
+                                        , LocalActorRepo shr rp
+                                        )
                     doc <- lift $ insertAcceptToOutbox proj shrUser obiidCreate talid recipsA recipsC
-                    recips <- lift $ deliverLocal' True (LocalActorProject shr prj)  (projectInbox j) obiidAccept $ makeRecipientSet recipsA recipsC
+                    recips <-
+                        lift $
+                            deliverLocal' True actor ibid obiidAccept $
+                                makeRecipientSet recipsA recipsC
                     checkFederation recips
                     lift $ (obiidAccept,doc,) <$> deliverRemoteDB'' [] obiidAccept [] recips
                 Right _ -> return Nothing
@@ -583,64 +601,248 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
             forkWorker "createTicketC: async HTTP Accept delivery" $ deliverRemoteHttp' [] obiidAccept docAccept remotesHttpAccept
     return obiidCreate
     where
-    checkTicket shr (AP.Ticket mlocal luAttrib mpublished mupdated mcontext summary content source massigned resolved mmr) mtarget = do
+    checkCreateTicket
-        verifyNothingE mlocal "Ticket with 'id'"
+        :: ShrIdent
-        encodeRouteLocal <- getEncodeRouteLocal
+        -> AP.Ticket URIMode
-        unless (encodeRouteLocal (SharerR shr) == luAttrib) $
+        -> Maybe FedURI
-            throwE "Ticket attributed to someone else"
+        -> ExceptT Text Handler
-        verifyNothingE mpublished "Ticket with 'published'"
+            ( Either
-        verifyNothingE mupdated "Ticket with 'updated'"
+                WorkItemTarget
-        context <- fromMaybeE mcontext "Ticket without 'context'"
+                ( Host
-        verifyNothingE massigned "Ticket with 'assignedTo'"
+                , LocalURI
-        when resolved $ throwE "Ticket resolved"
+                , LocalURI
-        target <- fromMaybeE mtarget "Create Ticket without 'target'"
+                , Maybe (Maybe LocalURI, PatchType, Text)
-        verifyNothingE mmr "Ticket with 'attachment'"
+                )
-        return (context, summary, content, source, target)
+            , TextHtml
+            , TextHtml
+            , TextPandocMarkdown
+            )
+    checkCreateTicket shr ticket muTarget = do
+        uTarget <- fromMaybeE muTarget "Create Ticket without 'target'"
+        target <- checkTracker "Create target" uTarget
+        (context, summary, content, source) <- checkTicket ticket
+        item <- checkTargetAndContext target context
+        return (item, summary, content, source)
+        where
+        checkTracker
+            :: Text
+            -> FedURI
+            -> ExceptT Text Handler
+                (Either
+                    (Either (ShrIdent, PrjIdent) (ShrIdent, RpIdent))
+                    FedURI
+                )
+        checkTracker name u@(ObjURI h lu) = do
+            hl <- hostIsLocal h
+            if hl
+                then Left <$> do
+                    route <-
+                        fromMaybeE
+                            (decodeRouteLocal lu)
+                            (name <> " is local but isn't a valid route")
+                    case route of
+                        ProjectR shr prj -> return $ Left (shr, prj)
+                        RepoR shr rp -> return $ Right (shr, rp)
+                        _ ->
+                            throwE $
+                                name <>
+                                " is a valid local route, but isn't a \
+                                \project/repo route"
+                else return $ Right u
+        checkTicket
+            :: AP.Ticket URIMode
+            -> ExceptT Text Handler
+                ( Either WorkItemTarget (Host, LocalURI, Maybe (Maybe LocalURI, PatchType, Text))
+                , TextHtml
+                , TextHtml
+                , TextPandocMarkdown
+                )
+        checkTicket (AP.Ticket mlocal attrib mpublished mupdated muContext summary
+                               content source muAssigned resolved mmr) = do
+            verifyNothingE mlocal "Ticket with 'id'"
+            encodeRouteLocal <- getEncodeRouteLocal
+            unless (encodeRouteLocal (SharerR shr) == attrib) $
+                throwE "Ticket attributed to someone else"
+            verifyNothingE mpublished "Ticket with 'published'"
+            verifyNothingE mupdated "Ticket with 'updated'"
+            uContext <- fromMaybeE muContext "Ticket without 'context'"
+            context <- checkTracker "Ticket context" uContext
+            verifyNothingE muAssigned "Ticket with 'assignedTo'"
+            when resolved $ throwE "Ticket resolved"
+            mmr' <- traverse (uncurry checkMR) mmr
+            context' <- matchContextAndMR context mmr'
+            return (context', summary, content, source)
+            where
+            checkMR
+                :: Host
+                -> MergeRequest URIMode
+                -> ExceptT Text Handler
+                    ( Either (ShrIdent, RpIdent, Maybe Text) FedURI
+                    , PatchType
+                    , Text
+                    )
+            checkMR h (MergeRequest muOrigin luTarget epatch) = do
+                verifyNothingE muOrigin "MR with 'origin'"
+                branch <- checkBranch h luTarget
+                (typ, content) <-
+                    case epatch of
+                        Left _ -> throwE "MR patch specified as a URI"
+                        Right (hPatch, patch) -> checkPatch hPatch patch
+                return (branch, typ, content)
+                where
+                checkBranch
+                    :: Host
+                    -> LocalURI
+                    -> ExceptT Text Handler
+                        (Either (ShrIdent, RpIdent, Maybe Text) FedURI)
+                checkBranch h lu = do
+                    hl <- hostIsLocal h
+                    if hl
+                        then Left <$> do
+                            route <-
+                                fromMaybeE
+                                    (decodeRouteLocal lu)
+                                    "MR target is local but isn't a valid route"
+                            case route of
+                                RepoR shr rp -> return (shr, rp, Nothing)
+                                RepoBranchR shr rp b -> return (shr, rp, Just b)
+                                _ ->
+                                    throwE
+                                        "MR target is a valid local route, but isn't a \
+                                        \repo or branch route"
+                        else return $ Right $ ObjURI h lu
+                checkPatch
+                    :: Host
+                    -> AP.Patch URIMode
+                    -> ExceptT Text Handler
+                        ( PatchType
+                        , Text
+                        )
+                checkPatch h (AP.Patch mlocal attrib mpub typ content) = do
+                    encodeRouteLocal <- getEncodeRouteLocal
+                    verifyHostLocal h "Patch attributed to remote user"
+                    verifyNothingE mlocal "Patch with 'id'"
+                    unless (encodeRouteLocal (SharerR shr) == attrib) $
+                        throwE "Ticket and Patch attrib mismatch"
+                    verifyNothingE mpub "Patch has 'published'"
+                    return (typ, content)
+            matchContextAndMR
+                :: Either
+                    (Either (ShrIdent, PrjIdent) (ShrIdent, RpIdent))
+                    FedURI
+                -> Maybe
+                    ( Either (ShrIdent, RpIdent, Maybe Text) FedURI
+                    , PatchType
+                    , Text
+                    )
+                -> ExceptT Text Handler
+                    (Either
+                        WorkItemTarget
+                        ( Host
+                        , LocalURI
+                        , Maybe (Maybe LocalURI, PatchType, Text)
+                        )
+                    )
+            matchContextAndMR (Left (Left (shr, prj))) Nothing = return $ Left $ WTTProject shr prj
+            matchContextAndMR (Left (Left (shr, prj))) (Just _) = throwE "Patch offered to project"
+            matchContextAndMR (Left (Right (shr, rp))) Nothing = throwE "Issue offered to repo"
+            matchContextAndMR (Left (Right (shr, rp))) (Just (branch, typ, content)) = do
+                branch' <-
+                    case branch of
+                        Left (shr', rp', mb) | shr == shr' && rp == rp' -> return mb
+                        _ -> throwE "MR target repo/branch and Ticket context repo mismatch"
+                let vcs = typ2vcs typ
+                case vcs of
+                    VCSDarcs ->
+                        unless (isNothing branch') $
+                            throwE "Darcs MR specifies a branch"
+                    VCSGit ->
+                        unless (isJust branch') $
+                            throwE "Git MR doesn't specify the branch"
+                return $ Left $ WTTRepo shr rp branch' vcs content
+                where
+                typ2vcs PatchTypeDarcs = VCSDarcs
+            matchContextAndMR (Right (ObjURI h lu)) Nothing = return $ Right (h, lu, Nothing)
+            matchContextAndMR (Right (ObjURI h lu)) (Just (branch, typ, content)) = do
+                luBranch <-
+                    case branch of
+                        Right (ObjURI h' lu') | h == h' -> return lu
+                        _ -> throwE "MR target repo/branch and Ticket context repo mismatch"
+                let patch =
+                        ( if lu == luBranch then Nothing else Just luBranch
+                        , typ
+                        , content
+                        )
+                return $ Right (h, lu, Just patch)
+        checkTargetAndContext
+            :: Either
+                (Either (ShrIdent, PrjIdent) (ShrIdent, RpIdent))
+                FedURI
+            -> Either
+                WorkItemTarget
+                (Host, LocalURI, Maybe (Maybe LocalURI, PatchType, Text))
+            -> ExceptT Text Handler
+                (Either
+                    WorkItemTarget
+                    ( Host
+                    , LocalURI
+                    , LocalURI
+                    , Maybe (Maybe LocalURI, PatchType, Text)
+                    )
+                )
+        checkTargetAndContext (Left _) (Right _) =
+            throwE "Create target is local but ticket context is remote"
+        checkTargetAndContext (Right _) (Left _) =
+            throwE "Create target is remote but ticket context is local"
+        checkTargetAndContext (Right (ObjURI hTarget luTarget)) (Right (hContext, luContext, mpatch)) =
+            if hTarget == hContext
+                then return $ Right (hContext, luTarget, luContext, mpatch)
+                else throwE "Create target and ticket context on different \
+                            \remote hosts"
+        checkTargetAndContext (Left proj) (Left wit) =
+            case (proj, wit) of
+                (Left (shr, prj), WTTProject shr' prj')
+                    | shr == shr' && prj == prj' -> return $ Left wit
+                (Right (shr, rp), WTTRepo shr' rp' _ _ _)
+                    | shr == shr' && rp == rp' -> return $ Left wit
+                _ -> throwE "Create target and ticket context are different \
+                            \local projects"
 
-    parseTicketContext :: (MonadSite m, SiteEnv m ~ App) => FedURI -> ExceptT Text m (Either (ShrIdent, PrjIdent) FedURI)
+    fetchTracker (h, luTarget, luContext, mpatch) = do
-    parseTicketContext u@(ObjURI h lu) = do
+        (iid, era) <- do
-        hl <- hostIsLocal h
+            iid <- lift $ runDB $ either entityKey id <$> insertBy' (Instance h)
-        if hl
+            result <- lift $ fetchRemoteActor iid h luTarget
-            then Left <$> do
+            case result of
-                route <- fromMaybeE (decodeRouteLocal lu) "Ticket context isn't a valid route"
+                Left e -> throwE $ T.pack $ displayException e
-                case route of
+                Right (Left e) -> throwE $ T.pack $ show e
-                    ProjectR shr prj -> return (shr, prj)
+                Right (Right mera) -> do
-                    _ -> throwE "Ticket context isn't a project route"
+                    era <- fromMaybeE mera "target found to be a collection, not an actor"
-            else return $ Right u
+                    return (iid, era)
+        return (iid, era, if luTarget == luContext then Nothing else Just luContext, mpatch)
 
-    fetchTracker c u@(ObjURI h lu) = do
+    prepareProject now (Left (WTTProject shr prj)) = Left <$> do
-        hl <- hostIsLocal h
-        case (hl, c) of
-            (True, Left (shr, prj)) -> Left <$> do
-                encodeRouteLocal <- getEncodeRouteLocal
-                unless (encodeRouteLocal (ProjectR shr prj) == lu) $
-                    throwE "Local context and target mismatch"
-                return (shr, prj)
-            (True, Right _) -> throwE "context and target different host"
-            (False, Left _) -> throwE "context and target different host"
-            (False, Right (ObjURI h' lu')) -> Right <$> do
-                unless (h == h') $ throwE "context and target different host"
-                (iid, era) <- do
-                    iid <- lift $ runDB $ either entityKey id <$> insertBy' (Instance h)
-                    result <- lift $ fetchRemoteActor iid h lu
-                    case result of
-                        Left e -> throwE $ T.pack $ displayException e
-                        Right (Left e) -> throwE $ T.pack $ show e
-                        Right (Right mera) -> do
-                            era <- fromMaybeE mera "target found to be a collection, not an actor"
-                            return (iid, era)
-                return (iid, era, if lu == lu' then Nothing else Just lu')
-
-    prepareProject now (Left (shr, prj)) = Left <$> do
         mej <- lift $ runMaybeT $ do
             sid <- MaybeT $ getKeyBy $ UniqueSharer shr
             MaybeT $ getBy $ UniqueProject prj sid
         ej@(Entity _ j) <- fromMaybeE mej "Local context: no such project"
         obiidAccept <- lift $ insertEmptyOutboxItem (projectOutbox j) now
-        return (shr, ej, obiidAccept)
+        return (shr, Left ej, obiidAccept)
-    prepareProject _   (Right (iid, era, mlu)) = lift $ Right <$> do
+    prepareProject now (Left (WTTRepo shr rp mb vcs diff)) = Left <$> do
-        mroid <- for mlu $ \ lu -> either entityKey id <$> insertBy' (RemoteObject iid lu)
+        mer <- lift $ runMaybeT $ do
-        return (era, mroid)
+            sid <- MaybeT $ getKeyBy $ UniqueSharer shr
+            MaybeT $ getBy $ UniqueRepo rp sid
+        er@(Entity _ r) <- fromMaybeE mer "Local context: no such repo"
+        unless (repoVcs r == vcs) $ throwE "Repo VCS and patch VCS mismatch"
+        obiidAccept <- lift $ insertEmptyOutboxItem (repoOutbox r) now
+        return (shr, Right (er, mb, diff), obiidAccept)
+    prepareProject _   (Right (iid, era, mlu, mpatch)) = lift $ Right <$> do
+        let mlu' =
+                case mpatch of
+                    Just (Just luBranch, _, _) -> Just luBranch
+                    Nothing -> mlu
+        mroid <- for mlu' $ \ lu -> either entityKey id <$> insertBy' (RemoteObject iid lu)
+        let removeBranch (mb, typ, diff) = (typ, diff)
+        return (era, mroid, removeBranch <$> mpatch)
 
     insertTicket now pidUser title desc source obiidCreate project = do
         did <- insert Discussion
@@ -666,35 +868,122 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
             , ticketAuthorLocalAuthor = pidUser
             , ticketAuthorLocalOpen   = obiidCreate
             }
-        case project of
+        mptid <-
-            Left (_shr, Entity jid _j, obiidAccept) -> do
+            case project of
-                tclid <- insert TicketContextLocal
+                Left (_shr, ent, obiidAccept) -> do
-                    { ticketContextLocalTicket = tid
+                    tclid <- insert TicketContextLocal
-                    , ticketContextLocalAccept = obiidAccept
+                        { ticketContextLocalTicket = tid
-                    }
+                        , ticketContextLocalAccept = obiidAccept
-                insert_ TicketProjectLocal
+                        }
-                    { ticketProjectLocalContext = tclid
+                    case ent of
-                    , ticketProjectLocalProject = jid
+                        Left (Entity jid _) -> do
-                    }
+                            insert_ TicketProjectLocal
-            Right (Entity raid _ra, mroid) ->
+                                { ticketProjectLocalContext = tclid
-                insert_ TicketProjectRemote
+                                , ticketProjectLocalProject = jid
-                    { ticketProjectRemoteTicket  = talid
+                                }
-                    , ticketProjectRemoteTracker = raid
+                            return Nothing
-                    , ticketProjectRemoteProject = mroid
+                        Right (Entity rid _, mb, diff) -> Just <$> do
-                    }
+                            insert_ TicketRepoLocal
-        return talid
+                                { ticketRepoLocalContext = tclid
+                                , ticketRepoLocalRepo    = rid
+                                , ticketRepoLocalBranch  = mb
+                                }
+                            insert $ Patch tid now diff
+                Right (Entity raid _, mroid, mpatch) -> do
+                    insert_ TicketProjectRemote
+                        { ticketProjectRemoteTicket  = talid
+                        , ticketProjectRemoteTracker = raid
+                        , ticketProjectRemoteProject = mroid
+                        }
+                    for mpatch $ \ (_typ, diff) -> insert $ Patch tid now diff
+        return (talid, mptid)
 
-    insertCreateToOutbox shrUser blinded (uContext, title, desc, source, uTarget) now obiidCreate talid = do
+    insertCreateToOutbox shrUser blinded context title desc source now obiidCreate talid mptid = do
         encodeRouteLocal <- getEncodeRouteLocal
+        encodeRouteHome <- getEncodeRouteHome
         hLocal <- asksSite siteInstanceHost
         talkhid <- encodeKeyHashid talid
+        mptkhid <- traverse encodeKeyHashid mptid
         obikhid <- encodeKeyHashid obiidCreate
-        let luAttrib = encodeRouteLocal $ SharerR shrUser
+        let luTicket = encodeRouteLocal $ SharerTicketR shrUser talkhid
+            luAttrib = encodeRouteLocal $ SharerR shrUser
+            (uTarget, uContext, mmr) =
+                case context of
+                    Left (WTTProject shr prj) ->
+                        let uProject = encodeRouteHome $ ProjectR shr prj
+                        in  (uProject, uProject, Nothing)
+                    Left (WTTRepo shr rp mb vcs diff) ->
+                        let uRepo = encodeRouteHome $ RepoR shr rp
+                            mr = MergeRequest
+                                { mrOrigin = Nothing
+                                , mrTarget =
+                                    encodeRouteLocal $
+                                        case mb of
+                                            Nothing -> RepoR shr rp
+                                            Just b -> RepoBranchR shr rp b
+                                , mrPatch  = Right
+                                    ( hLocal
+                                    , AP.Patch
+                                        { AP.patchLocal        = Just
+                                            ( hLocal
+                                            , PatchLocal
+                                                { patchId =
+                                                    case mptkhid of
+                                                        Nothing -> error "mptkhid is Nothing"
+                                                        Just ptkhid ->
+                                                            encodeRouteLocal $
+                                                                SharerPatchVersionR shrUser talkhid ptkhid
+                                                , patchContext = luTicket
+                                                , patchPrevVersions = []
+                                                }
+                                            )
+                                        , AP.patchAttributedTo = luAttrib
+                                        , AP.patchPublished    = Just now
+                                        , AP.patchType         =
+                                            case vcs of
+                                                VCSDarcs -> PatchTypeDarcs
+                                                VCSGit -> error "createTicketC VCSGit"
+                                        , AP.patchContent      = diff
+                                        }
+                                    )
+                                }
+                        in  (uRepo, uRepo, Just (hLocal, mr))
+                    Right (hContext, luTarget, luContext, mpatch) ->
+                        let mr (mluBranch, typ, diff) = MergeRequest
+                                { mrOrigin = Nothing
+                                , mrTarget = fromMaybe luContext mluBranch
+                                , mrPatch  = Right
+                                    ( hLocal
+                                    , AP.Patch
+                                        { AP.patchLocal        = Just
+                                            ( hLocal
+                                            , PatchLocal
+                                                { patchId =
+                                                    case mptkhid of
+                                                        Nothing -> error "mptkhid is Nothing"
+                                                        Just ptkhid ->
+                                                            encodeRouteLocal $
+                                                                SharerPatchVersionR shrUser talkhid ptkhid
+                                                , patchContext = luTicket
+                                                , patchPrevVersions = []
+                                                }
+                                            )
+                                        , AP.patchAttributedTo = luAttrib
+                                        , AP.patchPublished    = Just now
+                                        , AP.patchType         = typ
+                                        , AP.patchContent      = diff
+                                        }
+                                    )
+                                }
+                        in  ( ObjURI hContext luTarget
+                            , ObjURI hContext luContext
+                            , (hContext,) . mr <$> mpatch
+                            )
             tlocal = TicketLocal
-                { ticketId           = encodeRouteLocal $ SharerTicketR shrUser talkhid
+                { ticketId           = luTicket
                 , ticketReplies      = encodeRouteLocal $ SharerTicketDiscussionR shrUser talkhid
                 , ticketParticipants = encodeRouteLocal $ SharerTicketFollowersR shrUser talkhid
-                , ticketTeam         = Just $ encodeRouteLocal $ SharerTicketTeamR shrUser talkhid
+                , ticketTeam         = Nothing -- Just $ encodeRouteLocal $ SharerTicketTeamR shrUser talkhid
                 , ticketEvents       = encodeRouteLocal $ SharerTicketEventsR shrUser talkhid
                 , ticketDeps         = encodeRouteLocal $ SharerTicketDepsR shrUser talkhid
                 , ticketReverseDeps  = encodeRouteLocal $ SharerTicketReverseDepsR shrUser talkhid
@@ -716,7 +1005,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
                         , AP.ticketSource       = source
                         , AP.ticketAssignedTo   = Nothing
                         , AP.ticketIsResolved   = False
-                        , AP.ticketAttachment   = Nothing
+                        , AP.ticketAttachment   = mmr
                         }
                     , createTarget = Just uTarget
                     }
@@ -724,34 +1013,26 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
         update obiidCreate [OutboxItemActivity =. persistJSONObjectFromDoc create]
         return create
 
-    insertAcceptToOutbox (shrJ, Entity _ j, obiidAccept) shrU obiidCreate talid actors colls = do
+    insertAcceptToOutbox (shrJ, ent, obiidAccept) shrU obiidCreate talid actors colls = do
         encodeRouteLocal <- getEncodeRouteLocal
         encodeRouteHome <- getEncodeRouteHome
         hLocal <- asksSite siteInstanceHost
         obikhidAccept <- encodeKeyHashid obiidAccept
         obikhidCreate <- encodeKeyHashid obiidCreate
         talkhid <- encodeKeyHashid talid
-        let prjJ = projectIdent j
+        let (outboxItemRoute, actorRoute) =
-        summary <-
+                case ent of
-            TextHtml . TL.toStrict . renderHtml <$>
+                    Left (Entity _ j) ->
-                withUrlRenderer
+                        let prj = projectIdent j
-                    [hamlet|
+                        in  (ProjectOutboxItemR shrJ prj, ProjectR shrJ prj)
-                        <p>
+                    Right (Entity _ r, _, _) ->
-                          Project #
+                        let rp = repoIdent r
-                          <a href=@{ProjectR shrJ prjJ}>
+                        in  (RepoOutboxItemR shrJ rp, RepoR shrJ rp)
-                            #{prj2text prjJ}
+            recips = map encodeRouteHome $ map renderLocalActor actors ++ map renderLocalPersonCollection colls
-                          \ accepted #
-                          <a href=@{SharerTicketR shrU talkhid}>
-                            ticket
-                          \ by #
-                          <a href=@{SharerR shrU}>
-                            #{shr2text shrU}
-                    |]
-        let recips = map encodeRouteHome $ map renderLocalActor actors ++ map renderLocalPersonCollection colls
             accept = Doc hLocal Activity
-                { activityId       = Just $ encodeRouteLocal $ ProjectOutboxItemR shrJ prjJ obikhidAccept
+                { activityId       = Just $ encodeRouteLocal $ outboxItemRoute obikhidAccept
-                , activityActor    = encodeRouteLocal $ ProjectR shrJ prjJ
+                , activityActor    = encodeRouteLocal actorRoute
-                , activitySummary  = Just summary
+                , activitySummary  = Nothing
                 , activityAudience = Audience recips [] [] [] [] []
                 , activitySpecific = AcceptActivity Accept
                     { acceptObject = encodeRouteHome $ SharerOutboxItemR shrU obikhidCreate