{- This file is part of Vervis.
 -
 - Written in 2019, 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.Client
    ( makeServerInput

    , comment
    --, createThread
    --, createReply
    --, follow
    --, followSharer
    --, followProject
    --, followTicket
    --, followRepo
    , offerIssue
    --, resolve
    --, undoFollowSharer
    --, undoFollowProject
    --, undoFollowTicket
    --, undoFollowRepo
    --, unresolve
    , offerPatches
    , offerMerge
    , applyPatches
    , createDeck
    , createLoom
    , createRepo
    )
where

import Control.Exception.Base
import Control.Monad
import Control.Monad.Trans.Except
import Control.Monad.Trans.Reader
import Data.Bifunctor
import Data.Bitraversable
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe
import Data.Text (Text)
import Database.Persist
import Database.Persist.Sql
import Text.Blaze.Html (preEscapedToHtml)
import Text.Blaze.Html.Renderer.Text
import Text.Hamlet
import Yesod.Core
import Yesod.Core.Handler
import Yesod.Persist.Core

import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

import Development.PatchMediaType
import Network.FedURI
import Web.ActivityPub hiding (Follow, Ticket, Project (..), Repo, ActorLocal (..))
import Web.Text
import Yesod.ActivityPub
import Yesod.FedURI
import Yesod.Hashids
import Yesod.MonadSite

import qualified Web.ActivityPub as AP

import Control.Monad.Trans.Except.Local
import Data.Either.Local
import Database.Persist.Local

import Vervis.ActivityPub
import Vervis.Cloth
import Vervis.Data.Ticket
import Vervis.FedURI
import Vervis.Foundation
import Vervis.Model
import Vervis.Recipient
import Vervis.RemoteActorStore
import Vervis.Ticket

makeServerInput
    :: (MonadSite m, SiteEnv m ~ App)
    => Maybe FedURI
    -> Maybe HTML
    -> [Aud URIMode]
    -> AP.SpecificActivity URIMode
    -> m ( RecipientRoutes
         , [(Host, NonEmpty LocalURI)]
         , [Host]
         , AP.Action URIMode
         )
makeServerInput maybeCapURI maybeSummary audience specific = do
    encodeRouteHome <- getEncodeRouteHome
    let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
            collectAudience audience
        recips = map encodeRouteHome audLocal ++ audRemote
        action = AP.Action
            { AP.actionCapability = maybeCapURI
            , AP.actionSummary    = maybeSummary
            , AP.actionAudience   = AP.Audience recips [] [] [] [] []
            , AP.actionFulfills   = []
            , AP.actionSpecific   = specific
            }
    return (recipientSet, remoteActors, fwdHosts, action)

comment
    :: KeyHashid Person
    -> PandocMarkdown
    -> [LocalActorBy KeyHashid]
    -> [LocalStageBy KeyHashid]
    -> Route App
    -> Maybe FedURI
    -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Note URIMode)
comment senderHash source actors stages topicR muParent = do
    encodeRouteLocal <- getEncodeRouteLocal
    encodeRouteHome <- getEncodeRouteHome
    content <- ExceptT . pure $ renderPandocMarkdown source
    let audience = [AudLocal actors stages]
        uTopic = encodeRouteHome topicR
        note = AP.Note
            { AP.noteId        = Nothing
            , AP.noteAttrib    = encodeRouteLocal $ PersonR senderHash
            , AP.noteAudience  = emptyAudience
            , AP.noteReplyTo   = Just $ fromMaybe uTopic muParent
            , AP.noteContext   = Just uTopic
            , AP.notePublished = Nothing
            , AP.noteSource    = source
            , AP.noteContent   = content
            }
    return (Nothing, audience, note)

{-
createThread
    :: KeyHashid Person
    -> PandocMarkdown
    -> Host
    -> [Route App]
    -> [Route App]
    -> Route App
    -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Note URIMode)
