{- This file is part of Vervis.
 -
 - Written in 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Vervis.Handler.Cloth
    ( getClothR
    , getClothDiscussionR
    , getClothEventsR
    , getClothFollowersR
    , getClothDepsR
    , getClothReverseDepsR

    , getBundleR
    , getPatchR

    , getClothDepR

    , getClothNewR
    , postClothNewR

    , postClothApplyR
    , postClothFollowR
    , postClothUnfollowR

    , getClothReplyR
    , postClothReplyR
    , getClothReplyOnR
    , postClothReplyOnR








    {-
    , getSharerProposalsR
    , getSharerProposalR
    , getSharerProposalDiscussionR
    , getSharerProposalDepsR
    , getSharerProposalReverseDepsR
    , getSharerProposalFollowersR
    , getSharerProposalEventsR
    , getSharerProposalBundleR
    , getSharerProposalBundlePatchR

    , getRepoProposalsR
    , getRepoProposalR
    , getRepoProposalDiscussionR
    , getRepoProposalDepsR
    , getRepoProposalReverseDepsR
    , getRepoProposalFollowersR
    , getRepoProposalEventsR
    , getRepoProposalBundleR
    , getRepoProposalBundlePatchR
    -}
    )
where

import Control.Exception.Base
import Control.Monad
import Control.Monad.Trans.Except
import Data.Bifunctor
import Data.Bitraversable
import Data.Bool
import Data.Function
import Data.Functor
import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
import Data.Maybe
import Data.Text (Text)
import Data.These
import Data.Traversable
import Database.Persist
import Network.HTTP.Types.Method
import Text.Blaze.Html (Html, preEscapedToHtml)
import Yesod.Auth
import Yesod.Core
import Yesod.Form
import Yesod.Persist.Core

import qualified Data.List.NonEmpty as NE
import qualified Data.List.Ordered as LO
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Database.Esqueleto as E

import Data.MediaType
import Development.PatchMediaType
import Network.FedURI
import Web.ActivityPub hiding (Ticket (..), Patch (..), Bundle (..), Repo (..), ActorDetail (..))
import Web.Text
import Yesod.ActivityPub
import Yesod.FedURI
import Yesod.Hashids
import Yesod.MonadSite
import Yesod.RenderSource

import qualified Web.ActivityPub as AP

import Control.Monad.Trans.Except.Local
import Data.Paginate.Local
import Database.Persist.Local
import Yesod.Form.Local
import Yesod.Persist.Local

import Vervis.ActivityPub
import Vervis.API
import Vervis.Cloth
import Vervis.Data.Actor
import Vervis.Persist.Discussion
import Vervis.FedURI
import Vervis.Form.Ticket
import Vervis.Foundation
import Vervis.Model
import Vervis.Model.Ident
import Vervis.Model.Ticket
import Vervis.Paginate
import Vervis.Persist.Actor
import Vervis.Persist.Ticket
import Vervis.Recipient
import Vervis.Settings
import Vervis.Style
import Vervis.Ticket
import Vervis.Time (showDate)
import Vervis.Web.Actor
import Vervis.Web.Discussion
import Vervis.Web.Repo
import Vervis.Widget
import Vervis.Widget.Discussion
import Vervis.Widget.Person
import Vervis.Widget.Tracker

import qualified Vervis.Client as C

selectDiscussionID loomHash clothHash = do
    (_, _, Entity _ ticket, _, _, _) <- getCloth404 loomHash clothHash
    return $ ticketDiscuss ticket

getClothR :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler TypedContent
getClothR loomHash clothHash = do
    (repoID, mbranch, ticket, author, resolve, proposal) <- runDB $ do
        (Entity _ loom, Entity _ cloth, Entity _ ticket', author', resolve', proposal') <-
            getCloth404 loomHash clothHash
        (,,,,,)
            (loomRepo loom)
            (ticketLoomBranch cloth)
            ticket'
            <$> (case author' of
                    Left (Entity _ tal) ->
                        return $ Left $ ticketAuthorLocalAuthor tal
                    Right (Entity _ tar) -> Right <$> do
                        ra <- getJust $ ticketAuthorRemoteAuthor tar
                        ro <- getJust $ remoteActorIdent ra
                        i <- getJust $ remoteObjectInstance ro
                        return (i, ro)
                )
            <*> (for resolve' $ \ (_, etrx) ->
                    bitraverse
                        (\ (Entity _ trl) -> do
                            let obiid = ticketResolveLocalActivity trl
                            obid <- outboxItemOutbox <$> getJust obiid
                            actorID <- do
                                maybeActorID <- getKeyBy $ UniqueActorOutbox obid
                                case maybeActorID of
                                    Nothing -> error "Found outbox not used by any actor"
                                    Just a -> return a
                            actor <- getLocalActor actorID
                            return (actor, obiid)
                        )
                        (\ (Entity _ trr) -> do
                            roid <-
                                remoteActivityIdent <$>
                                    getJust (ticketResolveRemoteActivity trr)
                            ro <- getJust roid
                            i <- getJust $ remoteObjectInstance ro
                            return (i, ro)
                        )
                        etrx
                )
            <*> bitraverse
                    (pure . NE.head)
                    (bitraverse
                        (pure . entityVal)
                        (\ (Entity _ (MergeOriginRemote _ r), mbranch) -> do
                            ra <- getJust r
                            ro <- getJust $ remoteActorIdent ra
                            i <- getJust $ remoteObjectInstance ro
                            return (i, ro, entityVal <$> mbranch)
                        )
                    )
                    proposal'

    encodeRouteLocal <- getEncodeRouteLocal
    encodeRouteHome <- getEncodeRouteHome
    hashPerson <- getEncodeKeyHashid
    hashItem <- getEncodeKeyHashid
    hashActor <- getHashLocalActor
    hashBundle <- getEncodeKeyHashid
    hashRepo <- getEncodeKeyHashid
    hLocal <- getsYesod siteInstanceHost
    repoHash <- encodeKeyHashid repoID
    let route mk = encodeRouteLocal $ mk loomHash clothHash
        authorHost =
            case author of
                Left _       -> hLocal
                Right (i, _) -> instanceHost i
        ticketLocalAP = AP.TicketLocal
            { AP.ticketId           = route ClothR
            , AP.ticketReplies      = route ClothDiscussionR
            , AP.ticketParticipants = route ClothFollowersR
            , AP.ticketTeam         = Nothing
            , AP.ticketEvents       = route ClothEventsR
            , AP.ticketDeps         = route ClothDepsR
            , AP.ticketReverseDeps  = route ClothReverseDepsR
            }
        mergeRequestAP = AP.MergeRequest
            { AP.mrOrigin = justThere proposal <&> \ origin ->
                case origin of
                    Left (MergeOriginLocal _ originRepoID maybeBranch) ->
                        let luRepo = encodeRouteLocal $ RepoR $ hashRepo originRepoID
                        in  case maybeBranch of
                                Nothing -> Left $ ObjURI hLocal luRepo
                                Just b -> Right
                                    ( hLocal
                                    , AP.Branch
                                        { AP.branchName = b
                                        , AP.branchRef  = "refs/heads/" <> b
                                        , AP.branchRepo = luRepo
                                        }
                                    )
                    Right (i, ro, Nothing) ->
                        Left $ ObjURI (instanceHost i) (remoteObjectIdent ro)
                    Right (i, ro, Just (MergeOriginRemoteBranch _ mlu b)) ->
                        let h = instanceHost i
                        in  case mlu of
                                Nothing -> Right
                                    ( h
                                    , AP.Branch
                                        { AP.branchName = b
                                        , AP.branchRef  = "refs/heads/" <> b
                                        , AP.branchRepo = remoteObjectIdent ro
                                        }
                                    )
                                Just luBranch -> Left $ ObjURI h luBranch
            , AP.mrTarget =
                case mbranch of
                    Nothing -> Left $ encodeRouteLocal $ RepoR repoHash
                    Just b -> Right AP.Branch
                        { AP.branchName = b
                        , AP.branchRef  = "refs/heads/" <> b
                        , AP.branchRepo = encodeRouteLocal $ RepoR repoHash
                        }
            , AP.mrBundle =
                Left . encodeRouteHome . BundleR loomHash clothHash . hashBundle
                    <$> justHere proposal
            }
        ticketAP = AP.Ticket
            { AP.ticketLocal        = Just (hLocal, ticketLocalAP)
            , AP.ticketAttributedTo =
                case author of
                    Left authorID ->
                        encodeRouteLocal $ PersonR $ hashPerson authorID
                    Right (_instance, object) ->
                        remoteObjectIdent object
            , AP.ticketPublished    = Just $ ticketCreated ticket
            , AP.ticketUpdated      = Nothing
            , AP.ticketContext      = Just $ encodeRouteHome $ LoomR loomHash
            -- , AP.ticketName         = Just $ "#" <> T.pack (show num)
            , AP.ticketSummary      = encodeEntities $ ticketTitle ticket
            , AP.ticketContent      = ticketDescription ticket
            , AP.ticketSource       = ticketSource ticket
            , AP.ticketAssignedTo   = Nothing
            , AP.ticketResolved     =
                let u (Left (actor, obiid)) =
                        encodeRouteHome $
                            activityRoute (hashActor actor) (hashItem obiid)
                    u (Right (i, ro)) =
                        ObjURI (instanceHost i) (remoteObjectIdent ro)
                in  (,Nothing) . Just . u <$> resolve
            , AP.ticketAttachment = Just (hLocal, mergeRequestAP)
            }

    provideHtmlAndAP' authorHost ticketAP getClothHtml
    where
    getClothHtml = do
        mpid <- maybeAuthId
        (eloom, actor, ticket, targetRepo, author, tparams, eparams, cparams, resolved, moriginRepo, mbundle) <- handlerToWidget $ runDB $ do
            (eloom@(Entity _ loom), Entity _ cloth, Entity ticketID ticket, author, maybeResolve, proposal) <-
                getCloth404 loomHash clothHash
            actor <- getJust $ loomActor loom
            (eloom,actor,ticket,,,,,,,,)
                <$> getLocalRepo' (loomRepo loom) (ticketLoomBranch cloth)
                <*> bitraverse
                        (\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
                            p <- getJust personID
                            (Entity personID p,) <$> getJust (personActor p)
                        )
                        (\ (Entity _ (TicketAuthorRemote _ remoteActorID _)) -> do
                            ra <- getJust remoteActorID
                            ro <- getJust $ remoteActorIdent ra
                            i <- getJust $ remoteObjectInstance ro
                            return (i, ro, ra)
                        )
                        author
                <*> getTicketTextParams ticketID --wid
                <*> getTicketEnumParams ticketID --wid
                <*> getTicketClasses ticketID --wid
                <*> traverse getTicketResolve maybeResolve
                <*> traverse
                        (bitraverse
                                (\ (Entity _(MergeOriginLocal _ originRepoID maybeBranch)) ->
                                    getLocalRepo originRepoID maybeBranch
                                )
                                (\ (Entity _ (MergeOriginRemote _ r), mbranch) ->
                                    getRemoteRepo r mbranch
                                )
                        )
                        (justThere proposal)
                <*> traverse
                        (\ (bundleID :| _) -> do
                            ps <- selectList [PatchBundle ==. bundleID] [Desc PatchId]
                            case nonEmpty ps of
                                Nothing -> error "Bundle without any Patches in DB"
                                Just ne -> return (bundleID, ne)
                        )
                        (justHere proposal)
        mbundle' <- for mbundle $ \ (bundleID, patches) -> do
            let patchIDs = NE.map entityKey patches
                diffs = NE.map (patchContent . entityVal) $ NE.reverse patches
                (repoID, _, _, maybeBranch) = targetRepo
            maybeErrorOrCanApply <-
                case resolved of
                    Just _ -> pure Nothing
                    Nothing -> Just <$> runExceptT (canApplyPatches repoID maybeBranch diffs)
            return (bundleID, patchIDs, maybeErrorOrCanApply)
        hashMessageKey <- handlerToWidget getEncodeKeyHashid
        let desc :: Widget
            desc = toWidget $ markupHTML $ ticketDescription ticket
            discuss =
                discussionW
                    (return $ ticketDiscuss ticket)
                    (ClothReplyR loomHash clothHash)
                    (ClothReplyOnR loomHash clothHash . hashMessageKey)
        cRelevant <- newIdent
        cIrrelevant <- newIdent
        let relevant filt =
                bool cIrrelevant cRelevant $
                {-
                case ticketStatus ticket of
                    TSNew    -> wffNew filt
                    TSTodo   -> wffTodo filt
                    TSClosed -> wffClosed filt
                -}
                True
        let followButton =
                followW
                    (ClothFollowR loomHash clothHash)
                    (ClothUnfollowR loomHash clothHash)
                    (ticketFollowers ticket)
            applyButton label =
                buttonW POST label $ ClothApplyR loomHash clothHash
        hashBundle <- handlerToWidget getEncodeKeyHashid
        hashPatch <- handlerToWidget getEncodeKeyHashid
        $(widgetFile "cloth/one")
        where
        getLocalRepo' repoID mbranch = do
            repo <- getJust repoID
            actor <- getJust $ repoActor repo
            repoHash <- encodeKeyHashid repoID
            unless (isJust mbranch == (repoVcs repo == VCSGit)) $
                error "VCS and cloth-branch mismatch"
            return (repoID, repoHash, actorName actor, mbranch)
        getLocalRepo repoID mbranch = do
            repo <- getJust repoID
            actor <- getJust $ repoActor repo
            repoHash <- encodeKeyHashid repoID
            return (repoHash, actorName actor, mbranch)
        getRemoteRepo remoteActorID mbranch = do
            ra <- getJust remoteActorID
            ro <- getJust $ remoteActorIdent ra
            i <- getJust $ remoteObjectInstance ro
            let h = instanceHost i
                uRepo = ObjURI h (remoteObjectIdent ro)
            return
                ( uRepo
                , remoteActorName ra
                , mbranch <&>
                    \ (Entity _ (MergeOriginRemoteBranch _ mlu b)) ->
                        (ObjURI h <$> mlu, b)
                )

getClothDiscussionR
    :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler TypedContent
getClothDiscussionR loomHash clothHash = do
    hashMsg <- getEncodeKeyHashid
    serveDiscussion
        (ClothDiscussionR loomHash clothHash)
        (ClothReplyOnR loomHash clothHash . hashMsg)
        (ClothReplyR loomHash clothHash)
        (selectDiscussionID loomHash clothHash)

getClothEventsR
    :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler TypedContent
getClothEventsR _ _ = do
    error "Not implemented yet"

getClothFollowersR
    :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler TypedContent
getClothFollowersR loomHash clothHash = getFollowersCollection here getFsid
    where
    here = ClothFollowersR loomHash clothHash
    getFsid = do
        (_, _, Entity _ t, _, _, _) <- getCloth404 loomHash clothHash
        return $ ticketFollowers t

getClothDepsR
    :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler TypedContent
getClothDepsR loomHash clothHash =
    error "Temporarily disabled"
    {-
    getDependencyCollection here dep getLocalClothId404
    where
    here = ClothDepsR loomHash clothHash
    dep = ClothDepR loomHash clothHash
    getLocalClothId404 = do
        (_, _, Entity ltid _, _, _, _, _) <- getCloth404 dkhid ltkhid
        return ltid
    -}

getClothReverseDepsR
    :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler TypedContent
getClothReverseDepsR loomHash clothHash =
    error "Temporarily disabled"
    {-
    getReverseDependencyCollection here getLocalClothId404
    where
    here = ClothReverseDepsR loomhash clothHash
    getLocalClothId404 = do
        (_, _, _, Entity ltid _, _, _, _, _) <- getCloth404 loomHash clothHash
        return ltid
    -}

getBundleR
    :: KeyHashid Loom
    -> KeyHashid TicketLoom
    -> KeyHashid Bundle
    -> Handler TypedContent
getBundleR loomHash clothHash bundleHash = do
    (patchIDs, previousBundles, maybeCurrentBundle) <- runDB $ do
        (_, Entity clothID _, _, _, _, proposal) <-
            getCloth404 loomHash clothHash
        bundleID <- decodeKeyHashid404 bundleHash
        bundle <- get404 bundleID
        unless (bundleTicket bundle == clothID) notFound
        latest :| olds <-
            case justHere proposal of
                Nothing -> error "Why didn't getCloth find any bundles"
                Just bundles -> return bundles
        patches <- do
            ids <- selectKeysList [PatchBundle ==. bundleID] [Desc PatchId]
            case nonEmpty ids of
                Nothing -> error "Bundle without any Patches in DB"
                Just ne -> return ne
        let (prevs, mcurr) =
                if bundleID == latest
                    then (olds, Nothing)
                    else ([]  , Just latest)
        return (patches, prevs, mcurr)

    encodeRouteLocal <- getEncodeRouteLocal
    hashBundle <- getEncodeKeyHashid
    hashPatch <- getEncodeKeyHashid

    let versionRoute = BundleR loomHash clothHash . hashBundle
        patchRoute = PatchR loomHash clothHash bundleHash . hashPatch
        bundleLocalAP = AP.BundleLocal
            { AP.bundleId = encodeRouteLocal here
            , AP.bundleContext =
                encodeRouteLocal $ ClothR loomHash clothHash
            , AP.bundlePrevVersions =
                map (encodeRouteLocal . versionRoute) previousBundles
            , AP.bundleCurrentVersion =
                encodeRouteLocal . versionRoute <$> maybeCurrentBundle
            }
        bundleAP =
            AP.BundleHosted
                (Just bundleLocalAP)
                (NE.map (encodeRouteLocal . patchRoute) patchIDs)

    provideHtmlAndAP bundleAP $(widgetFile "bundle")
    where
    here = BundleR loomHash clothHash bundleHash

getPatchR
    :: KeyHashid Loom
    -> KeyHashid TicketLoom
    -> KeyHashid Bundle
    -> KeyHashid Patch
    -> Handler TypedContent
getPatchR loomHash clothHash bundleHash patchHash = do
    (patch, author) <- runDB $ do
        (_, _, _, author', _, proposal) <- getCloth404 loomHash clothHash
        let versions = maybe [] NE.toList $ justHere proposal
        (,) <$> do  bundleID <- decodeKeyHashid404 bundleHash
                    unless (bundleID `elem` versions) notFound
                    patchID <- decodeKeyHashid404 patchHash
                    patch' <- get404 patchID
                    unless (patchBundle patch' == bundleID) notFound
                    return patch'
            <*> bitraverse
                    (\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
                        p <- getJust personID
                        (Entity personID p,) <$> getJust (personActor p)
                    )
                    (\ (Entity _ tar) -> do
                        ra <- getJust $ ticketAuthorRemoteAuthor tar
                        ro <- getJust $ remoteActorIdent ra
                        i <- getJust $ remoteObjectInstance ro
                        return (i, ro, ra)
                    )
                    author'

    encodeRouteLocal <- getEncodeRouteLocal
    hashPerson <- getEncodeKeyHashid
    hLocal <- getsYesod siteInstanceHost

    let host =
            case author of
                Left _          -> hLocal
                Right (i, _, _) -> instanceHost i
        patchLocalAP = AP.PatchLocal
            { AP.patchId      = encodeRouteLocal here
            , AP.patchContext =
                encodeRouteLocal $ BundleR loomHash clothHash bundleHash
            }
        patchAP = AP.Patch
            { AP.patchLocal = Just (hLocal, patchLocalAP)
            , AP.patchAttributedTo =
                case author of
                    Left (Entity authorID _, _) ->
                        encodeRouteLocal $ PersonR $ hashPerson authorID
                    Right (_, object, _) -> remoteObjectIdent object
            , AP.patchPublished    = Just $ patchCreated patch
            , AP.patchType         = patchType patch
            , AP.patchContent      = patchContent patch
            }
    provideHtmlAndAP' host patchAP $ do
        let syntax =
                case patchType patch of
                    PatchMediaTypeDarcs -> DarcsPatch
                    PatchMediaTypeGit -> Diff
            sourceW = renderSourceT syntax $ patchContent patch
        $(widgetFile "patch")
    where
    here = PatchR loomHash clothHash bundleHash patchHash

getClothDepR
    :: KeyHashid Loom
    -> KeyHashid TicketLoom
    -> KeyHashid LocalTicketDependency
    -> Handler TypedContent
getClothDepR _ _ _ = do
    error "Temporarily disabled"
    {-
    encodeRouteLocal <- getEncodeRouteLocal
    encodeRouteHome <- getEncodeRouteHome
    wiRoute <- askWorkItemRoute
    hLocal <- asksSite siteInstanceHost

    tdid <- decodeKeyHashid404 tdkhid
    (td, author, parent, child) <- runDB $ do
        td <- get404 tdid
        (td,,,)
            <$> getAuthor tdid
            <*> getWorkItem ( localTicketDependencyParent td)
            <*> getChild tdid
    let host =
            case author of
                Left _ -> hLocal
                Right (h, _) -> h
        tdepAP = AP.TicketDependency
            { ticketDepId           = Just $ encodeRouteHome here
            , ticketDepParent       = encodeRouteHome $ wiRoute parent
            , ticketDepChild        =
                case child of
                    Left wi -> encodeRouteHome $ wiRoute wi
                    Right (h, lu) -> ObjURI h lu
            , ticketDepAttributedTo =
                case author of
                    Left shr -> encodeRouteLocal $ SharerR shr
                    Right (_h, lu) -> lu
            , ticketDepPublished    = Just $ localTicketDependencyCreated td
            , ticketDepUpdated      = Nothing
            }
    provideHtmlAndAP' host tdepAP $ redirectToPrettyJSON here
    where
    here = TicketDepR tdkhid
    getAuthor tdid = do
        tda <- requireEitherAlt
            (getValBy $ UniqueTicketDependencyAuthorLocal tdid)
            (getValBy $ UniqueTicketDependencyAuthorRemote tdid)
            "No TDA"
            "Both TDAL and TDAR"
        bitraverse
            (\ tdal -> do
                p <- getJust $ ticketDependencyAuthorLocalAuthor tdal
                s <- getJust $ personIdent p
                return $ sharerIdent s
            )
            (\ tdar -> do
                ra <- getJust $ ticketDependencyAuthorRemoteAuthor tdar
                ro <- getJust $ remoteActorIdent ra
                i <- getJust $ remoteObjectInstance ro
                return (instanceHost i, remoteObjectIdent ro)
            )
            tda
    getChild tdid = do
        tdc <- requireEitherAlt
            (getValBy $ UniqueTicketDependencyChildLocal tdid)
            (getValBy $ UniqueTicketDependencyChildRemote tdid)
            "No TDC"
            "Both TDCL and TDCR"
        bitraverse
            (getWorkItem . ticketDependencyChildLocalChild)
            (\ tdcr -> do
                ro <- getJust $ ticketDependencyChildRemoteChild tdcr
                i <- getJust $ remoteObjectInstance ro
                return (instanceHost i, remoteObjectIdent ro)
            )
            tdc
    -}

getClothNewR :: KeyHashid Loom -> Handler Html
getClothNewR loomHash = do
    loomID <- decodeKeyHashid404 loomHash
    _ <- runDB $ get404 loomID
    ((_result, widget), enctype) <- runFormPost newClothForm
    defaultLayout $(widgetFile "cloth/new")

postClothNewR :: KeyHashid Loom -> Handler Html
postClothNewR loomHash = do
    loomID <- decodeKeyHashid404 loomHash
    person@(Entity pid p) <- requireAuth
    (loom, senderActor) <- runDB $ do
        loom <- get404 loomID
        a <- getJust $ personActor p
        return (loom, a)
    NewCloth title desc targetBranch origin patch <-
        runFormPostRedirect (ClothNewR loomHash) newClothForm
    encodeRouteHome <- getEncodeRouteHome
    errorOrTicket <- runExceptT $ do
        let uLoom = encodeRouteHome $ LoomR loomHash
        senderHash <- encodeKeyHashid pid
        (maybeSummary, audience, ticket) <- do
            uTargetRepo <-
                encodeRouteHome . RepoR <$> encodeKeyHashid (loomRepo loom)
            case (origin, patch) of
                (Nothing, Nothing) -> throwE "Neither origin no patch provided"
                (Just _, Just _) -> throwE "Both origin and patch provided"
                (Just (uRepo, mb), Nothing) ->
                    C.offerMerge
                        senderHash title desc uLoom uTargetRepo targetBranch
                        uRepo mb
                (Nothing, Just (typ, fi)) -> do
                    diff <-
                        withExceptT (T.pack . displayException) $ ExceptT $
                            TE.decodeUtf8' <$> fileSourceByteString fi
                    C.offerPatches
                        senderHash title desc uLoom uTargetRepo targetBranch
                        typ (diff :| [])
        (localRecips, remoteRecips, fwdHosts, action) <-
            lift $ C.makeServerInput Nothing maybeSummary audience $
                AP.OfferActivity $ AP.Offer (AP.OfferTicket ticket) uLoom
        offerID <-
            offerTicketC
                person senderActor Nothing localRecips remoteRecips fwdHosts action
                ticket uLoom
        runDBExcept $ do
            mtal <- lift $ getValBy $ UniqueTicketAuthorLocalOpen offerID
            tal <- fromMaybeE mtal "Offer processed bu no ticket created"
            return $ ticketAuthorLocalTicket tal
    case errorOrTicket of
        Left e -> do
            setMessage $ toHtml e
            redirect $ ClothNewR loomHash
        Right ticketID -> do
            clothID <- do
                maybeClothID <- runDB $ getKeyBy $ UniqueTicketLoom ticketID
                case maybeClothID of
                    Nothing -> error "No TicketLoom for the new Ticket"
                    Just c -> return c
            clothHash <- encodeKeyHashid clothID
            setMessage "MR created"
            redirect $ ClothR loomHash clothHash

postClothApplyR :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler ()
postClothApplyR loomHash clothHash = do
    ep@(Entity personID person) <- requireAuth

    (grantIDs, proposal, actor, loomID) <- runDB $ do
        (Entity loomID _, _, _, _, _, proposal) <- getCloth404 loomHash clothHash

        grantIDs <-
            E.select $ E.from $ \ (topic `E.InnerJoin` recip `E.InnerJoin` enable) -> do
                E.on $ topic E.^. CollabTopicLoomCollab E.==. enable E.^. CollabEnableCollab
                E.on $ topic E.^. CollabTopicLoomCollab E.==. recip E.^. CollabRecipLocalCollab
                E.where_ $
                    topic E.^. CollabTopicLoomLoom E.==. E.val loomID E.&&.
                    recip E.^. CollabRecipLocalPerson E.==. E.val personID
                return $ enable E.^. CollabEnableGrant

        actor <- getJust $ personActor person

        return (map E.unValue grantIDs, proposal, actor, loomID)

    result <- runExceptT $ do

        bundleID :| _ <-
            fromMaybeE (justHere proposal) "No patch bundle to apply"
        grantID <-
            case grantIDs of
                [] -> throwE "You don't have access to this patch tracker"
                [g] -> return g
                _ -> error "Multiple grants for same person on same loom"
        bundleRoute <- BundleR loomHash clothHash <$> encodeKeyHashid bundleID
        encodeRouteHome <- getEncodeRouteHome
        personHash <- encodeKeyHashid personID
        (maybeSummary, audience, apply) <-
            C.applyPatches personHash $ encodeRouteHome bundleRoute
        let cap = (LocalActorLoom loomID, LocalActorLoom loomHash, grantID)
        uCap <-
            encodeRouteHome . LoomOutboxItemR loomHash <$>
                encodeKeyHashid grantID
        (localRecips, remoteRecips, fwdHosts, action) <-
            C.makeServerInput (Just uCap) maybeSummary audience (AP.ApplyActivity apply)
        applyC ep actor (Just $ Left cap) localRecips remoteRecips fwdHosts action apply

    case result of
        Left e -> setMessage $ toHtml e
        Right _ -> setMessage "Patches applied successfully!"
    redirect $ ClothR loomHash clothHash

postClothFollowR :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler ()
postClothFollowR _ = error "Temporarily disabled"

postClothUnfollowR :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler ()
postClothUnfollowR _ = error "Temporarily disabled"

getClothReplyR :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler Html
getClothReplyR loomHash clothHash =
    getTopReply $ ClothReplyR loomHash clothHash

postClothReplyR :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler Html
postClothReplyR loomHash clothHash =
    postReply
        (ClothReplyR loomHash clothHash)
        [LocalActorLoom loomHash]
        [ LocalStageLoomFollowers loomHash
        , LocalStageClothFollowers loomHash clothHash
        ]
        (ClothR loomHash clothHash)
        Nothing

getClothReplyOnR
    :: KeyHashid Loom
    -> KeyHashid TicketLoom
    -> KeyHashid Message
    -> Handler Html
getClothReplyOnR loomHash clothHash msgHash = do
    msgID <- decodeKeyHashid404 msgHash
    hashMsg <- getEncodeKeyHashid
    getReply
        (ClothReplyOnR loomHash clothHash . hashMsg)
        (selectDiscussionID loomHash clothHash)
        msgID

postClothReplyOnR
    :: KeyHashid Loom
    -> KeyHashid TicketLoom
    -> KeyHashid Message
    -> Handler Html
postClothReplyOnR loomHash clothHash msgHash = do
    msgID <- decodeKeyHashid404 msgHash
    postReply
        (ClothReplyOnR loomHash clothHash msgHash)
        [LocalActorLoom loomHash]
        [ LocalStageLoomFollowers loomHash
        , LocalStageClothFollowers loomHash clothHash
        ]
        (ClothR loomHash clothHash)
        (Just (selectDiscussionID loomHash clothHash, msgID))































{-
getSharerProposalsR :: ShrIdent -> Handler TypedContent
getSharerProposalsR =
    getSharerWorkItems SharerProposalsR SharerProposalR countPatches selectPatches
    where
    countPatches pid = fmap toOne $
        E.select $ E.from $ \ (tal `E.InnerJoin` lt `E.LeftOuterJoin` tup) -> do
            E.on $ E.just (tal E.^. TicketAuthorLocalId) E.==. tup E.?. TicketUnderProjectAuthor
            E.on $ tal E.^. TicketAuthorLocalTicket E.==. lt E.^. LocalTicketId
            E.where_ $
                tal E.^. TicketAuthorLocalAuthor E.==. E.val pid E.&&.
                E.isNothing (tup E.?. TicketUnderProjectId) E.&&.
                E.exists
                    (E.from $ \ bn ->
                        E.where_ $ lt E.^. LocalTicketTicket E.==. bn E.^. BundleTicket
                    )
            return $ E.count $ tal E.^. TicketAuthorLocalId
        where
        toOne [x] = E.unValue x
        toOne []  = error "toOne = 0"
        toOne _   = error "toOne > 1"
    selectPatches pid off lim =
        E.select $ E.from $ \ (tal `E.InnerJoin` lt `E.LeftOuterJoin` tup) -> do
            E.on $ E.just (tal E.^. TicketAuthorLocalId) E.==. tup E.?. TicketUnderProjectAuthor
            E.on $ tal E.^. TicketAuthorLocalTicket E.==. lt E.^. LocalTicketId
            E.where_ $
                tal E.^. TicketAuthorLocalAuthor E.==. E.val pid E.&&.
                E.isNothing (tup E.?. TicketUnderProjectId) E.&&.
                E.exists
                    (E.from $ \ bn ->
                        E.where_ $ lt E.^. LocalTicketTicket E.==. bn E.^. BundleTicket
                    )
            E.orderBy [E.desc $ tal E.^. TicketAuthorLocalId]
            E.offset $ fromIntegral off
            E.limit $ fromIntegral lim
            return $ tal E.^. TicketAuthorLocalId

getSharerProposalR
    :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerProposalR shr talkhid = do
    (ticket, bnid, repo, massignee) <- runDB $ do
        (_, _, Entity tid t, tp, _, bnid :| _) <- getSharerProposal404 shr talkhid
        (,,,) t bnid
            <$> bitraverse
                    (\ (_, Entity _ trl) -> do
                        r <- getJust $ ticketRepoLocalRepo trl
                        s <- getJust $ repoSharer r
                        return (s, r, ticketRepoLocalBranch trl)
                    )
                    (\ (Entity _ tpr, _) -> do
                        roid <-
                            case ticketProjectRemoteProject tpr of
                                Nothing ->
                                    remoteActorIdent <$>
                                        getJust (ticketProjectRemoteTracker tpr)
                                Just roid -> return roid
                        ro <- getJust roid
                        i <- getJust $ remoteObjectInstance ro
                        return (i, ro)
                    )
                    tp
            <*> (for (ticketAssignee t) $ \ pidAssignee -> do
                    p <- getJust pidAssignee
                    getJust $ personIdent p
                )
    hLocal <- getsYesod siteInstanceHost
    encodeRouteLocal <- getEncodeRouteLocal
    encodeRouteHome <- getEncodeRouteHome
    encodeBundleId <- getEncodeKeyHashid
    let ticketAP = AP.Ticket
            { AP.ticketLocal        = Just
                ( hLocal
                , AP.TicketLocal
                    { AP.ticketId =
                        encodeRouteLocal $ SharerProposalR shr talkhid
                    , AP.ticketReplies =
                        encodeRouteLocal $ SharerProposalDiscussionR shr talkhid
                    , AP.ticketParticipants =
                        encodeRouteLocal $ SharerProposalFollowersR shr talkhid
                    , AP.ticketTeam = Nothing
                    , AP.ticketEvents =
                        encodeRouteLocal $ SharerProposalEventsR shr talkhid
                    , AP.ticketDeps =
                        encodeRouteLocal $ SharerProposalDepsR shr talkhid
                    , AP.ticketReverseDeps =
                        encodeRouteLocal $ SharerProposalReverseDepsR shr talkhid
                    }
                )
            , AP.ticketAttributedTo = encodeRouteLocal $ SharerR shr
            , AP.ticketPublished    = Just $ ticketCreated ticket
            , AP.ticketUpdated      = Nothing
            , AP.ticketContext      =
                Just $
                    case repo of
                        Left (s, r, _) ->
                            encodeRouteHome $
                                RepoR (sharerIdent s) (repoIdent r)
                        Right (i, ro) ->
                            ObjURI (instanceHost i) (remoteObjectIdent ro)
            , AP.ticketSummary      = TextHtml $ ticketTitle ticket
            , AP.ticketContent      = TextHtml $ ticketDescription ticket
            , AP.ticketSource       = TextPandocMarkdown $ ticketSource ticket
            , AP.ticketAssignedTo   =
                encodeRouteHome . SharerR . sharerIdent <$> massignee
            , AP.ticketResolved     =
                if ticketStatus ticket == TSClosed
                    then Just (Nothing, Nothing)
                    else Nothing
            , AP.ticketAttachment   = Just
                ( case repo of
                    Left _ -> hLocal
                    Right (i, _) -> instanceHost i
                , MergeRequest
                    { mrOrigin = Nothing
                    , mrTarget =
                        case repo of
                            Left (s, r, Nothing) ->
                                encodeRouteLocal $
                                    RepoR (sharerIdent s) (repoIdent r)
                            Left (s, r, Just b) ->
                                encodeRouteLocal $
                                    RepoBranchR (sharerIdent s) (repoIdent r) b
                            Right (_, ro) ->
                                remoteObjectIdent ro
                    , mrBundle =
                        Left $ encodeRouteHome $
                            SharerProposalBundleR shr talkhid $
                                encodeBundleId bnid
                    }
                )
            }
    provideHtmlAndAP ticketAP $ redirectToPrettyJSON here
    where
    here = SharerProposalR shr talkhid

getSharerProposalDepsR
    :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerProposalDepsR shr talkhid =
    getDependencyCollection here getTicket404
    where
    here = SharerProposalDepsR shr talkhid
    getTicket404 = do
        (_, Entity ltid _, _, _, _, _) <- getSharerProposal404 shr talkhid
        return ltid

getSharerProposalReverseDepsR
    :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerProposalReverseDepsR shr talkhid =
    getReverseDependencyCollection here getTicket404
    where
    here = SharerProposalDepsR shr talkhid
    getTicket404 = do
        (_, Entity ltid _, _, _, _, _) <- getSharerProposal404 shr talkhid
        return ltid

getSharerProposalFollowersR
    :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerProposalFollowersR shr talkhid = getFollowersCollection here getFsid
    where
    here = SharerProposalFollowersR shr talkhid
    getFsid = do
        (_, Entity _ lt, _, _, _, _) <- getSharerProposal404 shr talkhid
        return $ localTicketFollowers lt

getSharerProposalEventsR
    :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerProposalEventsR shr talkhid = do
    _ <- runDB $ getSharerProposal404 shr talkhid
    provideEmptyCollection
        CollectionTypeOrdered
        (SharerProposalEventsR shr talkhid)

getSharerProposalBundleR
    :: ShrIdent
    -> KeyHashid TicketAuthorLocal
    -> KeyHashid Bundle
    -> Handler TypedContent
getSharerProposalBundleR shr talkhid bnkhid = do
    (ptids, prevs, mcurr) <- runDB $ do
        (_, _, Entity tid _, _, _, v :| vs) <- getSharerProposal404 shr talkhid
        bnid <- decodeKeyHashid404 bnkhid
        bn <- get404 bnid
        unless (bundleTicket bn == tid) notFound
        ptids <- selectKeysList [PatchBundle ==. bnid] [Desc PatchId]
        ptidsNE <-
            case nonEmpty ptids of
                Nothing -> error "Bundle without any Patches in DB"
                Just ne -> return ne
        let (prevs, mcurr) =
                if bnid == v
                    then (vs, Nothing)
                    else ([], Just v)
        return (ptidsNE, prevs, mcurr)

    encodeRouteLocal <- getEncodeRouteLocal
    encodeBNID <- getEncodeKeyHashid
    encodePTID <- getEncodeKeyHashid

    let versionRoute = SharerProposalBundleR shr talkhid . encodeBNID
        local = BundleLocal
            { bundleId             = encodeRouteLocal here
            , bundleContext        =
                encodeRouteLocal $ SharerProposalR shr talkhid
            , bundlePrevVersions   =
                map (encodeRouteLocal . versionRoute) prevs
            , bundleCurrentVersion = encodeRouteLocal . versionRoute <$> mcurr
            }
        bundleAP =
            AP.BundleHosted
                (Just local)
                (NE.map
                    ( encodeRouteLocal
                    . SharerProposalBundlePatchR shr talkhid bnkhid
                    . encodePTID
                    )
                    ptids
                )
    provideHtmlAndAP bundleAP $ redirectToPrettyJSON here
    where
    here = SharerProposalBundleR shr talkhid bnkhid

getSharerProposalBundlePatchR
    :: ShrIdent
    -> KeyHashid TicketAuthorLocal
    -> KeyHashid Bundle
    -> KeyHashid Patch
    -> Handler TypedContent
getSharerProposalBundlePatchR shr talkhid bnkhid ptkhid = do
    patch <- runDB $ do
        (_, _, _, _, _, vers) <- getSharerProposal404 shr talkhid
        bnid <- decodeKeyHashid404 bnkhid
        unless (bnid `elem` vers) notFound
        ptid <- decodeKeyHashid404 ptkhid
        pt <- get404 ptid
        unless (patchBundle pt == bnid) notFound
        return pt

    encodeRouteLocal <- getEncodeRouteLocal
    hLocal <- getsYesod siteInstanceHost

    let patchAP = AP.Patch
            { AP.patchLocal        = Just
                ( hLocal
                , AP.PatchLocal
                    { AP.patchId             = encodeRouteLocal here
                    , AP.patchContext        =
                        encodeRouteLocal $
                            SharerProposalBundleR shr talkhid bnkhid
                    }
                )
            , AP.patchAttributedTo = encodeRouteLocal $ SharerR shr
            , AP.patchPublished    = Just $ patchCreated patch
            , AP.patchType         = patchType patch
            , AP.patchContent      = patchContent patch
            }
    provideHtmlAndAP patchAP $ redirectToPrettyJSON here
    where
    here = SharerProposalBundlePatchR shr talkhid bnkhid ptkhid

getRepoProposalsR :: ShrIdent -> RpIdent -> Handler TypedContent
getRepoProposalsR shr rp = do
    (total, pages, mpage) <- runDB $ do
        sid <- getKeyBy404 $ UniqueSharer shr
        rid <- getKeyBy404 $ UniqueRepo rp sid
        getPageAndNavCount (countPatches rid) (selectPatches rid)

    encodeRouteHome <- getEncodeRouteHome
    encodeRouteLocal <- getEncodeRouteLocal
    encodeRoutePageLocal <- getEncodeRoutePageLocal
    let here = RepoProposalsR shr rp
        pageUrl = encodeRoutePageLocal here
    encodeLT <- getEncodeKeyHashid
    encodeTAL <- getEncodeKeyHashid
    let patchUrl (Left (E.Value ltid, E.Value mtalid, E.Value mshr, E.Value mtupid)) =
            encodeRouteHome $
                case (mtalid, mshr, mtupid) of
                    (Nothing, Nothing, Nothing) -> RepoProposalR shr rp $ encodeLT ltid
                    (Just talid, Just shrA, Nothing) -> SharerProposalR shrA $ encodeTAL talid
                    (Just _, Just _, Just _) -> RepoProposalR shr rp $ encodeLT ltid
                    _ -> error "Impossible"
        patchUrl (Right (E.Value h, E.Value lu)) = ObjURI h lu

    case mpage of
        Nothing -> provide here $ Collection
            { collectionId         = encodeRouteLocal here
            , collectionType       = CollectionTypeOrdered
            , collectionTotalItems = Just total
            , collectionCurrent    = Nothing
            , collectionFirst      = Just $ pageUrl 1
            , collectionLast       = Just $ pageUrl pages
            , collectionItems      = [] :: [Text]
            }
        Just (patches, navModel) ->
            let current = nmCurrent navModel
            in  provide here $ CollectionPage
                    { collectionPageId         = pageUrl current
                    , collectionPageType       = CollectionPageTypeOrdered
                    , collectionPageTotalItems = Nothing
                    , collectionPageCurrent    = Just $ pageUrl current
                    , collectionPageFirst      = Just $ pageUrl 1
                    , collectionPageLast       = Just $ pageUrl pages
                    , collectionPagePartOf     = encodeRouteLocal here
                    , collectionPagePrev       =
                        if current > 1
                            then Just $ pageUrl $ current - 1
                            else Nothing
                    , collectionPageNext       =
                        if current < pages
                            then Just $ pageUrl $ current + 1
                            else Nothing
                    , collectionPageStartIndex = Nothing
                    , collectionPageItems      = map patchUrl patches
                    }
    where
    provide :: ActivityPub a => Route App -> a URIMode -> Handler TypedContent
    provide here a = provideHtmlAndAP a $ redirectToPrettyJSON here
    countPatches rid = count [TicketRepoLocalRepo ==. rid]
    selectPatches rid off lim = do
        tids <- E.select $ E.from $ \ (tcl `E.InnerJoin` trl) -> do
            E.on $ tcl E.^. TicketContextLocalId E.==. trl E.^. TicketRepoLocalContext
            E.where_ $ trl E.^. TicketRepoLocalRepo E.==. E.val rid
            E.orderBy [E.desc $ tcl E.^. TicketContextLocalTicket]
            E.offset $ fromIntegral off
            E.limit $ fromIntegral lim
            return $ tcl E.^. TicketContextLocalTicket
        let tids' = map E.unValue tids
        locals <- E.select $ E.from $ \ (lt `E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` s `E.LeftOuterJoin` tup)) -> do
            E.on $ tal E.?. TicketAuthorLocalId E.==. tup E.?. TicketUnderProjectAuthor
            E.on $ p E.?. PersonIdent E.==. s E.?. SharerId
            E.on $ tal E.?. TicketAuthorLocalAuthor E.==. p E.?. PersonId
            E.on $ E.just (lt E.^. LocalTicketId) E.==. tal E.?. TicketAuthorLocalTicket
            E.where_ $ lt E.^. LocalTicketTicket `E.in_` E.valList tids'
            E.orderBy [E.desc $ lt E.^. LocalTicketTicket]
            return
                ( lt E.^. LocalTicketTicket
                , ( lt E.^. LocalTicketId
                  , tal E.?. TicketAuthorLocalId
                  , s E.?. SharerIdent
                  , tup E.?. TicketUnderProjectId
                  )
                )
        remotes <- E.select $ E.from $ \ (tcl `E.InnerJoin` tar `E.InnerJoin` rt `E.InnerJoin` ro `E.InnerJoin` i) -> do
            E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId
            E.on $ rt E.^. RemoteTicketIdent E.==. ro E.^. RemoteObjectId
            E.on $ tar E.^. TicketAuthorRemoteId E.==. rt E.^. RemoteTicketTicket
            E.on $ tcl E.^. TicketContextLocalId E.==. tar E.^. TicketAuthorRemoteTicket
            E.where_ $ tcl E.^. TicketContextLocalTicket `E.in_` E.valList tids'
            E.orderBy [E.desc $ tcl E.^. TicketContextLocalTicket]
            return
                ( tcl E.^. TicketContextLocalTicket
                , ( i E.^. InstanceHost
                  , ro E.^. RemoteObjectIdent
                  )
                )
        return $
            map snd $
                LO.mergeBy
                    (flip compare `on` fst)
                    (map (second Left) locals)
                    (map (second Right) remotes)

getRepoProposalR
    :: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> Handler TypedContent
getRepoProposalR shr rp ltkhid = do
    (ticket, bnid, trl, author, massignee, mresolved) <- runDB $ do
        (_, _, Entity tid t, _, _, Entity _ trl, ta, tr, bnid :| _) <- getRepoProposal404 shr rp ltkhid
        (,,,,,) t bnid trl
            <$> bitraverse
                    (\ (Entity _ tal, _) -> do
                        p <- getJust $ ticketAuthorLocalAuthor tal
                        getJust $ personIdent p
                    )
                    (\ (Entity _ tar) -> do
                        ra <- getJust $ ticketAuthorRemoteAuthor tar
                        ro <- getJust $ remoteActorIdent ra
                        i <- getJust $ remoteObjectInstance ro
                        return (i, ro)
                    )
                    ta
            <*> (for (ticketAssignee t) $ \ pidAssignee -> do
                    p <- getJust pidAssignee
                    getJust $ personIdent p
                )
            <*> (for tr $ \ (_, etrx) ->
                    bitraverse
                        (\ (Entity _ trl) -> do
                            let obiid = ticketResolveLocalActivity trl
                            obid <- outboxItemOutbox <$> getJust obiid
                            ent <- getOutboxActorEntity obid
                            actor <- actorEntityPath ent
                            return (actor, obiid)
                        )
                        (\ (Entity _ trr) -> do
                            roid <-
                                remoteActivityIdent <$>
                                    getJust (ticketResolveRemoteActivity trr)
                            ro <- getJust roid
                            i <- getJust $ remoteObjectInstance ro
                            return (i, ro)
                        )
                        etrx
                )
    hLocal <- getsYesod siteInstanceHost
    encodeRouteLocal <- getEncodeRouteLocal
    encodeRouteHome <- getEncodeRouteHome
    encodeBundleId <- getEncodeKeyHashid
    encodeObiid <- getEncodeKeyHashid
    let host =
            case author of
                Left _       -> hLocal
                Right (i, _) -> instanceHost i
        ticketAP = AP.Ticket
            { AP.ticketLocal        = Just
                ( hLocal
                , AP.TicketLocal
                    { AP.ticketId =
                        encodeRouteLocal $ RepoProposalR shr rp ltkhid
                    , AP.ticketReplies =
                        encodeRouteLocal $ RepoProposalDiscussionR shr rp ltkhid
                    , AP.ticketParticipants =
                        encodeRouteLocal $ RepoProposalFollowersR shr rp ltkhid
                    , AP.ticketTeam = Nothing
                    , AP.ticketEvents =
                        encodeRouteLocal $ RepoProposalEventsR shr rp ltkhid
                    , AP.ticketDeps =
                        encodeRouteLocal $ RepoProposalDepsR shr rp ltkhid
                    , AP.ticketReverseDeps =
                        encodeRouteLocal $ RepoProposalReverseDepsR shr rp ltkhid
                    }
                )
            , AP.ticketAttributedTo =
                case author of
                    Left sharer ->
                        encodeRouteLocal $ SharerR $ sharerIdent sharer
                    Right (_inztance, object) ->
                        remoteObjectIdent object
            , AP.ticketPublished    = Just $ ticketCreated ticket
            , AP.ticketUpdated      = Nothing
            , AP.ticketContext      = Just $ encodeRouteHome $ RepoR shr rp
            , AP.ticketSummary      = TextHtml $ ticketTitle ticket
            , AP.ticketContent      = TextHtml $ ticketDescription ticket
            , AP.ticketSource       = TextPandocMarkdown $ ticketSource ticket
            , AP.ticketAssignedTo   =
                encodeRouteHome . SharerR . sharerIdent <$> massignee
            , AP.ticketResolved     =
                let u (Left (actor, obiid)) =
                        encodeRouteHome $
                            outboxItemRoute actor $ encodeObiid obiid
                    u (Right (i, ro)) =
                        ObjURI (instanceHost i) (remoteObjectIdent ro)
                in  (,Nothing) . Just . u <$> mresolved
            , AP.ticketAttachment   = Just
                ( hLocal
                , MergeRequest
                    { mrOrigin = Nothing
                    , mrTarget =
                        encodeRouteLocal $
                            case ticketRepoLocalBranch trl of
                                Nothing -> RepoR shr rp
                                Just b -> RepoBranchR shr rp b
                    , mrBundle =
                        Left $ encodeRouteHome $
                            RepoProposalBundleR shr rp ltkhid $
                                encodeBundleId bnid
                    }
                )
            }
    provideHtmlAndAP' host ticketAP $ redirectToPrettyJSON here
    where
    here = RepoProposalR shr rp ltkhid

getRepoProposalDepsR
    :: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> Handler TypedContent
getRepoProposalDepsR shr rp ltkhid =
    getDependencyCollection here getTicketId404
    where
    here = RepoProposalDepsR shr rp ltkhid
    getTicketId404 = do
        (_, _, _, Entity ltid _, _, _, _, _, _) <- getRepoProposal404 shr rp ltkhid
        return ltid

getRepoProposalReverseDepsR
    :: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> Handler TypedContent
getRepoProposalReverseDepsR shr rp ltkhid =
    getReverseDependencyCollection here getTicketId404
    where
    here = RepoProposalReverseDepsR shr rp ltkhid
    getTicketId404 = do
        (_, _, _, Entity ltid _, _, _, _, _, _) <- getRepoProposal404 shr rp ltkhid
        return ltid

getRepoProposalFollowersR
    :: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> Handler TypedContent
getRepoProposalFollowersR shr rp ltkhid = getFollowersCollection here getFsid
    where
    here = RepoProposalFollowersR shr rp ltkhid
    getFsid = do
        (_, _, _, Entity _ lt, _, _, _, _, _) <- getRepoProposal404 shr rp ltkhid
        return $ localTicketFollowers lt

getRepoProposalEventsR
    :: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> Handler TypedContent
getRepoProposalEventsR shr rp ltkhid = do
    _ <- runDB $ getRepoProposal404 shr rp ltkhid
    provideEmptyCollection
        CollectionTypeOrdered
        (RepoProposalEventsR shr rp ltkhid)
-}