createThread senderHash source hDest recipsA recipsC context = runExceptT $ do
    encodeRouteLocal <- getEncodeRouteLocal
    let encodeRecipRoute = ObjURI hDest . encodeRouteLocal
    contentHtml <- ExceptT . pure $ renderPandocMarkdown msg
    let uContext = encodeRecipRoute context
        recips = recipsA ++ recipsC
    return Note
        { noteId        = Nothing
        , noteAttrib    = encodeRouteLocal $ SharerR shrAuthor
        , noteAudience  = Audience
            { audienceTo        = map encodeRecipRoute recips
            , audienceBto       = []
            , audienceCc        = []
            , audienceBcc       = []
            , audienceGeneral   = []
            , audienceNonActors = map encodeRecipRoute recipsC
            }
        , noteReplyTo   = Just uContext
        , noteContext   = Just uContext
        , notePublished = Nothing
        , noteSource    = msg
        , noteContent   = contentHtml
        }

createReply
    :: ShrIdent
    -> TextPandocMarkdown
    -> Host
    -> [Route App]
    -> [Route App]
    -> Route App
    -> MessageId
    -> Handler (Either Text (Note URIMode))
createReply shrAuthor (TextPandocMarkdown msg) hDest recipsA recipsC context midParent = runExceptT $ do
    error "Temporarily disabled"
    {-
    encodeRouteHome <- getEncodeRouteHome
    encodeRouteLocal <- getEncodeRouteLocal
    let encodeRecipRoute = ObjURI hDest . encodeRouteLocal
    uParent <- lift $ runDB $ do
        _m <- get404 midParent
        mlocal <- getBy $ UniqueLocalMessage midParent
        mremote <- getValBy $ UniqueRemoteMessage midParent
        case (mlocal, mremote) of
            (Nothing, Nothing) -> error "Message with no author"
            (Just _, Just _) -> error "Message used as both local and remote"
            (Just (Entity lmidParent lm), Nothing) -> do
                p <- getJust $ localMessageAuthor lm
                s <- getJust $ personIdent p
                lmkhid <- encodeKeyHashid lmidParent
                return $ encodeRouteHome $ MessageR (sharerIdent s) lmkhid
            (Nothing, Just rm) -> do
                ro <- getJust $ remoteMessageIdent rm
                i <- getJust $ remoteObjectInstance ro
                return $ ObjURI (instanceHost i) (remoteObjectIdent ro)
    contentHtml <- ExceptT . pure $ renderPandocMarkdown msg
    let uContext = encodeRecipRoute context
        recips = recipsA ++ recipsC
    return Note
        { noteId        = Nothing
        , noteAttrib    = encodeRouteLocal $ SharerR shrAuthor
        , noteAudience  = Audience
            { audienceTo        = map encodeRecipRoute recips
            , audienceBto       = []
            , audienceCc        = []
            , audienceBcc       = []
            , audienceGeneral   = []
            , audienceNonActors = map encodeRecipRoute recipsC
            }
        , noteReplyTo   = Just uParent
        , noteContext   = Just uContext
        , notePublished = Nothing
        , noteSource    = msg
        , noteContent   = contentHtml
        }
    -}

follow
    :: (MonadHandler m, HandlerSite m ~ App)
    => ShrIdent -> ObjURI URIMode -> ObjURI URIMode -> Bool -> m (TextHtml, Audience URIMode, AP.Follow URIMode)
follow shrAuthor uObject@(ObjURI hObject luObject) uRecip hide = do
    error "Temporarily disabled"
    {-
    summary <-
        TextHtml . TL.toStrict . renderHtml <$>
            withUrlRenderer
                [hamlet|
                    <p>
                      <a href=@{SharerR shrAuthor}>
                        #{shr2text shrAuthor}
                      \ requested to follow #
                        <a href=#{renderObjURI uObject}>
                          #{renderAuthority hObject}#{localUriPath luObject}
                      \.
                |]
    let followAP = AP.Follow
            { followObject  = uObject
            , followContext =
                if uObject == uRecip
                    then Nothing
                    else Just uRecip
            , followHide    = hide
            }
        audience = Audience [uRecip] [] [] [] [] []
    return (summary, audience, followAP)
    -}

followSharer
    :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => ShrIdent -> ShrIdent -> Bool -> m (TextHtml, Audience URIMode, AP.Follow URIMode)
followSharer shrAuthor shrObject hide = do
    error "Temporarily disabled"
    {-
    encodeRouteHome <- getEncodeRouteHome
    let uObject = encodeRouteHome $ SharerR shrObject
    follow shrAuthor uObject uObject hide
    -}

followProject
    :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => ShrIdent -> ShrIdent -> PrjIdent -> Bool -> m (TextHtml, Audience URIMode, AP.Follow URIMode)
followProject shrAuthor shrObject prjObject hide = do
    error "Temporarily disabled"
    {-
    encodeRouteHome <- getEncodeRouteHome
    let uObject = encodeRouteHome $ ProjectR shrObject prjObject
    follow shrAuthor uObject uObject hide
    -}

followTicket
    :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => ShrIdent -> ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Bool -> m (TextHtml, Audience URIMode, AP.Follow URIMode)
followTicket shrAuthor shrObject prjObject numObject hide = do
    error "Temporarily disabled"
    {-
    encodeRouteHome <- getEncodeRouteHome
    let uObject = encodeRouteHome $ ProjectTicketR shrObject prjObject numObject
        uRecip = encodeRouteHome $ ProjectR shrObject prjObject
    follow shrAuthor uObject uRecip hide
    -}

followRepo
    :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => ShrIdent -> ShrIdent -> RpIdent -> Bool -> m (TextHtml, Audience URIMode, AP.Follow URIMode)
followRepo shrAuthor shrObject rpObject hide = do
    error "Temporarily disabled"
    {-
    encodeRouteHome <- getEncodeRouteHome
    let uObject = encodeRouteHome $ RepoR shrObject rpObject
    follow shrAuthor uObject uObject hide
    -}
-}

offerIssue
    :: KeyHashid Person -> Text -> PandocMarkdown -> FedURI
    -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Ticket URIMode)
offerIssue senderHash title desc uTracker = do

    tracker <- do
        tracker <- checkTracker uTracker
        case tracker of
            TrackerDeck deckID -> Left <$> encodeKeyHashid deckID
            TrackerLoom _ -> throwE "Local patch tracker doesn't take issues"
            TrackerRemote (ObjURI hTracker luTracker) -> Right <$> do
                instanceID <- lift $ runDB $ either entityKey id <$> insertBy' (Instance hTracker)
                result <- ExceptT $ first (T.pack . displayException) <$> fetchRemoteActor instanceID hTracker luTracker
                case result of
                    Left Nothing -> throwE "Tracker @id mismatch"
                    Left (Just err) -> throwE $ T.pack $ displayException err
                    Right Nothing -> throwE "Tracker isn't an actor"
                    Right (Just actor) -> return (entityVal actor, uTracker)

    descHtml <- ExceptT . pure $ renderPandocMarkdown desc

    encodeRouteLocal <- getEncodeRouteLocal
    hLocal <- asksSite siteInstanceHost

    let audAuthor =
            AudLocal [] [LocalStagePersonFollowers senderHash]
        audTracker =
            case tracker of
                Left deckHash ->
                    AudLocal
                        [LocalActorDeck deckHash]
                        [LocalStageDeckFollowers deckHash]
                Right (remoteActor, ObjURI hTracker luTracker) ->
                    AudRemote hTracker
                        [luTracker]
                        (maybeToList $ remoteActorFollowers remoteActor)

        audience = [audAuthor, audTracker]

        ticket = AP.Ticket
            { AP.ticketLocal        = Nothing
            , AP.ticketAttributedTo = encodeRouteLocal $ PersonR senderHash
            , AP.ticketPublished    = Nothing
            , AP.ticketUpdated      = Nothing
            , AP.ticketContext      = Nothing
            , AP.ticketSummary      = encodeEntities title
            , AP.ticketContent      = descHtml
            , AP.ticketSource       = desc
            , AP.ticketAssignedTo   = Nothing
            , AP.ticketResolved     = Nothing
            , AP.ticketAttachment   = Nothing
            }

    return (Nothing, audience, ticket)

{-
{-
resolve
    :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => ShrIdent
    -> FedURI
    -> m (Either Text (Maybe TextHtml, Audience URIMode, Resolve URIMode))
resolve shrUser uObject = runExceptT $ do
    encodeRouteHome <- getEncodeRouteHome
    wiFollowers <- askWorkItemFollowers
    object <- parseWorkItem "Resolve object" uObject
    WorkItemDetail ident context author <- runWorkerExcept $ getWorkItemDetail "Object" object
    let audAuthor =
            AudLocal
                [LocalActorSharer shrUser]
                [LocalPersonCollectionSharerFollowers shrUser]
        audTicketContext = contextAudience context
        audTicketAuthor = authorAudience author
        audTicketFollowers =
            case ident of
                Left (wi, _ltid) -> AudLocal [] [wiFollowers wi]
                Right (ObjURI h _, luFollowers) -> AudRemote h [] [luFollowers]

        (_, _, _, audLocal, audRemote) =
            collectAudience $
                audAuthor :
                audTicketAuthor :
                audTicketFollowers :
                audTicketContext

        recips = map encodeRouteHome audLocal ++ audRemote
    return (Nothing, Audience recips [] [] [] [] [], Resolve uObject)
    -}

undoFollow
    :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => ShrIdent
    -> PersonId
    -> ExceptT Text (ReaderT SqlBackend m) FollowerSetId
    -> Text
    -> Route App
    -> Route App
    -> m (Either Text (TextHtml, Audience URIMode, Undo URIMode))
undoFollow shrAuthor pidAuthor getFsid typ objRoute recipRoute = runExceptT $ do
    error "Temporarily disabled"
    {-
    encodeRouteLocal <- getEncodeRouteLocal
    encodeRouteHome <- getEncodeRouteHome
    obiidFollow <- runSiteDBExcept $ do
        fsid <- getFsid
        mf <- lift $ getValBy $ UniqueFollow pidAuthor fsid
        followFollow <$> fromMaybeE mf ("Not following this " <> typ)
    obikhidFollow <- encodeKeyHashid obiidFollow
    summary <- do
        hLocal <- asksSite siteInstanceHost
        TextHtml . TL.toStrict . renderHtml <$>
            withUrlRenderer
                [hamlet|
                    <p>
                      <a href=@{SharerR shrAuthor}>
                        #{shr2text shrAuthor}
                      \ unfollowed #
                        <a href=@{objRoute}>
                          #{renderAuthority hLocal}#{localUriPath $ encodeRouteLocal objRoute}
                      \.
                |]
    let undo = Undo
            { undoObject =
                encodeRouteHome $ SharerOutboxItemR shrAuthor obikhidFollow
            }
        audience = Audience [encodeRouteHome recipRoute] [] [] [] [] []
    return (summary, audience, undo)
    -}

undoFollowSharer
    :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => ShrIdent
    -> PersonId
    -> ShrIdent
    -> m (Either Text (TextHtml, Audience URIMode, Undo URIMode))
undoFollowSharer shrAuthor pidAuthor shrFollowee =
    error "Temporarily disabled"
    {-
    undoFollow shrAuthor pidAuthor getFsid "sharer" objRoute objRoute
    where
    objRoute = SharerR shrFollowee
    getFsid = do
        sidFollowee <- do
            msid <- lift $ getKeyBy $ UniqueSharer shrFollowee
            fromMaybeE msid "No such local sharer"
        mp <- lift $ getValBy $ UniquePersonIdent sidFollowee
        personFollowers <$>
            fromMaybeE mp "Unfollow target local sharer isn't a person"

undoFollowProject
    :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => ShrIdent
    -> PersonId
    -> ShrIdent
    -> PrjIdent
    -> m (Either Text (TextHtml, Audience URIMode, Undo URIMode))
undoFollowProject shrAuthor pidAuthor shrFollowee prjFollowee =
    undoFollow shrAuthor pidAuthor getFsid "project" objRoute objRoute
    where
    objRoute = ProjectR shrFollowee prjFollowee
    getFsid = do
        sidFollowee <- do
            msid <- lift $ getKeyBy $ UniqueSharer shrFollowee
            fromMaybeE msid "No such local sharer"
        mj <- lift $ getValBy $ UniqueProject prjFollowee sidFollowee
        j <- fromMaybeE mj "Unfollow target no such local project"
        lift $ actorFollowers <$> getJust (projectActor j)
    -}

undoFollowTicket
    :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => ShrIdent
    -> PersonId
    -> ShrIdent
    -> PrjIdent
    -> KeyHashid LocalTicket
    -> m (Either Text (TextHtml, Audience URIMode, Undo URIMode))
undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee numFollowee =
    error "Temporarily disabled"
    {-
    undoFollow shrAuthor pidAuthor getFsid "project" objRoute recipRoute
    where
    objRoute = ProjectTicketR shrFollowee prjFollowee numFollowee
    recipRoute = ProjectR shrFollowee prjFollowee
    getFsid = do
        sid <- do
            msid <- lift $ getKeyBy $ UniqueSharer shrFollowee
            fromMaybeE msid "No such local sharer"
        jid <- do
            mjid <- lift $ getKeyBy $ UniqueProject prjFollowee sid
            fromMaybeE mjid "No such local project"
        ltid <- decodeKeyHashidE numFollowee "Invalid hashid for context"
        mlt <- lift $ get ltid
        lt <- fromMaybeE mlt "Unfollow target no such local ticket"
        tclid <- do
            mtclid <-
                lift $ getKeyBy $
                    UniqueTicketContextLocal $ localTicketTicket lt
            fromMaybeE mtclid "Unfollow target ticket isn't of local context"
        tpl <- do
            mtpl <- lift $ getValBy $ UniqueTicketProjectLocal tclid
            fromMaybeE mtpl "Unfollow target ticket local ctx isn't a project"
        unless (ticketProjectLocalProject tpl == jid) $
            throwE "Hashid doesn't match sharer/project"
        return $ localTicketFollowers lt
    -}

undoFollowRepo
    :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => ShrIdent
    -> PersonId
    -> ShrIdent
    -> RpIdent
    -> m (Either Text (TextHtml, Audience URIMode, Undo URIMode))
undoFollowRepo shrAuthor pidAuthor shrFollowee rpFollowee =
    error "Temporarily disabled"
    {-
    undoFollow shrAuthor pidAuthor getFsid "repo" objRoute objRoute
    where
    objRoute = RepoR shrFollowee rpFollowee
    getFsid = do
        sidFollowee <- do
            msid <- lift $ getKeyBy $ UniqueSharer shrFollowee
            fromMaybeE msid "No such local sharer"
        mr <- lift $ getValBy $ UniqueRepo rpFollowee sidFollowee
        repoFollowers <$>
            fromMaybeE mr "Unfollow target no such local repo"
    -}

unresolve
    :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => ShrIdent
    -> FedURI
    -> m (Either Text (Maybe TextHtml, Audience URIMode, Undo URIMode))
unresolve shrUser uTicket = runExceptT $ do
    error "Temporarily disabled"
    {-
    encodeRouteHome <- getEncodeRouteHome
    wiFollowers <- askWorkItemFollowers
    ticket <- parseWorkItem "Ticket" uTicket
    WorkItemDetail ident context author <- runWorkerExcept $ getWorkItemDetail "Ticket" ticket
    uResolve <-
        case ident of
            Left (_, ltid) -> runSiteDBExcept $ do
                mtrid <- lift $ getKeyBy $ UniqueTicketResolve ltid
                trid <- fromMaybeE mtrid "Ticket already isn't resolved"
                trx <-
                    lift $
                    requireEitherAlt
                        (getValBy $ UniqueTicketResolveLocal trid)
                        (getValBy $ UniqueTicketResolveRemote trid)
                        "No TRX"
                        "Both TRL and TRR"
                case trx of
                    Left trl -> lift $ do
                        let obiid = ticketResolveLocalActivity trl
                        obid <- outboxItemOutbox <$> getJust obiid
                        ent <- getOutboxActorEntity obid
                        obikhid <- encodeKeyHashid obiid
                        encodeRouteHome . flip outboxItemRoute obikhid <$>
                            actorEntityPath ent
                    Right trr -> lift $ do
                        roid <-
                            remoteActivityIdent <$>
                                getJust (ticketResolveRemoteActivity trr)
                        ro <- getJust roid
                        i <- getJust $ remoteObjectInstance ro
                        return $ ObjURI (instanceHost i) (remoteObjectIdent ro)
            Right (u, _) -> do
                manager <- asksSite appHttpManager
                Doc _ t <- withExceptT T.pack $ AP.fetchAP manager $ Left u
                case ticketResolved t of
                    Nothing -> throwE "Ticket already isn't resolved"
                    Just (muBy, _) -> fromMaybeE muBy "Ticket doesn't specify 'resolvedBy'"
    let audAuthor =
            AudLocal
                [LocalActorSharer shrUser]
                [LocalPersonCollectionSharerFollowers shrUser]
        audTicketContext = contextAudience context
        audTicketAuthor = authorAudience author
        audTicketFollowers =
            case ident of
                Left (wi, _ltid) -> AudLocal [] [wiFollowers wi]
                Right (ObjURI h _, luFollowers) -> AudRemote h [] [luFollowers]

        (_, _, _, audLocal, audRemote) =
            collectAudience $
                audAuthor :
                audTicketAuthor :
                audTicketFollowers :
                audTicketContext

        recips = map encodeRouteHome audLocal ++ audRemote
    return (Nothing, Audience recips [] [] [] [] [], Undo uResolve)
    -}
-}

offerPatches
    :: KeyHashid Person
    -> Text
    -> PandocMarkdown
    -> FedURI
    -> FedURI
    -> Maybe Text
    -> PatchMediaType
    -> NonEmpty Text
    -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Ticket URIMode)
offerPatches senderHash title desc uTracker uTargetRepo maybeBranch typ diffs = do

    tracker <- do
        tracker <- checkTracker uTracker
        case tracker of
            TrackerDeck _ -> throwE "Local ticket tracker doesn't take patches"
            TrackerLoom loomID -> Left <$> encodeKeyHashid loomID
            TrackerRemote (ObjURI hTracker luTracker) -> Right <$> do
                instanceID <- lift $ runDB $ either entityKey id <$> insertBy' (Instance hTracker)
                result <- ExceptT $ first (T.pack . displayException) <$> fetchRemoteActor instanceID hTracker luTracker
                case result of
                    Left Nothing -> throwE "Tracker @id mismatch"
                    Left (Just err) -> throwE $ T.pack $ displayException err
                    Right Nothing -> throwE "Tracker isn't an actor"
                    Right (Just actor) -> return (entityVal actor, uTracker)

    descHtml <- ExceptT . pure $ renderPandocMarkdown desc

    encodeRouteLocal <- getEncodeRouteLocal
    hLocal <- asksSite siteInstanceHost

    let audAuthor =
            AudLocal [] [LocalStagePersonFollowers senderHash]
        audTracker =
            case tracker of
                Left loomHash ->
                    AudLocal
                        [LocalActorLoom loomHash]
                        [LocalStageLoomFollowers loomHash]
                Right (remoteActor, ObjURI hTracker luTracker) ->
                    AudRemote hTracker
                        [luTracker]
                        (maybeToList $ remoteActorFollowers remoteActor)

        audience = [audAuthor, audTracker]

        luSender = encodeRouteLocal $ PersonR senderHash
        ObjURI hTargetRepo luTargetRepo = uTargetRepo
        ticket = AP.Ticket
            { AP.ticketLocal        = Nothing
            , AP.ticketAttributedTo = luSender
            , AP.ticketPublished    = Nothing
            , AP.ticketUpdated      = Nothing
            , AP.ticketContext      = Nothing
            , AP.ticketSummary      = encodeEntities title
            , AP.ticketContent      = descHtml
            , AP.ticketSource       = desc
            , AP.ticketAssignedTo   = Nothing
            , AP.ticketResolved     = Nothing
            , AP.ticketAttachment   = Just
                ( hTargetRepo
                , MergeRequest
                    { mrOrigin = Nothing
                    , mrTarget =
                        case maybeBranch of
                            Nothing -> Left luTargetRepo
                            Just b -> Right AP.Branch
                                { AP.branchName = b
                                , AP.branchRef  = "refs/heads/" <> b
                                , AP.branchRepo = luTargetRepo
                                }
                    , mrBundle = Just $ Right
                        ( hLocal
                        , BundleOffer Nothing $ NE.reverse $ NE.map
                            (\ diff -> AP.Patch
                                { AP.patchLocal        = Nothing
                                , AP.patchAttributedTo = luSender
                                , AP.patchPublished    = Nothing
                                , AP.patchType         = typ
                                , AP.patchContent      = diff
                                }
                            )
                            diffs
                        )
                    }
                )
            }

    return (Nothing, audience, ticket)

offerMerge
    :: KeyHashid Person
    -> Text
    -> PandocMarkdown
    -> FedURI
    -> FedURI
    -> Maybe Text
    -> FedURI
    -> Maybe Text
    -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Ticket URIMode)
offerMerge senderHash title desc uTracker uTargetRepo maybeTargetBranch uOriginRepo maybeOriginBranch = do

    tracker <- do
        tracker <- checkTracker uTracker
        case tracker of
            TrackerDeck _ -> throwE "Local ticket tracker doesn't take patches"
            TrackerLoom loomID -> Left <$> encodeKeyHashid loomID
            TrackerRemote (ObjURI hTracker luTracker) -> Right <$> do
                instanceID <- lift $ runDB $ either entityKey id <$> insertBy' (Instance hTracker)
                result <- ExceptT $ first (T.pack . displayException) <$> fetchRemoteActor instanceID hTracker luTracker
                case result of
                    Left Nothing -> throwE "Tracker @id mismatch"
                    Left (Just err) -> throwE $ T.pack $ displayException err
                    Right Nothing -> throwE "Tracker isn't an actor"
                    Right (Just actor) -> return (entityVal actor, uTracker)

    descHtml <- ExceptT . pure $ renderPandocMarkdown desc

    encodeRouteLocal <- getEncodeRouteLocal
    hLocal <- asksSite siteInstanceHost

    let audAuthor =
            AudLocal [] [LocalStagePersonFollowers senderHash]
        audTracker =
            case tracker of
                Left loomHash ->
                    AudLocal
                        [LocalActorLoom loomHash]
                        [LocalStageLoomFollowers loomHash]
                Right (remoteActor, ObjURI hTracker luTracker) ->
                    AudRemote hTracker
                        [luTracker]
                        (maybeToList $ remoteActorFollowers remoteActor)

        audience = [audAuthor, audTracker]

        ObjURI hTargetRepo luTargetRepo = uTargetRepo
        ObjURI hOriginRepo luOriginRepo = uOriginRepo
        ticket = AP.Ticket
            { AP.ticketLocal        = Nothing
            , AP.ticketAttributedTo = encodeRouteLocal $ PersonR senderHash
            , AP.ticketPublished    = Nothing
            , AP.ticketUpdated      = Nothing
            , AP.ticketContext      = Nothing
            , AP.ticketSummary      = encodeEntities title
            , AP.ticketContent      = descHtml
            , AP.ticketSource       = desc
            , AP.ticketAssignedTo   = Nothing
            , AP.ticketResolved     = Nothing
            , AP.ticketAttachment   = Just
                ( hTargetRepo
                , MergeRequest
                    { mrOrigin =
                        Just $ case maybeOriginBranch of
                            Nothing -> Left uOriginRepo
                            Just b -> Right
                                ( hOriginRepo
                                , AP.Branch
                                    { AP.branchName = b
                                    , AP.branchRef  = "refs/heads/" <> b
                                    , AP.branchRepo = luOriginRepo
                                    }
                                )
                    , mrTarget =
                        case maybeTargetBranch of
                            Nothing -> Left luTargetRepo
                            Just b -> Right AP.Branch
                                { AP.branchName = b
                                , AP.branchRef  = "refs/heads/" <> b
                                , AP.branchRepo = luTargetRepo
                                }
                    , mrBundle = Nothing
                    }
                )
            }

    return (Nothing, audience, ticket)

applyPatches
    :: KeyHashid Person
    -> FedURI
    -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], Apply URIMode)
applyPatches senderHash uObject = do

    bundle <- parseBundleRoute "Apply object" uObject
    mrInfo <-
        bifor bundle
            (\ (loomID, clothID, _) -> do
                maybeCloth <- lift $ runDB $ getCloth loomID clothID
                (Entity _ loom, Entity _ cloth, _, _, _, _) <-
                    fromMaybeE maybeCloth "Local bundle not found in DB"
                return (loomID, clothID, loomRepo loom, ticketLoomBranch cloth)
            )
            (\ uBundle -> do
                manager <- asksSite appHttpManager
                Doc h b <- AP.fetchAP_T manager $ Left uBundle
                let mlocal =
                        case b of
                            BundleHosted ml _ -> (h,) <$> ml
                            BundleOffer ml _ -> ml
                (hBundle, blocal) <- 
                    fromMaybeE mlocal "Remote bundle doesn't have 'context'"
                unless (hBundle == h) $
                    throwE "Bundle @id mismatch!"

                Doc _ ticket <-
                    AP.fetchAP_T manager $
                        Left $ ObjURI hBundle $ AP.bundleContext blocal
                (hMR, mr) <- fromMaybeE (AP.ticketAttachment ticket) "Ticket doesn't have attachment"
                (hT, tlocal) <- fromMaybeE (AP.ticketLocal ticket) "Ticket doesn't have followers"
                unless (hT == hBundle) $
                    throwE "Ticket @id mismatch!"
                uContext@(ObjURI hC _) <- fromMaybeE (AP.ticketContext ticket) "Ticket doesn't have context"
                unless (hC == hT) $
                    throwE "Ticket and tracker on different instances"

                Doc hC' (AP.Actor aloc adet) <- AP.fetchAP_T manager $ Left uContext
                unless (hC' == hC) $
                    throwE "Tracker @id mismatch!"
                unless (AP.actorType adet == AP.ActorTypePatchTracker) $
                    throwE "Ticket context isn't a PatchTracker"
                return
                    ( uContext
                    , AP.actorFollowers aloc
                    , AP.ticketParticipants tlocal
                    , bimap (ObjURI hMR) (hMR,) $ AP.mrTarget mr
                    )
            )

    encodeRouteLocal <- getEncodeRouteLocal
    encodeRouteHome <- getEncodeRouteHome
    hashRepo <- getEncodeKeyHashid
    hashLoom <- getEncodeKeyHashid
    hashCloth <- getEncodeKeyHashid
    hLocal <- asksSite siteInstanceHost

    let target =
            case mrInfo of
                Left (_, _, repoID, maybeBranch) ->
                    let luRepo = encodeRouteLocal $ RepoR $ hashRepo repoID
                    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 (_, _, _, remoteTarget) -> remoteTarget

        audAuthor =
            AudLocal
                []
                [LocalStagePersonFollowers senderHash]
        audCloth =
            case mrInfo of
                Left (loomID, clothID, _, _) ->
                    let loomHash = hashLoom loomID
                        clothHash = hashCloth clothID
                    in  AudLocal
                            [LocalActorLoom loomHash]
                            [ LocalStageLoomFollowers loomHash
                            , LocalStageClothFollowers loomHash clothHash
                            ]
                Right (ObjURI h luTracker, mluFollowers, luTicketFollowers, _) ->
                    AudRemote h
                        [luTracker]
                        (catMaybes [mluFollowers, Just luTicketFollowers])

        audience = [audAuthor, audCloth]

    return (Nothing, audience, Apply uObject target)

createDeck
    :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => KeyHashid Person
    -> Text
    -> Text
    -> m (Maybe HTML, [Aud URIMode], AP.ActorDetail)
createDeck senderHash name desc = do
    let audAuthor =
            AudLocal [] [LocalStagePersonFollowers senderHash]

        audience = [audAuthor]

        detail = AP.ActorDetail
            { AP.actorType     = AP.ActorTypeTicketTracker
            , AP.actorUsername = Nothing
            , AP.actorName     = Just name
            , AP.actorSummary  = Just desc
            }

    return (Nothing, audience, detail)

createLoom
    :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => KeyHashid Person
    -> Text
    -> Text
    -> KeyHashid Repo
    -> m (Maybe HTML, [Aud URIMode], AP.ActorDetail, NonEmpty FedURI)
createLoom senderHash name desc repoHash = do
    encodeRouteHome <- getEncodeRouteHome

    let audAuthor =
            AudLocal [] [LocalStagePersonFollowers senderHash]
        audRepo =
            AudLocal
                [LocalActorRepo repoHash]
                [LocalStageRepoFollowers repoHash]

        audience = [audAuthor, audRepo]

        detail = AP.ActorDetail
            { AP.actorType     = AP.ActorTypePatchTracker
            , AP.actorUsername = Nothing
            , AP.actorName     = Just name
            , AP.actorSummary  = Just desc
            }
        repo = encodeRouteHome $ RepoR repoHash

    return (Nothing, audience, detail, repo :| [])

createRepo
    :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
    => KeyHashid Person
    -> Text
    -> Text
    -> m (Maybe HTML, [Aud URIMode], AP.ActorDetail)
createRepo senderHash name desc = do
    let audAuthor =
            AudLocal [] [LocalStagePersonFollowers senderHash]

        audience = [audAuthor]

        detail = AP.ActorDetail
            { AP.actorType     = AP.ActorTypeRepo
            , AP.actorUsername = Nothing
            , AP.actorName     = Just name
            , AP.actorSummary  = Just desc
            }

    return (Nothing, audience, detail)