{- This file is part of Vervis.
 -
 - Written in 2019, 2020, 2021, 2022, 2023
 - 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/>.
 -}

{-# LANGUAGE RankNTypes #-}

module Vervis.Federation.Ticket
    ( --personOfferTicketF
      deckOfferTicketF
    , loomOfferTicketF

    --, repoAddBundleF

    , loomApplyF

    --, deckOfferDepF
    --, repoOfferDepF

    , deckResolveF
    , loomResolveF
    )
where

import Control.Applicative
import Control.Exception hiding (Handler)
import Control.Monad
import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Data.Aeson
import Data.Align
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.ByteString (ByteString)
import Data.Either
import Data.Foldable
import Data.Function
import Data.List (nub, union)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe
import Data.Text (Text)
import Data.These
import Data.Time.Calendar
import Data.Time.Clock
import Data.Traversable
import Database.Persist
import Database.Persist.Sql
import System.Exit
import System.Process.Typed
import Text.Blaze.Html (preEscapedToHtml)
import Text.Blaze.Html.Renderer.Text
import Yesod.Core hiding (logError, logWarn, logInfo, logDebug)
import Yesod.Core.Handler
import Yesod.Persist.Core

import qualified Data.ByteString.Lazy as BL
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 Data.Text.Lazy as TL

import Database.Persist.JSON
import Network.FedURI
import Web.ActivityPub hiding (Patch, Ticket (..), Repo (..), Project (..), ActorLocal (..))
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.Tuple.Local
import Database.Persist.Local
import Yesod.Persist.Local

import qualified Data.Text.UTF8.Local as TU

import Development.PatchMediaType

import Vervis.Access
import Vervis.ActivityPub
import Vervis.Actor
import Vervis.Cloth
import Vervis.Data.Actor
import Vervis.Data.Ticket
import Vervis.Darcs
import Vervis.Web.Delivery
import Vervis.Federation.Auth
import Vervis.Federation.Util
import Vervis.FedURI
import Vervis.Fetch
import Vervis.Foundation
import Vervis.Git
import Vervis.Model
import Vervis.Model.Role
import Vervis.Model.Ticket
import Vervis.Path
import Vervis.Persist.Actor
import Vervis.Persist.Ticket
import Vervis.Query
import Vervis.Recipient
import Vervis.Ticket
import Vervis.Web.Repo

{-
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

checkBranch' (ObjURI h lu) = checkBranch h lu

checkOfferTicket
    :: RemoteAuthor
    -> AP.Ticket URIMode
    -> FedURI
    -> ExceptT
        Text
        Handler
        ( Either WorkItemTarget (Host, LocalURI, Maybe (Maybe LocalURI, PatchMediaType, NonEmpty Text))
        , TextHtml
        , TextHtml
        , TextPandocMarkdown
        )
checkOfferTicket author ticket uTarget = do
    target <- parseTarget uTarget
    (muContext, summary, content, source, mmr) <- checkTicket ticket
    for_ muContext $
        \ u -> unless (u == uTarget) $ throwE "Offer target != Ticket context"
    target' <- matchTargetAndMR target mmr
    return (target', summary, content, source)
    where
    parseTarget u@(ObjURI h lu) = do
        hl <- hostIsLocal h
        if hl
            then Left <$> do
                route <-
                    fromMaybeE
                        (decodeRouteLocal lu)
                        "Offer target 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
                            "Offer target is a valid local route, but isn't a \
                            \project or repo route"
            else return $ Right u

    checkTicket (AP.Ticket mlocal attrib mpublished mupdated muContext summary
                           content source muAssigned mresolved mmr) = do
        verifyNothingE mlocal "Ticket with 'id'"
        unless (attrib == objUriLocal (remoteAuthorURI author)) $
            throwE "Author created ticket attibuted to someone else"

        verifyNothingE mpublished "Ticket has 'published'"
        verifyNothingE mupdated "Ticket has 'updated'"
        verifyNothingE muAssigned "Ticket has 'assignedTo'"
        when (isJust mresolved) $ throwE "Ticket is resolved"

        mmr' <- traverse (uncurry checkMR) mmr

        return (muContext, summary, content, source, mmr')
        where
        checkMR h (MergeRequest muOrigin luTarget ebundle) = do
            verifyNothingE muOrigin "MR with 'origin'"
            branch <- checkBranch h luTarget
            (typ, diffs) <-
                case ebundle of
                    Left _ -> throwE "MR bundle specified as a URI"
                    Right (hBundle, bundle) -> checkBundle hBundle bundle
            case (typ, diffs) of
                (PatchMediaTypeDarcs, _ :| _ : _) ->
                    throwE "More than one Darcs patch bundle provided"
                _ -> return ()
            return (branch, typ, diffs)
            where
            checkBundle _ (AP.BundleHosted _ _) =
                throwE "Patches specified as URIs"
            checkBundle h (AP.BundleOffer mlocal patches) = do
                verifyNothingE mlocal "Bundle with 'id'"
                (typ:|typs, diffs) <- NE.unzip <$> traverse (checkPatch h) patches
                unless (all (== typ) typs) $ throwE "Different patch types"
                return (typ, diffs)
                where
                checkPatch h (AP.Patch mlocal attrib mpub typ content) = do
                    verifyNothingE mlocal "Patch with 'id'"
                    unless (ObjURI h attrib == remoteAuthorURI author) $
                        throwE "Ticket and Patch attrib mismatch"
                    verifyNothingE mpub "Patch has 'published'"
                    return (typ, content)

    matchTargetAndMR (Left (Left (shr, prj))) Nothing = return $ Left $ WITProject shr prj
    matchTargetAndMR (Left (Left (shr, prj))) (Just _) = throwE "Patch offered to project"
    matchTargetAndMR (Left (Right (shr, rp))) Nothing = throwE "Issue offered to repo"
    matchTargetAndMR (Left (Right (shr, rp))) (Just (branch, typ, diffs)) = do
        branch' <-
            case branch of
                Left (shr', rp', mb) | shr == shr' && rp == rp' -> return mb
                _ -> throwE "MR target repo/branch and Offer target repo mismatch"
        case patchMediaTypeVCS typ 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 $ WITRepo shr rp branch' typ diffs
    matchTargetAndMR (Right (ObjURI h lu)) Nothing = return $ Right (h, lu, Nothing)
    matchTargetAndMR (Right (ObjURI h lu)) (Just (branch, typ, diffs)) = do
        luBranch <-
            case branch of
                Right (ObjURI h' lu') | h == h' -> return lu
                _ -> throwE "MR target repo/branch and Offer target repo mismatch"
        let bundle =
                ( if lu == luBranch then Nothing else Just luBranch
                , typ
                , diffs
                )
        return $ Right (h, lu, Just bundle)
-}

personOfferTicketF
    :: UTCTime
    -> KeyHashid Person
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Ticket URIMode
    -> FedURI
    -> ExceptT Text Handler Text
personOfferTicketF now recipHash author body mfwd luOffer ticket uTarget = do
    error "sharerOfferTicketF temporarily disabled"



{-
    (target, _, _, _) <- checkOfferTicket author ticket uTarget
    mractid <- runDBExcept $ do
        ibidRecip <- lift $ do
            sid <- getKeyBy404 $ UniqueSharer shrRecip
            personInbox <$> getValBy404 (UniquePersonIdent sid)
        case target of
            Left (WITProject shr prj) -> do
                mjid <- lift $ runMaybeT $ do
                    sid <- MaybeT $ getKeyBy $ UniqueSharer shr
                    MaybeT $ getKeyBy $ UniqueProject prj sid
                void $ fromMaybeE mjid "Offer target: No such local project"
            Left (WITRepo shr rp _ _ _) -> do
                mrid <- lift $ runMaybeT $ do
                    sid <- MaybeT $ getKeyBy $ UniqueSharer shr
                    MaybeT $ getKeyBy $ UniqueRepo rp sid
                void $ fromMaybeE mrid "Offer target: No such local repo"
            Right _ -> return ()
        lift $ insertToInbox now author body ibidRecip luOffer True
    return $
        case mractid of
            Nothing -> "Activity already exists in my inbox"
            Just _ -> "Activity inserted to my inbox"
-}

{-
insertLocalTicket now author txl summary content source ractidOffer obiidAccept = do
    did <- insert Discussion
    fsid <- insert FollowerSet
    tid <- insert Ticket
        { ticketNumber      = Nothing
        , ticketCreated     = now
        , ticketTitle       = unTextHtml summary
        , ticketSource      = unTextPandocMarkdown source
        , ticketDescription = unTextHtml content
        , ticketAssignee    = Nothing
        , ticketStatus      = TSNew
        }
    ltid <- insert LocalTicket
        { localTicketTicket    = tid
        , localTicketDiscuss   = did
        , localTicketFollowers = fsid
        }
    tclid <- insert TicketContextLocal
        { ticketContextLocalTicket = tid
        , ticketContextLocalAccept = obiidAccept
        }
    insert_ $ txl tclid
    insert_ TicketAuthorRemote
        { ticketAuthorRemoteTicket = tclid
        , ticketAuthorRemoteAuthor = remoteAuthorId author
        , ticketAuthorRemoteOpen   = ractidOffer
        }
    return (tid, ltid)
-}

deckOfferTicketF
    :: UTCTime
    -> KeyHashid Deck
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Ticket URIMode
    -> FedURI
    -> ExceptT Text Handler Text
deckOfferTicketF now recipDeckHash author body mfwd luOffer ticket uTarget = do

    -- Check input
    recipDeckID <- decodeKeyHashid404 recipDeckHash
    (title, desc, source) <- do
        let uAuthor@(ObjURI hAuthor _) = remoteAuthorURI author
        WorkItemOffer {..} <- checkOfferTicket hAuthor ticket uTarget
        unless (wioAuthor == Right (remoteAuthorURI author)) $
            throwE "Offering a Ticket attributed to someone else"
        case wioRest of
            TAM_Task deckID ->
                if deckID == recipDeckID
                    then return ()
                    else throwE
                            "Offer target is some other local deck, so I have \
                            \no use for this Offer. Was I supposed to receive \
                            \it?"
            TAM_Merge _ _ ->
                throwE
                    "Offer target is some local loom, so I have no use for \
                    \this Offer. Was I supposed to receive it?"
            TAM_Remote _ _ ->
                throwE
                    "Offer target is some remote tracker, so I have no use \
                    \for this Offer. Was I supposed to receive it?"
        return (wioTitle, wioDesc, wioSource)

    -- Find recipient deck in DB, returning 404 if doesn't exist because we're
    -- in the deck's inbox post handler
    maybeHttp <- runDBExcept $ do
        (recipDeckActorID, recipDeckActor) <- lift $ do
            deck <- get404 recipDeckID
            let actorID = deckActor deck
            (actorID,) <$> getJust actorID

        -- Insert the Offer to deck's inbox
        mractid <- lift $ insertToInbox now author body (actorInbox recipDeckActor) luOffer False
        for mractid $ \ offerID -> do

            -- Forward the Offer activity to relevant local stages, and
            -- schedule delivery for unavailable remote members of them
            maybeHttpFwdOffer <- lift $ for mfwd $ \ (localRecips, sig) -> do
                let sieve =
                        makeRecipientSet
                            []
                            [LocalStageDeckFollowers recipDeckHash]
                forwardActivityDB
                    (actbBL body) localRecips sig recipDeckActorID
                    (LocalActorDeck recipDeckHash) sieve offerID

            -- Insert the new ticket to our DB
            acceptID <- lift $ insertEmptyOutboxItem (actorOutbox recipDeckActor) now
            taskID <- lift $ insertTask now title desc source recipDeckID offerID acceptID

            -- Prepare an Accept activity and insert to deck's outbox
            (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                lift $ prepareAccept taskID
            _luAccept <- lift $ updateOutboxItem (LocalActorDeck recipDeckID) acceptID actionAccept

            -- Deliver the Accept to local recipients, and schedule delivery
            -- for unavailable remote recipients
            deliverHttpAccept <-
                deliverActivityDB
                    (LocalActorDeck recipDeckHash) recipDeckActorID
                    localRecipsAccept remoteRecipsAccept fwdHostsAccept
                    acceptID actionAccept

            -- Return instructions for HTTP inbox-forwarding of the Offer
            -- activity, and for HTTP delivery of the Accept activity to
            -- remote recipients
            return (maybeHttpFwdOffer, deliverHttpAccept)

    -- Launch asynchronous HTTP forwarding of the Offer activity and HTTP
    -- delivery of the Accept activity
    case maybeHttp of
        Nothing -> return "I already have this activity in my inbox, doing nothing"
        Just (maybeHttpFwdOffer, deliverHttpAccept) -> do
            forkWorker "deckOfferTicketF Accept HTTP delivery" deliverHttpAccept
            case maybeHttpFwdOffer of
                Nothing -> return "Opened a ticket, no inbox-forwarding to do"
                Just forwardHttpOffer -> do
                    forkWorker "deckOfferTicketF inbox-forwarding" forwardHttpOffer
                    return "Opened a ticket and ran inbox-forwarding of the Offer"

    where

    insertTask now title desc source deckID offerID acceptID = do
        did <- insert Discussion
        fsid <- insert FollowerSet
        tid <- insert Ticket
            { ticketNumber      = Nothing
            , ticketCreated     = now
            , ticketTitle       = title
            , ticketSource      = source
            , ticketDescription = desc
            , ticketDiscuss     = did
            , ticketFollowers   = fsid
            , ticketAccept      = acceptID
            }
        insert_ TicketAuthorRemote
            { ticketAuthorRemoteTicket = tid
            , ticketAuthorRemoteAuthor = remoteAuthorId author
            , ticketAuthorRemoteOpen   = offerID
            }
        insert $ TicketDeck tid deckID

    prepareAccept taskID = do
        encodeRouteLocal <- getEncodeRouteLocal
        encodeRouteHome <- getEncodeRouteHome

        taskHash <- encodeKeyHashid taskID

        ra <- getJust $ remoteAuthorId author

        let ObjURI hAuthor luAuthor = remoteAuthorURI author

            audSender =
                AudRemote hAuthor
                    [luAuthor]
                    (maybeToList $ remoteActorFollowers ra)
            audTracker = AudLocal [] [LocalStageDeckFollowers recipDeckHash]

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audSender, audTracker]

            recips = map encodeRouteHome audLocal ++ audRemote
            action = AP.Action
                { AP.actionCapability = Nothing
                , AP.actionSummary    = Nothing
                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                , AP.actionFulfills   = []
                , AP.actionSpecific   = AP.AcceptActivity AP.Accept
                    { AP.acceptObject   = ObjURI hAuthor luOffer
                    , AP.acceptResult   =
                        Just $ encodeRouteLocal $
                            TicketR recipDeckHash taskHash
                    }
                }

        return (action, recipientSet, remoteActors, fwdHosts)

activityAlreadyInInbox hAct luAct inboxID = fmap isJust . runMaybeT $ do
    instanceID <- MaybeT $ getKeyBy $ UniqueInstance hAct
    remoteObjectID <- MaybeT $ getKeyBy $ UniqueRemoteObject instanceID luAct
    remoteActivityID <- MaybeT $ getKeyBy $ UniqueRemoteActivity remoteObjectID
    MaybeT $ getBy $ UniqueInboxItemRemote inboxID remoteActivityID

loomOfferTicketF
    :: UTCTime
    -> KeyHashid Loom
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Ticket URIMode
    -> FedURI
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
loomOfferTicketF now recipLoomHash author body mfwd luOffer ticket uTarget = do

    -- Check input
    recipLoomID <- decodeKeyHashid404 recipLoomHash
    (title, desc, source, originTipOrBundle, targetRepoID, maybeTargetBranch) <- do
        let uAuthor@(ObjURI hAuthor _) = remoteAuthorURI author
        WorkItemOffer {..} <- checkOfferTicket hAuthor ticket uTarget
        unless (wioAuthor == Right (remoteAuthorURI author)) $
            throwE "Offering a Ticket attributed to someone else"
        Merge maybeOriginTip maybeBundle targetTip <- case wioRest of
            TAM_Task _ ->
                throwE
                    "Offer target is some local deck, so I have no use for \
                    \this Offer. Was I supposed to receive it?"
            TAM_Merge loomID merge ->
                if loomID == recipLoomID
                    then return merge
                    else throwE
                            "Offer target is some other local loom, so I have \
                            \no use for this Offer. Was I supposed to receive \
                            \it?"
            TAM_Remote _ _ ->
                throwE
                    "Offer target is some remote tracker, so I have no use \
                    \for this Offer. Was I supposed to receive it?"
        originTipOrBundle <-
            fromMaybeE
                (align maybeOriginTip maybeBundle)
                "MR provides neither origin nor patches"
        (targetRepoID, maybeTargetBranch) <-
            case targetTip of
                TipLocalRepo repoID -> pure (repoID, Nothing)
                TipLocalBranch repoID branch -> pure (repoID, Just branch)
                _ -> throwE "MR target is a remote repo (this tracker serves only local repos)"
        return (wioTitle, wioDesc, wioSource, originTipOrBundle, targetRepoID, maybeTargetBranch)

    -- Soon we're going to proceed asynchronously to be able to HTTP GET the
    -- origin repo AP object, because:
    --
    --      * No support for providing a signed repo object directly in the
    --        Offer activity
    --      * It may be nice to make sure a remote origin repo's VCS type
    --        matches the target repo's VCS, even if patches are provided too
    --          + However there's no support for caching VCS type when
    --            remembering remote repo in our DB, so we'd have to check this
    --            every time
    --      * If origin is remote and no patches are provided, we'll need to
    --        know the clone URL to generate the patches ourselves
    --          + However the code here, for some simplicity, doesn't have a
    --            way to skip that and do the whole handler synchronously in
    --            case patches are provided or the origin is a local repo
    --          + And no support for caching the clone URI in DB when
    --            remembering the remote repo, so we'd need to do this every
    --            time
    --
    -- So first let's do some checks using the DB, on the loom, on the target
    -- repo (which is always local), and on the origin repo if it's local
    (recipLoomRepoID, Entity recipLoomActorID recipLoomActor, alreadyInInbox) <- lift $ runDB $ do

        -- Find recipient loom in DB, returning 404 if doesn't exist because
        -- we're in the loom's inbox post handler
        (recipLoomRepoID, recipLoomActor@(Entity _ actor)) <- do
            loom <- get404 recipLoomID
            let actorID = loomActor loom
            (loomRepo loom,) . Entity actorID <$> getJust actorID

        -- Has the loom already received this activity to its inbox? If yes, we
        -- won't process it again
        alreadyInInbox <- do
            let hOffer = objUriAuthority $ remoteAuthorURI author
            activityAlreadyInInbox hOffer luOffer (actorInbox actor)

        return (recipLoomRepoID, recipLoomActor, alreadyInInbox)

    if alreadyInInbox
        then return ("I already have this activity in my inbox, ignoring", Nothing)
        else do
            (targetRepoVCS, originOrBundle) <- runDBExcept $ do

                -- Grab loom's repo from DB and verify that it consents to be served by
                -- the loom, otherwise this loom doesn't accept tickets
                unless (targetRepoID == recipLoomRepoID) $
                    throwE "MR target repo isn't the one served by the Offer target loom"
                targetRepo <- lift $ getJust targetRepoID
                unless (repoLoom targetRepo == Just recipLoomID) $
                    throwE "Offer target loom doesn't have repo's consent to serve it"

                -- Verify VCS type match between patch bundle and target repo
                for_ (justThere originTipOrBundle) $ \ (Material typ diffs) -> do
                    unless (repoVcs targetRepo == patchMediaTypeVCS typ) $
                        throwE "Patch type and local target repo VCS mismatch"
                    case (typ, diffs) of
                        (PatchMediaTypeDarcs, _ :| _ : _) ->
                            throwE "More than one Darcs dpatch file provided"
                        _ -> pure ()

                -- If origin repo is local, find it in our DB and verify its VCS type
                -- matches the target repo
                originOrBundle <- flip (bifor originTipOrBundle) pure $ \ originTip -> do
                    let origin =
                            case originTip of
                                TipLocalRepo repoID -> Left (repoID, Nothing)
                                TipLocalBranch repoID branch -> Left (repoID, Just branch)
                                TipRemote uOrigin -> Right (uOrigin, Nothing)
                                TipRemoteBranch uRepo branch -> Right (uRepo, Just branch)
                    bitraverse_
                        (\ (repoID, maybeBranch) -> do
                            repo <- getE repoID "MR origin local repo not found in DB"
                            unless (repoVcs repo == repoVcs targetRepo) $
                                throwE "Local origin repo VCS differs from target repo VCS"
                        )
                        pure
                        origin
                    return origin

                return (repoVcs targetRepo, originOrBundle)

            return $ (,) "Ran initial checks, doing the rest asynchronously" $ Just $ do

                -- If origin repo is remote, HTTP GET its AP representation and
                -- remember it in our DB
                originOrBundle' <-
                    bitraverse
                        (bitraverse
                            pure
                            (\ (uOrigin, maybeOriginBranch) -> do
                                (vcs, remoteOrigin) <-
                                    case maybeOriginBranch of
                                        Nothing -> do
                                            (vcs, raid, uClone, mb) <- withExceptT (T.pack . show) $ httpGetRemoteTip uOrigin
                                            return (vcs, (raid, uClone, first Just <$> mb))
                                        Just branch -> do
                                            (vcs, raid, uClone) <- withExceptT (T.pack . show) $ httpGetRemoteRepo uOrigin
                                            return (vcs, (raid, uClone, Just (Nothing, branch)))
                                unless (vcs == targetRepoVCS) $
                                    throwE "Remote origin repo VCS differs from target repo VCS"
                                return remoteOrigin
                            )
                        )
                        pure
                        originOrBundle

                -- Verify that branches are specified for Git and aren't specified for
                -- Darcs
                -- Also, produce a data structure separating by VCS rather than by
                -- local/remote origin, which we'll need for generating patches
                tipInfo <- case targetRepoVCS of
                    VCSGit -> do
                        targetBranch <- fromMaybeE maybeTargetBranch "Local target repo is Git but no target branch specified"
                        maybeOrigin <- for (justHere originOrBundle') $ \case
                            Left (originRepoID, maybeOriginBranch) -> do
                                originBranch <- fromMaybeE maybeOriginBranch "Local origin repo is Git but no origin branch specified"
                                return (Left originRepoID, originBranch)
                            Right (_remoteActorID, uClone, maybeOriginBranch) -> do
                                (_maybeURI, originBranch) <- fromMaybeE maybeOriginBranch "Remote origin repo is Git but no origin branch specified"
                                return (Right uClone, originBranch)
                        return $ Left (targetBranch, maybeOrigin)
                    VCSDarcs -> do
                        verifyNothingE maybeTargetBranch "Local target repo is Darcs but target branch specified"
                        maybeOriginRepo <- for (justHere originOrBundle') $ \case
                            Left (originRepoID, maybeOriginBranch) -> do
                                verifyNothingE maybeOriginBranch "Local origin repo is Darcs but origin branch specified"
                                return $ Left originRepoID
                            Right (_remoteActorID, uClone, maybeOriginBranch) -> do
                                verifyNothingE maybeOriginBranch "Remote origin repo is Darcs but origin branch specified"
                                return $ Right uClone
                        return $ Right $ maybeOriginRepo

                maybeHttp <- runSiteDBExcept $ do

                    -- Insert the Offer to loom's inbox
                    mractid <- lift $ insertToInbox now author body (actorInbox recipLoomActor) luOffer False
                    for mractid $ \ offerID -> do

                        -- Forward the Offer activity to relevant local stages, and
                        -- schedule delivery for unavailable remote members of them
                        maybeHttpFwdOffer <- lift $ for mfwd $ \ (localRecips, sig) -> do
                            let sieve =
                                    makeRecipientSet
                                        []
                                        [LocalStageLoomFollowers recipLoomHash]
                            forwardActivityDB
                                (actbBL body) localRecips sig
                                recipLoomActorID (LocalActorLoom recipLoomHash)
                                sieve offerID

                        -- Insert the new ticket to our DB
                        acceptID <- lift $ insertEmptyOutboxItem (actorOutbox recipLoomActor) now
                        ticketID <- lift $ insertTicket now title desc source offerID acceptID
                        clothID <- lift $ insertMerge recipLoomID ticketID maybeTargetBranch originOrBundle'
                        let maybePull =
                                let maybeTipInfo =
                                        case tipInfo of
                                            Left (b, mo) -> Left . (b,) <$> mo
                                            Right mo -> Right <$> mo
                                    hasBundle = isJust $ justThere originOrBundle'
                                in  (clothID, targetRepoID, hasBundle,) <$> maybeTipInfo

                        -- Prepare an Accept activity and insert to loom's outbox
                        (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                            lift $ prepareAccept clothID
                        _luAccept <- lift $ updateOutboxItem (LocalActorLoom recipLoomID) acceptID actionAccept

                        -- Deliver the Accept to local recipients, and schedule delivery
                        -- for unavailable remote recipients
                        deliverHttpAccept <-
                            deliverActivityDB
                                (LocalActorLoom recipLoomHash) recipLoomActorID
                                localRecipsAccept remoteRecipsAccept
                                fwdHostsAccept acceptID actionAccept

                        -- Return instructions for HTTP inbox-forwarding of the Offer
                        -- activity, and for HTTP delivery of the Accept activity to
                        -- remote recipients, and for generating patches from
                        -- the origin repo
                        return
                            (maybeHttpFwdOffer, deliverHttpAccept, maybePull)

                -- Launch asynchronous HTTP forwarding of the Offer activity and HTTP
                -- delivery of the Accept activity, and generate patches if we opened
                -- a local MR that mentions just an origin
                case maybeHttp of
                    Nothing ->
                        return
                            "When I started serving this activity, I didn't have it in my inbox, \
                            \but now suddenly it seems I already do, so ignoring"
                    Just (maybeHttpFwdOffer, deliverHttpAccept, maybePull) -> do
                        forkWorker "loomOfferTicketF Accept HTTP delivery" deliverHttpAccept
                        traverse generatePatches maybePull
                        case maybeHttpFwdOffer of
                            Nothing -> return "Opened a merge request, no inbox-forwarding to do"
                            Just forwardHttpOffer -> do
                                forkWorker "loomOfferTicketF inbox-forwarding" forwardHttpOffer
                                return "Opened a merge request and ran inbox-forwarding of the Offer"

    where

    insertTicket now title desc source offerID acceptID = do
        did <- insert Discussion
        fsid <- insert FollowerSet
        tid <- insert Ticket
            { ticketNumber      = Nothing
            , ticketCreated     = now
            , ticketTitle       = title
            , ticketSource      = source
            , ticketDescription = desc
            , ticketDiscuss     = did
            , ticketFollowers   = fsid
            , ticketAccept      = acceptID
            }
        insert_ TicketAuthorRemote
            { ticketAuthorRemoteTicket = tid
            , ticketAuthorRemoteAuthor = remoteAuthorId author
            , ticketAuthorRemoteOpen   = offerID
            }
        return tid

    insertMerge
        :: LoomId
        -> TicketId
        -> Maybe Text
        -> These
            (Either
                (RepoId, Maybe Text)
                (RemoteActorId, FedURI, Maybe (Maybe LocalURI, Text))
            )
            Material
        -> WorkerDB TicketLoomId
    insertMerge loomID ticketID maybeTargetBranch originOrBundle = do
        clothID <- insert $ TicketLoom ticketID loomID maybeTargetBranch
        for_ (justHere originOrBundle) $ \case
            Left (repoID, maybeOriginBranch) ->
                insert_ $ MergeOriginLocal clothID repoID maybeOriginBranch
            Right (remoteActorID, _uClone, maybeOriginBranch) -> do
                originID <- insert $ MergeOriginRemote clothID remoteActorID
                for_ maybeOriginBranch $ \ (mlu, b) ->
                    insert_ $ MergeOriginRemoteBranch originID mlu b
        for_ (justThere originOrBundle) $ \ (Material typ diffs) -> do
            bundleID <- insert $ Bundle clothID False
            insertMany_ $ NE.toList $ NE.reverse $
                NE.map (Patch bundleID now typ) diffs
        return clothID

    prepareAccept clothID = do
        encodeRouteLocal <- getEncodeRouteLocal
        encodeRouteHome <- getEncodeRouteHome

        clothHash <- encodeKeyHashid clothID

        ra <- getJust $ remoteAuthorId author

        let ObjURI hAuthor luAuthor = remoteAuthorURI author

            audSender =
                AudRemote hAuthor
                    [luAuthor]
                    (maybeToList $ remoteActorFollowers ra)
            audTracker = AudLocal [] [LocalStageLoomFollowers recipLoomHash]

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audSender, audTracker]

            recips = map encodeRouteHome audLocal ++ audRemote
            action = AP.Action
                { AP.actionCapability = Nothing
                , AP.actionSummary    = Nothing
                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                , AP.actionFulfills   = []
                , AP.actionSpecific   = AP.AcceptActivity AP.Accept
                    { AP.acceptObject   = ObjURI hAuthor luOffer
                    , AP.acceptResult   =
                        Just $ encodeRouteLocal $
                            ClothR recipLoomHash clothHash
                    }
                }

        return (action, recipientSet, remoteActors, fwdHosts)

repoOfferTicketF
    :: UTCTime
    -> KeyHashid Repo
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Ticket URIMode
    -> FedURI
    -> ExceptT Text Handler Text
repoOfferTicketF now recipHash author body mfwd luOffer ticket uTarget = do
    error "repoOfferTicketF temporarily disabled"



{-

    (target, summary, content, source) <- checkOfferTicket author ticket uTarget
    mmhttp <- for (targetRelevance target) $ \ (mb, typ, diffs) -> runDBExcept $ do
        Entity rid r <- lift $ do
            sid <- getKeyBy404 $ UniqueSharer shrRecip
            getBy404 $ UniqueRepo rpRecip sid
        unless (repoVcs r == patchMediaTypeVCS typ) $
            throwE "Patch type and repo VCS mismatch"
        mractid <- lift $ insertToInbox now author body (repoInbox r) luOffer False
        lift $ for mractid $ \ ractid -> do
            mremotesHttpFwd <- for mfwd $ \ (localRecips, sig) -> do
                let sieve =
                        makeRecipientSet
                            []
                            [ LocalPersonCollectionRepoTeam shrRecip rpRecip
                            , LocalPersonCollectionRepoFollowers shrRecip rpRecip
                            ]
                remoteRecips <-
                    insertRemoteActivityToLocalInboxes
                        False ractid $
                            localRecipSieve'
                                sieve False False localRecips
                (sig,) <$> deliverRemoteDB_R (actbBL body) ractid rid sig remoteRecips
            (obiidAccept, docAccept, fwdHostsAccept, recipsAccept) <- do
                obiidAccept <- insertEmptyOutboxItem (repoOutbox r) now
                let makeTRL tclid = TicketRepoLocal tclid rid mb
                (tid, ltid) <- insertLocalTicket now author makeTRL summary content source ractid obiidAccept
                bnid <- insert $ Bundle tid
                insertMany_ $ NE.toList $ NE.map (Patch bnid now typ) diffs
                (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                    insertAccept shrRecip rpRecip author luOffer ltid obiidAccept
                knownRemoteRecipsAccept <-
                    deliverLocal'
                        False
                        (LocalActorRepo shrRecip rpRecip)
                        (repoInbox r)
                        obiidAccept
                        localRecipsAccept
                (obiidAccept,docAccept,fwdHostsAccept,) <$>
                    deliverRemoteDB fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
            return (mremotesHttpFwd, obiidAccept, docAccept, fwdHostsAccept, recipsAccept)
    case mmhttp of
        Nothing -> return "Offer target isn't me, not using"
        Just mhttp ->
            case mhttp of
                Nothing -> return "Activity already in my inbox, doing nothing"
                Just (mremotesHttpFwd, obiid, doc, fwdHosts, remotes) -> do
                    for_ mremotesHttpFwd $ \ (sig, remotes) ->
                        forkWorker "repoOfferTicketF inbox-forwarding" $
                            deliverRemoteHTTP_R now shrRecip rpRecip (actbBL body) sig remotes
                    forkWorker "repoOfferTicketF Accept HTTP delivery" $
                        deliverRemoteHttp' fwdHosts obiid doc remotes
                    return $
                        case mremotesHttpFwd of
                            Nothing -> "Accepted new patch, no inbox-forwarding to do"
                            Just _ -> "Accepted new patch and ran inbox-forwarding of the Offer"
    where
    targetRelevance (Left (WITRepo shr rp mb vcs diffs))
        | shr == shrRecip && rp == rpRecip = Just (mb, vcs, diffs)
    targetRelevance _ = Nothing
    insertAccept shr rp author luOffer ltid obiidAccept = do
        encodeRouteLocal <- getEncodeRouteLocal
        encodeRouteHome <- getEncodeRouteHome

        hLocal <- asksSite siteInstanceHost

        obikhidAccept <- encodeKeyHashid obiidAccept
        ltkhid <- encodeKeyHashid ltid

        ra <- getJust $ remoteAuthorId author

        let ObjURI hAuthor luAuthor = remoteAuthorURI author

            audAuthor =
                AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra)
            audProject =
                AudLocal []
                    [ LocalPersonCollectionRepoTeam shr rp
                    , LocalPersonCollectionRepoFollowers shr rp
                    ]

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audAuthor, audProject]

            recips = map encodeRouteHome audLocal ++ audRemote
            doc = Doc hLocal Activity
                { activityId       =
                    Just $ encodeRouteLocal $
                        RepoOutboxItemR shr rp obikhidAccept
                , activityActor    = encodeRouteLocal $ RepoR shr rp
                , activityCapability = Nothing
                , activitySummary  = Nothing
                , activityAudience = Audience recips [] [] [] [] []
                , activitySpecific = AcceptActivity Accept
                    { acceptObject = ObjURI hAuthor luOffer
                    , acceptResult =
                        Just $ encodeRouteLocal $ RepoProposalR shr rp ltkhid
                    }
                }
        update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
        return (doc, recipientSet, remoteActors, fwdHosts)
-}

{-
data RemoteBundle = RemoteBundle
    { rpBranch :: Maybe LocalURI
    , rpType   :: PatchMediaType
    , rpDiffs  :: NonEmpty Text
    }

data RemoteWorkItem = RemoteWorkItem
    { rwiHost    :: Host
    , rwiTarget  :: Maybe LocalURI
    , rwiContext :: LocalURI
    , rwiBundle  :: Maybe RemoteBundle
    }

data RemoteWorkItem' = RemoteWorkItem'
    { rwiHost'    :: Host
    , rwiContext' :: LocalURI
    , rwiBundle'  :: Maybe RemoteBundle
    }

data ParsedCreateTicket = ParsedCreateTicket
    { pctItem      :: Either (Bool, WorkItemTarget) RemoteWorkItem
    , pctLocal     :: TicketLocal
    , pctPublished :: UTCTime
    , pctTitle     :: TextHtml
    , pctDesc      :: TextHtml
    , pctSource    :: TextPandocMarkdown
    }
-}

repoAddBundleF
    :: UTCTime
    -> KeyHashid Repo
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> NonEmpty (AP.Patch URIMode)
    -> FedURI
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
repoAddBundleF now recipHash author body mfwd luAdd patches uTarget = do
    error "repoAddBundleF temporarily disabled"



{-

    ticket <- parseWorkItem "Target" uTarget
    (typ, diffs) <- do
        ((typ, diff) :| rest) <-
            for patches $ \ (AP.Patch mlocal attrib mpub typ content) -> do
                verifyNothingE mlocal "Patch with 'id'"
                unless (attrib == objUriLocal (remoteAuthorURI author)) $
                    throwE "Add and Patch attrib mismatch"
                verifyNothingE mpub "Patch has 'published'"
                return (typ, content)
        let (typs, diffs) = unzip rest
        unless (all (== typ) typs) $ throwE "Patches of different media types"
        return (typ, diff :| diffs)
    Entity ridRecip repoRecip <- lift $ runDB $ do
        sid <- getKeyBy404 $ UniqueSharer shrRecip
        getBy404 $ UniqueRepo rpRecip sid
    unless (repoVcs repoRecip == patchMediaTypeVCS typ) $
        throwE "Patch type and repo VCS mismatch"
    return $ (,) "Ran initial checks, doing the rest asynchronously" $ Just $ do
        relevantTicket <-
            for (ticketRelevance shrRecip rpRecip ticket) $ \ ltid -> do
                author <- runSiteDBExcept $ do
                    (_, _, _, _, _, _, author, _, _) <- do
                        mticket <- lift $ getRepoProposal shrRecip rpRecip ltid
                        fromMaybeE mticket $ "Target" <> ": No such repo-patch"
                    lift $ getWorkItemAuthorDetail author
                return (ltid, author)
        mhttp <- runSiteDBExcept $ do
            mractid <- lift $ insertToInbox now author body (repoInbox repoRecip) luAdd False
            for mractid $ \ ractid -> do
                mremotesHttpFwd <- lift $ for mfwd $ \ (localRecips, sig) -> do
                    relevantFollowers <- askRelevantFollowers
                    let rf = relevantFollowers shrRecip rpRecip
                        sieve =
                            makeRecipientSet [] $ catMaybes
                                [ rf ticket
                                ]
                    remoteRecips <-
                        insertRemoteActivityToLocalInboxes False ractid $
                                localRecipSieve'
                                    sieve False False localRecips
                    (sig,) <$> deliverRemoteDB_R (actbBL body) ractid ridRecip sig remoteRecips
                mremotesHttpAccept <- lift $ for relevantTicket $ \ ticketData@(ltid, _author) -> do
                    obiidAccept <- insertEmptyOutboxItem (repoOutbox repoRecip) now
                    tid <- localTicketTicket <$> getJust ltid
                    bnid <- insert $ Bundle tid
                    insertMany_ $ NE.toList $ NE.map (Patch bnid now typ) diffs
                    (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                        insertAccept luAdd obiidAccept bnid ticketData
                    knownRemoteRecipsAccept <-
                        deliverLocal'
                            False
                            (LocalActorRepo shrRecip rpRecip)
                            (repoInbox repoRecip)
                            obiidAccept
                            localRecipsAccept
                    (obiidAccept,docAccept,fwdHostsAccept,) <$>
                        deliverRemoteDB fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
                return (mremotesHttpFwd, mremotesHttpAccept)
        case mhttp of
            Nothing -> return "I already have this activity in my inbox, doing nothing"
            Just (mremotesHttpFwd, mremotesHttpAccept) -> do
                for_ mremotesHttpFwd $ \ (sig, remotes) ->
                    forkWorker "repoAddBundleF inbox-forwarding" $
                        deliverRemoteHTTP_R now shrRecip rpRecip (actbBL body) sig remotes
                for_ mremotesHttpAccept $ \ (obiid, doc, fwdHosts, remotes) ->
                    forkWorker "repoAddBundleF Accept HTTP delivery" $
                        deliverRemoteHttp' fwdHosts obiid doc remotes
                return $
                    case (mremotesHttpAccept, mremotesHttpFwd) of
                        (Nothing, Nothing) -> "Ticket not mine, just stored in inbox and no inbox-forwarding to do"
                        (Nothing, Just _) -> "Ticket not mine, just stored in inbox and ran inbox-forwarding"
                        (Just _, Nothing) -> "Accepted new bundle, no inbox-forwarding to do"
                        (Just _, Just _) -> "Accepted new bundle and ran inbox-forwarding of the Add"
    where
    ticketRelevance shr rp (Left (WorkItemRepoProposal shr' rp' ltid))
        | shr == shr' && rp == rp' = Just ltid
    ticketRelevance _ _ _ = Nothing
    askRelevantFollowers = do
        hashLTID <- getEncodeKeyHashid
        return $
            \ shr rp wi -> followers hashLTID <$> ticketRelevance shr rp wi
        where
        followers hashLTID ltid =
            LocalPersonCollectionRepoProposalFollowers
                shrRecip rpRecip (hashLTID ltid)
    insertAccept luAdd obiidAccept bnid (ltid, ticketAuthor) = do
        encodeRouteLocal <- getEncodeRouteLocal
        encodeRouteHome <- getEncodeRouteHome
        followers <- askFollowers
        hLocal <- asksSite siteInstanceHost
        obikhidAccept <- encodeKeyHashid obiidAccept
        ltkhid <- encodeKeyHashid ltid
        bnkhid <- encodeKeyHashid bnid
        ra <- getJust $ remoteAuthorId author
        let ObjURI hAuthor luAuthor = remoteAuthorURI author

            audAuthor =
                AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra)
            audTicketContext =
                AudLocal
                    []
                    [ LocalPersonCollectionRepoTeam shrRecip rpRecip
                    , LocalPersonCollectionRepoFollowers shrRecip rpRecip
                    ]
            audTicketFollowers = AudLocal [] [followers ltid]
            audTicketAuthor =
                case ticketAuthor of
                    Left shr -> AudLocal [LocalActorSharer shr] []
                    Right (i, ro) ->
                        AudRemote (instanceHost i) [remoteObjectIdent ro] []

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience
                    [ audAuthor
                    , audTicketAuthor
                    , audTicketFollowers
                    , audTicketContext
                    ]

            recips = map encodeRouteHome audLocal ++ audRemote
            doc = Doc hLocal Activity
                { activityId       =
                    Just $ encodeRouteLocal $
                        RepoOutboxItemR shrRecip rpRecip obikhidAccept
                , activityActor    = encodeRouteLocal $ RepoR shrRecip rpRecip
                , activityCapability = Nothing
                , activitySummary  = Nothing
                , activityAudience = Audience recips [] [] [] [] []
                , activitySpecific = AcceptActivity Accept
                    { acceptObject = ObjURI hAuthor luAdd
                    , acceptResult =
                        Just $ encodeRouteLocal $ RepoProposalBundleR shrRecip rpRecip ltkhid bnkhid
                    }
                }
        update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
        return (doc, recipientSet, remoteActors, fwdHosts)
        where
        askFollowers = do
            hashLTID <- getEncodeKeyHashid
            return $
                \ ltid ->
                    LocalPersonCollectionRepoProposalFollowers
                        shrRecip rpRecip (hashLTID ltid)
-}

loomApplyF
    :: UTCTime
    -> KeyHashid Loom
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Apply URIMode
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
loomApplyF now recipLoomHash author body mfwd luApply apply = (,Nothing) <$> do

    -- Check input
    recipLoomID <- decodeKeyHashid404 recipLoomHash
    (repoID, maybeBranch, clothID, bundleID) <- do
        maybeLocalTarget <- checkApplyLocalLoom apply
        (repoID, maybeBranch, loomID, clothID, bundleID) <-
            fromMaybeE
                maybeLocalTarget
                "Bundle doesn't belong to a local loom, in particular not to \
                \me, so I won't apply it. Was I supposed to receive it?"
        unless (loomID == recipLoomID) $
            throwE
                "Bundle belongs to some other local loom, so I won't apply \
                \it. Was I supposed to receive it?"
        return (repoID, maybeBranch, clothID, bundleID)

    -- Verify the capability URI is one of:
    --   * Outbox item URI of a local actor, i.e. a local activity
    --   * A remote URI
    uCap <- do
        let muCap = activityCapability $ actbActivity body
        fromMaybeE muCap "Asking to apply patch but no capability provided"
    capID <- nameExceptT "Apply capability" $ parseActivityURI uCap

    maybeNewApply <- runDBExcept $ do

        -- Find recipient loom in DB, returning 404 if doesn't exist because
        -- we're in the loom's inbox post handler
        recipLoom <- lift $ get404 recipLoomID
        let recipLoomActorID = loomActor recipLoom
        recipLoomActor <- lift $ getJust recipLoomActorID

        -- Has the loom already received this activity to its inbox? If yes, we
        -- won't process it again
        alreadyInInbox <- lift $ do
            let hOffer = objUriAuthority $ remoteAuthorURI author
            activityAlreadyInInbox hOffer luApply (actorInbox recipLoomActor)

        -- Find the repo and the bundle in our DB, and verify that the loom is
        -- willing to accept the request from sender to apply this specific
        -- bundle to this repo/branch
        if alreadyInInbox
            then pure Nothing
            else Just <$> do
                (_, ticketID, diffs) <-
                    checkApplyDB
                        (Right $ remoteAuthorId author) capID
                        (repoID, maybeBranch) (recipLoomID, clothID, bundleID)
                return (Entity recipLoomActorID recipLoomActor, ticketID, diffs)

    case maybeNewApply of
        Nothing ->
            return "I already have this activity in my inbox, doing nothing"
        Just (Entity recipLoomActorID recipLoomActor, ticketID, diffs) -> do

            -- Apply patches
            applyPatches repoID maybeBranch diffs

            maybeHttp <- runDBExcept $ do

                -- Insert the Apply to loom's inbox
                mractid <- lift $ insertToInbox now author body (actorInbox recipLoomActor) luApply False
                for mractid $ \ applyID -> do

                    -- Forward the Apply activity to relevant local stages, and
                    -- schedule delivery for unavailable remote members of them
                    maybeHttpFwdApply <- lift $ for mfwd $ \ (localRecips, sig) -> do
                        clothHash <- encodeKeyHashid clothID
                        let sieve =
                                makeRecipientSet
                                    []
                                    [ LocalStageLoomFollowers recipLoomHash
                                    , LocalStageClothFollowers recipLoomHash clothHash
                                    ]
                        forwardActivityDB
                            (actbBL body) localRecips sig recipLoomActorID
                            (LocalActorLoom recipLoomHash) sieve applyID

                    -- Mark ticket in DB as resolved by the Apply
                    acceptID <-
                        lift $ insertEmptyOutboxItem (actorOutbox recipLoomActor) now
                    lift $ insertResolve ticketID applyID acceptID

                    -- Prepare an Accept activity and insert to loom's outbox
                    (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                        lift $ prepareAccept clothID
                    _luAccept <- lift $ updateOutboxItem (LocalActorLoom recipLoomID) acceptID actionAccept

                    -- Deliver the Accept to local recipients, and schedule delivery
                    -- for unavailable remote recipients
                    deliverHttpAccept <-
                        deliverActivityDB
                            (LocalActorLoom recipLoomHash) recipLoomActorID
                            localRecipsAccept remoteRecipsAccept fwdHostsAccept
                            acceptID actionAccept

                    -- Return instructions for HTTP inbox-forwarding of the Apply
                    -- activity, and for HTTP delivery of the Accept activity to
                    -- remote recipients
                    return (maybeHttpFwdApply, deliverHttpAccept)

            -- Launch asynchronous HTTP forwarding of the Apply activity and HTTP
            -- delivery of the Accept activity
            case maybeHttp of
                Nothing ->
                    return
                        "When I started serving this activity, I didn't have it in my inbox, \
                        \but now suddenly it seems I already do, so ignoring"
                Just (maybeHttpFwdApply, deliverHttpAccept) -> do
                    forkWorker "loomApplyF Accept HTTP delivery" deliverHttpAccept
                    case maybeHttpFwdApply of
                        Nothing -> return "Applied the patch(es), no inbox-forwarding to do"
                        Just forwardHttpApply -> do
                            forkWorker "loomApplyF inbox-forwarding" forwardHttpApply
                            return "Applied the patch(es) and ran inbox-forwarding of the Apply"

    where

    insertResolve ticketID applyID acceptID = do
        trid <- insert TicketResolve
            { ticketResolveTicket = ticketID
            , ticketResolveAccept = acceptID
            }
        insert_ TicketResolveRemote
            { ticketResolveRemoteTicket   = trid
            , ticketResolveRemoteActivity = applyID
            , ticketResolveRemoteActor    = remoteAuthorId author
            }

    prepareAccept clothID = do
        encodeRouteHome <- getEncodeRouteHome

        clothHash <- encodeKeyHashid clothID

        ra <- getJust $ remoteAuthorId author

        let ObjURI hAuthor luAuthor = remoteAuthorURI author

            audSender =
                AudRemote hAuthor
                    [luAuthor]
                    (maybeToList $ remoteActorFollowers ra)
            audTracker =
                AudLocal
                    []
                    [ LocalStageLoomFollowers recipLoomHash
                    , LocalStageClothFollowers recipLoomHash clothHash
                    ]

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audSender, audTracker]

            recips = map encodeRouteHome audLocal ++ audRemote
            action = AP.Action
                { AP.actionCapability = Nothing
                , AP.actionSummary    = Nothing
                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                , AP.actionFulfills   = []
                , AP.actionSpecific   = AP.AcceptActivity AP.Accept
                    { AP.acceptObject   = ObjURI hAuthor luApply
                    , AP.acceptResult   = Nothing
                    }
                }

        return (action, recipientSet, remoteActors, fwdHosts)

personOfferDepF
    :: UTCTime
    -> KeyHashid Person
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.TicketDependency URIMode
    -> FedURI
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
personOfferDepF now recipHash author body mfwd luOffer dep uTarget = do
    error "sharerOfferDepF temporarily disabled"




{-
    (parent, child) <- checkDepAndTarget dep uTarget
    personRecip <- lift $ runDB $ do
        sid <- getKeyBy404 $ UniqueSharer shrRecip
        getValBy404 $ UniquePersonIdent sid
    return $ (,) "Ran initial checks, doing the rest asynchronously" $ Just $ do
        manager <- asksSite appHttpManager
        relevantParent <-
            for (ticketRelevance shrRecip parent) $ \ (talid, patch) -> do
                (parentLtid, parentCtx) <-
                    getSharerWorkItemDetail shrRecip talid patch
                childDetail <- getWorkItemDetail "Child" child
                return (talid, patch, parentLtid, parentCtx, childDetail)
        mhttp <- runSiteDBExcept $ do
            mractid <- lift $ insertToInbox' now author body (personInbox personRecip) luOffer True
            for mractid $ \ (ractid, ibiid) -> do
                insertDepOffer ibiid parent child
                mremotesHttpFwd <- lift $ for mfwd $ \ (localRecips, sig) -> do
                    relevantFollowers <- askRelevantFollowers
                    let sieve =
                            makeRecipientSet [] $ catMaybes
                                [ relevantFollowers shrRecip parent
                                , relevantFollowers shrRecip child
                                ]
                    remoteRecips <-
                        insertRemoteActivityToLocalInboxes
                            False ractid $
                                localRecipSieve'
                                    sieve False False localRecips
                    (sig,) <$> deliverRemoteDB_S (actbBL body) ractid (personIdent personRecip) sig remoteRecips
                mremotesHttpAccept <- lift $ for relevantParent $ \ ticketData@(_, _, parentLtid, _, childDetail) -> do
                    obiidAccept <- insertEmptyOutboxItem (personOutbox personRecip) now
                    tdid <- insertDep now author ractid parentLtid (widIdent childDetail) obiidAccept
                    (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                        insertAccept luOffer obiidAccept tdid ticketData
                    knownRemoteRecipsAccept <-
                        deliverLocal'
                            False
                            (LocalActorSharer shrRecip)
                            (personInbox personRecip)
                            obiidAccept
                            localRecipsAccept
                    (obiidAccept,docAccept,fwdHostsAccept,) <$> deliverRemoteDB fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
                return (mremotesHttpFwd, mremotesHttpAccept)
        case mhttp of
            Nothing -> return "I already have this activity in my inbox, doing nothing"
            Just (mremotesHttpFwd, mremotesHttpAccept) -> do
                for_ mremotesHttpFwd $ \ (sig, remotes) ->
                    forkWorker "sharerOfferDepF inbox-forwarding" $
                        deliverRemoteHTTP_S now shrRecip (actbBL body) sig remotes
                for_ mremotesHttpAccept $ \ (obiid, doc, fwdHosts, remotes) ->
                    forkWorker "sharerOfferDepF Accept HTTP delivery" $
                        deliverRemoteHttp' fwdHosts obiid doc remotes
                return $
                    case (mremotesHttpAccept, mremotesHttpFwd) of
                        (Nothing, Nothing) -> "Parent not mine, just stored in inbox and no inbox-forwarding to do"
                        (Nothing, Just _) -> "Parent not mine, just stored in inbox and ran inbox-forwarding"
                        (Just _, Nothing) -> "Accepted new ticket dep, no inbox-forwarding to do"
                        (Just _, Just _) -> "Accepted new ticket dep and ran inbox-forwarding of the Offer"
    where
    ticketRelevance shr (Left (WorkItemSharerTicket shr' talid patch))
        | shr == shr' = Just (talid, patch)
    ticketRelevance _ _ = Nothing
    insertDepOffer _          (Left _)  _     = return ()
    insertDepOffer ibiidOffer (Right _) child =
        for_ (ticketRelevance shrRecip child) $ \ (talid, patch) -> do
            ltid <-
                if patch
                    then do
                        (_, Entity ltid _, _, _, _, _) <- do
                            mticket <- lift $ getSharerProposal shrRecip talid
                            fromMaybeE mticket $ "Child" <> ": No such sharer-patch"
                        return ltid
                    else do
                        (_, Entity ltid _, _, _, _) <- do
                            mticket <- lift $ getSharerTicket shrRecip talid
                            fromMaybeE mticket $ "Child" <> ": No such sharer-ticket"
                        return ltid
            lift $ insert_ TicketDependencyOffer
                { ticketDependencyOfferOffer = ibiidOffer
                , ticketDependencyOfferChild = ltid
                }
    askRelevantFollowers = do
        hashTALID <- getEncodeKeyHashid
        return $ \ shr wi -> followers hashTALID <$> ticketRelevance shr wi
        where
        followers hashTALID (talid, patch) =
            let coll =
                    if patch
                        then LocalPersonCollectionSharerProposalFollowers
                        else LocalPersonCollectionSharerTicketFollowers
            in  coll shrRecip (hashTALID talid)
    insertAccept luOffer obiidAccept tdid (talid, patch, _, parentCtx, WorkItemDetail childId childCtx childAuthor) = do
        encodeRouteLocal <- getEncodeRouteLocal
        encodeRouteHome <- getEncodeRouteHome
        followers <- askFollowers
        workItemFollowers <- askWorkItemFollowers
        hLocal <- asksSite siteInstanceHost
        obikhidAccept <- encodeKeyHashid obiidAccept
        tdkhid <- encodeKeyHashid tdid
        ra <- getJust $ remoteAuthorId author
        let ObjURI hAuthor luAuthor = remoteAuthorURI author

            audAuthor =
                AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra)
            audParentContext = contextAudience parentCtx
            audChildContext = contextAudience childCtx
            audParent = AudLocal [LocalActorSharer shrRecip] [followers talid patch]
            audChildAuthor =
                case childAuthor of
                    Left shr -> AudLocal [LocalActorSharer shr] []
                    Right (ObjURI h lu) -> AudRemote h [lu] []
            audChildFollowers =
                case childId of
                    Left (wi, _ltid) -> AudLocal [] [workItemFollowers wi]
                    Right (ObjURI h _, luFollowers) -> AudRemote h [] [luFollowers]

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience $
                    audAuthor :
                    audParent :
                    audChildAuthor :
                    audChildFollowers :
                    audParentContext ++ audChildContext

            recips = map encodeRouteHome audLocal ++ audRemote
            doc = Doc hLocal Activity
                { activityId       =
                    Just $ encodeRouteLocal $
                        SharerOutboxItemR shrRecip obikhidAccept
                , activityActor    = encodeRouteLocal $ SharerR shrRecip
                , activityCapability = Nothing
                , activitySummary  = Nothing
                , activityAudience = Audience recips [] [] [] [] []
                , activitySpecific = AcceptActivity Accept
                    { acceptObject = ObjURI hAuthor luOffer
                    , acceptResult =
                        Just $ encodeRouteLocal $ TicketDepR tdkhid
                    }
                }
        update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
        return (doc, recipientSet, remoteActors, fwdHosts)
        where
        askFollowers = do
            hashTALID <- getEncodeKeyHashid
            return $ \ talid patch ->
                let coll =
                        if patch
                            then LocalPersonCollectionSharerProposalFollowers
                            else LocalPersonCollectionSharerTicketFollowers
                in  coll shrRecip (hashTALID talid)
-}

mkuri (i, ro) = ObjURI (instanceHost i) (remoteObjectIdent ro)

{-
insertDep
    :: MonadIO m
    => UTCTime
    -> RemoteAuthor
    -> RemoteActivityId
    -> LocalTicketId
    -> Either (WorkItem, LocalTicketId) (FedURI, LocalURI)
    -> OutboxItemId
    -> ReaderT SqlBackend m LocalTicketDependencyId
insertDep now author ractidOffer ltidParent child obiidAccept = do
    tdid <- insert LocalTicketDependency
        { localTicketDependencyParent  = ltidParent
        , localTicketDependencyCreated = now
        , localTicketDependencyAccept  = obiidAccept
        }
    case child of
        Left (_wi, ltid) -> insert_ TicketDependencyChildLocal
            { ticketDependencyChildLocalDep   = tdid
            , ticketDependencyChildLocalChild = ltid
            }
        Right (ObjURI h lu, _luFollowers) -> do
            iid <- either entityKey id <$> insertBy' (Instance h)
            roid <- either entityKey id <$> insertBy' (RemoteObject iid lu)
            insert_ TicketDependencyChildRemote
                { ticketDependencyChildRemoteDep   = tdid
                , ticketDependencyChildRemoteChild = roid
                }
    insert_ TicketDependencyAuthorRemote
        { ticketDependencyAuthorRemoteDep    = tdid
        , ticketDependencyAuthorRemoteAuthor = remoteAuthorId author
        , ticketDependencyAuthorRemoteOpen   = ractidOffer
        }
    return tdid
-}

deckOfferDepF
    :: UTCTime
    -> KeyHashid Deck
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.TicketDependency URIMode
    -> FedURI
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
deckOfferDepF now recipHash author body mfwd luOffer dep uTarget = do
    error "projectOfferDepF temporarily disabled"



{-


    (parent, child) <- checkDepAndTarget dep uTarget
    (Entity jidRecip projectRecip, actorRecip) <- lift $ runDB $ do
        sid <- getKeyBy404 $ UniqueSharer shrRecip
        ej@(Entity _ j) <- getBy404 $ UniqueProject prjRecip sid
        (ej,) <$> getJust (projectActor j)
    return $ (,) "Ran initial checks, doing the rest asynchronously" $ Just $ do
        relevantParent <-
            for (ticketRelevance shrRecip prjRecip parent) $ \ parentLtid -> do
                parentAuthor <- runSiteDBExcept $ do
                    (_, _, _, _, _, _, author, _) <- do
                        mticket <- lift $ getProjectTicket shrRecip prjRecip parentLtid
                        fromMaybeE mticket $ "Parent" <> ": No such project-ticket"
                    lift $ getWorkItemAuthorDetail author
                childDetail <- getWorkItemDetail "Child" child
                return (parentLtid, parentAuthor, childDetail)
        mhttp <- runSiteDBExcept $ do
            mractid <- lift $ insertToInbox' now author body (actorInbox actorRecip) luOffer False
            for mractid $ \ (ractid, ibiid) -> do
                insertDepOffer ibiid parent child
                mremotesHttpFwd <- lift $ for mfwd $ \ (localRecips, sig) -> do
                    relevantFollowers <- askRelevantFollowers
                    let rf = relevantFollowers shrRecip prjRecip
                        sieve =
                            makeRecipientSet [] $ catMaybes
                                [ rf parent
                                , rf child
                                ]
                    remoteRecips <-
                        insertRemoteActivityToLocalInboxes
                            False ractid $
                                localRecipSieve'
                                    sieve False False localRecips
                    (sig,) <$> deliverRemoteDB_J (actbBL body) ractid jidRecip sig remoteRecips
                mremotesHttpAccept <- lift $ for relevantParent $ \ (parentLtid, parentAuthor, childDetail) -> do
                    obiidAccept <- insertEmptyOutboxItem (actorOutbox actorRecip) now
                    tdid <- insertDep now author ractid parentLtid (widIdent childDetail) obiidAccept
                    (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                        insertAccept luOffer obiidAccept tdid parentLtid parentAuthor childDetail
                    knownRemoteRecipsAccept <-
                        deliverLocal'
                            False
                            (LocalActorProject shrRecip prjRecip)
                            (actorInbox actorRecip)
                            obiidAccept
                            localRecipsAccept
                    (obiidAccept,docAccept,fwdHostsAccept,) <$> deliverRemoteDB fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
                return (mremotesHttpFwd, mremotesHttpAccept)
        case mhttp of
            Nothing -> return "I already have this activity in my inbox, doing nothing"
            Just (mremotesHttpFwd, mremotesHttpAccept) -> do
                for_ mremotesHttpFwd $ \ (sig, remotes) ->
                    forkWorker "projectOfferDepF inbox-forwarding" $
                        deliverRemoteHTTP_J now shrRecip prjRecip (actbBL body) sig remotes
                for_ mremotesHttpAccept $ \ (obiid, doc, fwdHosts, remotes) ->
                    forkWorker "projectOfferDepF Accept HTTP delivery" $
                        deliverRemoteHttp' fwdHosts obiid doc remotes
                return $
                    case (mremotesHttpAccept, mremotesHttpFwd) of
                        (Nothing, Nothing) -> "Parent not mine, just stored in inbox and no inbox-forwarding to do"
                        (Nothing, Just _) -> "Parent not mine, just stored in inbox and ran inbox-forwarding"
                        (Just _, Nothing) -> "Accepted new ticket dep, no inbox-forwarding to do"
                        (Just _, Just _) -> "Accepted new ticket dep and ran inbox-forwarding of the Offer"
    where
    ticketRelevance shr prj (Left (WorkItemProjectTicket shr' prj' ltid))
        | shr == shr' && prj == prj' = Just ltid
    ticketRelevance _ _ _ = Nothing
    insertDepOffer _          (Left _)  _     = return ()
    insertDepOffer ibiidOffer (Right _) child =
        for_ (ticketRelevance shrRecip prjRecip child) $ \ ltid -> do
            _ <- do
                mticket <- lift $ getProjectTicket shrRecip prjRecip ltid
                fromMaybeE mticket $ "Child" <> ": No such project-ticket"
            lift $ insert_ TicketDependencyOffer
                { ticketDependencyOfferOffer = ibiidOffer
                , ticketDependencyOfferChild = ltid
                }
    askRelevantFollowers = do
        hashLTID <- getEncodeKeyHashid
        return $
            \ shr prj wi -> followers hashLTID <$> ticketRelevance shr prj wi
        where
        followers hashLTID ltid =
            LocalPersonCollectionProjectTicketFollowers
                shrRecip prjRecip (hashLTID ltid)
    insertAccept luOffer obiidAccept tdid ltid parentAuthor (WorkItemDetail childId childCtx childAuthor) = do
        encodeRouteLocal <- getEncodeRouteLocal
        encodeRouteHome <- getEncodeRouteHome
        followers <- askFollowers
        workItemFollowers <- askWorkItemFollowers
        hLocal <- asksSite siteInstanceHost
        obikhidAccept <- encodeKeyHashid obiidAccept
        tdkhid <- encodeKeyHashid tdid
        ra <- getJust $ remoteAuthorId author
        let ObjURI hAuthor luAuthor = remoteAuthorURI author

            audAuthor =
                AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra)
            audParentContext =
                AudLocal
                    []
                    [ LocalPersonCollectionProjectTeam shrRecip prjRecip
                    , LocalPersonCollectionProjectFollowers shrRecip prjRecip
                    ]
            audChildContext = contextAudience childCtx
            audParentFollowers = AudLocal [] [followers ltid]
            audParentAuthor =
                case parentAuthor of
                    Left shr -> AudLocal [LocalActorSharer shr] []
                    Right (i, ro) ->
                        AudRemote (instanceHost i) [remoteObjectIdent ro] []
            audChildAuthor =
                case childAuthor of
                    Left shr -> AudLocal [LocalActorSharer shr] []
                    Right (ObjURI h lu) -> AudRemote h [lu] []
            audChildFollowers =
                case childId of
                    Left (wi, _ltid) -> AudLocal [] [workItemFollowers wi]
                    Right (ObjURI h _, luFollowers) -> AudRemote h [] [luFollowers]

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience $
                    audAuthor :
                    audParentAuthor : audParentFollowers :
                    audChildAuthor : audChildFollowers :
                    audParentContext : audChildContext

            recips = map encodeRouteHome audLocal ++ audRemote
            doc = Doc hLocal Activity
                { activityId       =
                    Just $ encodeRouteLocal $
                        ProjectOutboxItemR shrRecip prjRecip obikhidAccept
                , activityActor    = encodeRouteLocal $ ProjectR shrRecip prjRecip
                , activityCapability = Nothing
                , activitySummary  = Nothing
                , activityAudience = Audience recips [] [] [] [] []
                , activitySpecific = AcceptActivity Accept
                    { acceptObject = ObjURI hAuthor luOffer
                    , acceptResult =
                        Just $ encodeRouteLocal $ TicketDepR tdkhid
                    }
                }
        update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
        return (doc, recipientSet, remoteActors, fwdHosts)
        where
        askFollowers = do
            hashLTID <- getEncodeKeyHashid
            return $
                \ ltid ->
                    LocalPersonCollectionProjectTicketFollowers
                        shrRecip prjRecip (hashLTID ltid)
-}

repoOfferDepF
    :: UTCTime
    -> KeyHashid Repo
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.TicketDependency URIMode
    -> FedURI
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
repoOfferDepF now recipHash author body mfwd luOffer dep uTarget = do
    error "repoOfferDepF temporarily disabled"


{-


    (parent, child) <- checkDepAndTarget dep uTarget
    Entity ridRecip repoRecip <- lift $ runDB $ do
        sid <- getKeyBy404 $ UniqueSharer shrRecip
        getBy404 $ UniqueRepo rpRecip sid
    return $ (,) "Ran initial checks, doing the rest asynchronously" $ Just $ do
        relevantParent <-
            for (ticketRelevance shrRecip rpRecip parent) $ \ parentLtid -> do
                parentAuthor <- runSiteDBExcept $ do
                    (_, _, _, _, _, _, author, _, _) <- do
                        mticket <- lift $ getRepoProposal shrRecip rpRecip parentLtid
                        fromMaybeE mticket $ "Parent" <> ": No such repo-patch"
                    lift $ getWorkItemAuthorDetail author
                childDetail <- getWorkItemDetail "Child" child
                return (parentLtid, parentAuthor, childDetail)
        mhttp <- runSiteDBExcept $ do
            mractid <- lift $ insertToInbox' now author body (repoInbox repoRecip) luOffer False
            for mractid $ \ (ractid, ibiid) -> do
                insertDepOffer ibiid parent child
                mremotesHttpFwd <- lift $ for mfwd $ \ (localRecips, sig) -> do
                    relevantFollowers <- askRelevantFollowers
                    let rf = relevantFollowers shrRecip rpRecip
                        sieve =
                            makeRecipientSet [] $ catMaybes
                                [ rf parent
                                , rf child
                                ]
                    remoteRecips <-
                        insertRemoteActivityToLocalInboxes
                            False ractid $
                                localRecipSieve'
                                    sieve False False localRecips
                    (sig,) <$> deliverRemoteDB_R (actbBL body) ractid ridRecip sig remoteRecips
                mremotesHttpAccept <- lift $ for relevantParent $ \ (parentLtid, parentAuthor, childDetail) -> do
                    obiidAccept <- insertEmptyOutboxItem (repoOutbox repoRecip) now
                    tdid <- insertDep now author ractid parentLtid (widIdent childDetail) obiidAccept
                    (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                        insertAccept luOffer obiidAccept tdid parentLtid parentAuthor childDetail
                    knownRemoteRecipsAccept <-
                        deliverLocal'
                            False
                            (LocalActorRepo shrRecip rpRecip)
                            (repoInbox repoRecip)
                            obiidAccept
                            localRecipsAccept
                    (obiidAccept,docAccept,fwdHostsAccept,) <$> deliverRemoteDB fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
                return (mremotesHttpFwd, mremotesHttpAccept)
        case mhttp of
            Nothing -> return "I already have this activity in my inbox, doing nothing"
            Just (mremotesHttpFwd, mremotesHttpAccept) -> do
                for_ mremotesHttpFwd $ \ (sig, remotes) ->
                    forkWorker "repoOfferDepF inbox-forwarding" $
                        deliverRemoteHTTP_R now shrRecip rpRecip (actbBL body) sig remotes
                for_ mremotesHttpAccept $ \ (obiid, doc, fwdHosts, remotes) ->
                    forkWorker "repoOfferDepF Accept HTTP delivery" $
                        deliverRemoteHttp' fwdHosts obiid doc remotes
                return $
                    case (mremotesHttpAccept, mremotesHttpFwd) of
                        (Nothing, Nothing) -> "Parent not mine, just stored in inbox and no inbox-forwarding to do"
                        (Nothing, Just _) -> "Parent not mine, just stored in inbox and ran inbox-forwarding"
                        (Just _, Nothing) -> "Accepted new ticket dep, no inbox-forwarding to do"
                        (Just _, Just _) -> "Accepted new ticket dep and ran inbox-forwarding of the Offer"
    where
    ticketRelevance shr rp (Left (WorkItemRepoProposal shr' rp' ltid))
        | shr == shr' && rp == rp' = Just ltid
    ticketRelevance _ _ _ = Nothing
    insertDepOffer _          (Left _)  _     = return ()
    insertDepOffer ibiidOffer (Right _) child =
        for_ (ticketRelevance shrRecip rpRecip child) $ \ ltid -> do
            _ <- do
                mticket <- lift $ getRepoProposal shrRecip rpRecip ltid
                fromMaybeE mticket $ "Child" <> ": No such repo-patch"
            lift $ insert_ TicketDependencyOffer
                { ticketDependencyOfferOffer = ibiidOffer
                , ticketDependencyOfferChild = ltid
                }
    askRelevantFollowers = do
        hashLTID <- getEncodeKeyHashid
        return $
            \ shr rp wi -> followers hashLTID <$> ticketRelevance shr rp wi
        where
        followers hashLTID ltid =
            LocalPersonCollectionRepoProposalFollowers
                shrRecip rpRecip (hashLTID ltid)
    insertAccept luOffer obiidAccept tdid ltid parentAuthor (WorkItemDetail childId childCtx childAuthor) = do
        encodeRouteLocal <- getEncodeRouteLocal
        encodeRouteHome <- getEncodeRouteHome
        followers <- askFollowers
        workItemFollowers <- askWorkItemFollowers
        hLocal <- asksSite siteInstanceHost
        obikhidAccept <- encodeKeyHashid obiidAccept
        tdkhid <- encodeKeyHashid tdid
        ra <- getJust $ remoteAuthorId author
        let ObjURI hAuthor luAuthor = remoteAuthorURI author

            audAuthor =
                AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra)
            audParentContext =
                AudLocal
                    []
                    [ LocalPersonCollectionRepoTeam shrRecip rpRecip
                    , LocalPersonCollectionRepoFollowers shrRecip rpRecip
                    ]
            audChildContext = contextAudience childCtx
            audParentFollowers = AudLocal [] [followers ltid]
            audParentAuthor =
                case parentAuthor of
                    Left shr -> AudLocal [LocalActorSharer shr] []
                    Right (i, ro) ->
                        AudRemote (instanceHost i) [remoteObjectIdent ro] []
            audChildAuthor =
                case childAuthor of
                    Left shr -> AudLocal [LocalActorSharer shr] []
                    Right (ObjURI h lu) -> AudRemote h [lu] []
            audChildFollowers =
                case childId of
                    Left (wi, _ltid) -> AudLocal [] [workItemFollowers wi]
                    Right (ObjURI h _, luFollowers) -> AudRemote h [] [luFollowers]

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience $
                    audAuthor :
                    audParentAuthor : audParentFollowers :
                    audChildAuthor : audChildFollowers :
                    audParentContext : audChildContext

            recips = map encodeRouteHome audLocal ++ audRemote
            doc = Doc hLocal Activity
                { activityId       =
                    Just $ encodeRouteLocal $
                        RepoOutboxItemR shrRecip rpRecip obikhidAccept
                , activityActor    = encodeRouteLocal $ RepoR shrRecip rpRecip
                , activityCapability = Nothing
                , activitySummary  = Nothing
                , activityAudience = Audience recips [] [] [] [] []
                , activitySpecific = AcceptActivity Accept
                    { acceptObject = ObjURI hAuthor luOffer
                    , acceptResult =
                        Just $ encodeRouteLocal $ TicketDepR tdkhid
                    }
                }
        update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
        return (doc, recipientSet, remoteActors, fwdHosts)
        where
        askFollowers = do
            hashLTID <- getEncodeKeyHashid
            return $
                \ ltid ->
                    LocalPersonCollectionRepoProposalFollowers
                        shrRecip rpRecip (hashLTID ltid)
-}

{-
verifyWorkItemExists (WorkItemSharerTicket shr talid False) = do
    mticket <- lift $ getSharerTicket shr talid
    verifyNothingE mticket $ "Object" <> ": No such sharer-ticket"
verifyWorkItemExists (WorkItemSharerTicket shr talid True) = do
    mticket <- lift $ getSharerProposal shr talid
    verifyNothingE mticket $ "Object" <> ": No such sharer-patch"
verifyWorkItemExists (WorkItemProjectTicket shr prj ltid) = do
    mticket <- lift $ getProjectTicket shr prj ltid
    verifyNothingE mticket $ "Object" <> ": No such project-ticket"
verifyWorkItemExists (WorkItemRepoProposal shr rp ltid) = do
    mticket <- lift $ getRepoProposal shr rp ltid
    verifyNothingE mticket $ "Object" <> ": No such repo-patch"

insertResolve author ltid ractid obiidAccept = do
    mtrid <- insertUnique TicketResolve
        { ticketResolveTicket = ltid
        , ticketResolveAccept = obiidAccept
        }
    for mtrid $ \ trid ->
        insertUnique TicketResolveRemote
            { ticketResolveRemoteTicket   = trid
            , ticketResolveRemoteActivity = ractid
            , ticketResolveRemoteActor    = remoteAuthorId author
            }
-}

trackerResolveF
    :: ( PersistRecordBackend r SqlBackend, ToBackendKey SqlBackend r
       , ToBackendKey SqlBackend wi
       )
    => (Route App -> Maybe (KeyHashid wi))
    -> (r -> ActorId)
    -> (  Key r
       -> Key wi
       -> ExceptT Text AppDB
            ( TicketId
            , Maybe
                ( Entity TicketResolve
                , Either
                    (Entity TicketResolveLocal)
                    (Entity TicketResolveRemote)
                )
            )
       )
    -> (Key r -> GrantResourceBy Key)
    -> (KeyHashid r -> LocalStageBy KeyHashid)
    -> (KeyHashid r -> KeyHashid wi -> LocalStageBy KeyHashid)
    -> (forall f. f r -> LocalActorBy f)
    -> UTCTime
    -> KeyHashid r
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Resolve URIMode
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
trackerResolveF maybeWorkItem grabActor getWorkItem makeResource trackerFollowers itemFollowers makeLocalActor now recipHash author body mfwd luResolve (AP.Resolve uObject) = (,Nothing) <$> do

    -- Check input
    recipID <- decodeKeyHashid404 recipHash
    wiID <- nameExceptT "Resolve object" $ do
        route <- do
            routeOrRemote <- parseFedURIOld uObject
            case routeOrRemote of
                Left route -> pure route
                Right _ -> throwE "Remote, so definitely not mine"
        case maybeWorkItem route of
            Nothing -> throwE "Local route but not a work item of mine"
            Just wiHash ->
                decodeKeyHashidE wiHash "Invalid work item keyhashid"

    -- Verify the capability URI is one of:
    --   * Outbox item URI of a local actor, i.e. a local activity
    --   * A remote URI
    capID <- do
        uCap <- do
            fromMaybeE
                (activityCapability $ actbActivity body)
                "Asking to resolve ticket but no capability provided"
        nameExceptT "Resolve capability" $ parseActivityURI uCap

    maybeHttp <- runDBExcept $ do

        -- Find recipient tracker in DB, returning 404 if doesn't exist because
        -- we're in the tracker's inbox post handler
        recip <- lift $ get404 recipID
        let recipActorID = grabActor recip
        recipActor <- lift $ getJust recipActorID

        -- Insert the Resolve to tracker's inbox
        mractid <- lift $ insertToInbox now author body (actorInbox recipActor) luResolve False
        for mractid $ \ resolveID -> do

            -- Find ticket in DB, verify it's not resolved
            ticketID <- do
                (ticketID, maybeResolve) <- getWorkItem recipID wiID
                unless (isNothing maybeResolve) $
                    throwE "Work item is already resolved"
                return ticketID

            -- Verify the sender is authorized by the tracker to resolve a ticket
            capability <-
                case capID of
                    Left (capActor, _, capItem) -> return (capActor, capItem)
                    Right _ -> throwE "Capability is a remote URI, i.e. not authored by the local tracker"
            verifyCapability
                capability
                (Right $ remoteAuthorId author)
                (makeResource recipID)

            -- Forward the Resolve activity to relevant local stages, and
            -- schedule delivery for unavailable remote members of them
            maybeHttpFwdResolve <- lift $ for mfwd $ \ (localRecips, sig) -> do
                wiHash <- encodeKeyHashid wiID
                let sieve =
                        makeRecipientSet
                            []
                            [ trackerFollowers recipHash
                            , itemFollowers recipHash wiHash
                            ]
                forwardActivityDB
                    (actbBL body) localRecips sig recipActorID
                    (makeLocalActor recipHash) sieve resolveID

            -- Mark ticket in DB as resolved by the Resolve
            acceptID <-
                lift $ insertEmptyOutboxItem (actorOutbox recipActor) now
            lift $ insertResolve ticketID resolveID acceptID

            -- Prepare an Accept activity and insert to tracker's outbox
            (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                lift $ prepareAccept wiID
            _luAccept <- lift $ updateOutboxItem (makeLocalActor recipID) acceptID actionAccept

            -- Deliver the Accept to local recipients, and schedule delivery
            -- for unavailable remote recipients
            deliverHttpAccept <-
                deliverActivityDB
                    (makeLocalActor recipHash) recipActorID
                    localRecipsAccept remoteRecipsAccept fwdHostsAccept
                    acceptID actionAccept

            -- Return instructions for HTTP inbox-forwarding of the Resolve
            -- activity, and for HTTP delivery of the Accept activity to
            -- remote recipients
            return (maybeHttpFwdResolve, deliverHttpAccept)

    -- Launch asynchronous HTTP forwarding of the Resolve activity and HTTP
    -- delivery of the Accept activity
    case maybeHttp of
        Nothing ->
            return "I already have this activity in my inbox, doing nothing"
        Just (maybeHttpFwdResolve, deliverHttpAccept) -> do
            for_ maybeHttpFwdResolve $
                forkWorker "trackerResolveF inbox-forwarding"
            forkWorker "trackerResolveF Accept HTTP delivery" deliverHttpAccept
            return $
                case maybeHttpFwdResolve of
                    Nothing -> "Resolved ticket, no inbox-forwarding to do"
                    Just _ ->
                        "Resolved ticket and ran inbox-forwarding of the Resolve"

    where

    insertResolve ticketID resolveID acceptID = do
        trid <- insert TicketResolve
            { ticketResolveTicket = ticketID
            , ticketResolveAccept = acceptID
            }
        insert_ TicketResolveRemote
            { ticketResolveRemoteTicket   = trid
            , ticketResolveRemoteActivity = resolveID
            , ticketResolveRemoteActor    = remoteAuthorId author
            }

    prepareAccept wiID = do
        encodeRouteHome <- getEncodeRouteHome

        wiHash <- encodeKeyHashid wiID

        ra <- getJust $ remoteAuthorId author

        let ObjURI hAuthor luAuthor = remoteAuthorURI author

            audSender =
                AudRemote hAuthor
                    [luAuthor]
                    (maybeToList $ remoteActorFollowers ra)
            audTracker =
                AudLocal
                    []
                    [ trackerFollowers recipHash
                    , itemFollowers recipHash wiHash
                    ]

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audSender, audTracker]

            recips = map encodeRouteHome audLocal ++ audRemote
            action = AP.Action
                { AP.actionCapability = Nothing
                , AP.actionSummary    = Nothing
                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                , AP.actionFulfills   = []
                , AP.actionSpecific   = AP.AcceptActivity AP.Accept
                    { AP.acceptObject   = ObjURI hAuthor luResolve
                    , AP.acceptResult   = Nothing
                    }
                }

        return (action, recipientSet, remoteActors, fwdHosts)

deckResolveF
    :: UTCTime
    -> KeyHashid Deck
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Resolve URIMode
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
deckResolveF now deckHash =
    trackerResolveF
        (\case
            TicketR trackerHash taskHash | trackerHash == deckHash ->
                Just taskHash
            _ -> Nothing
        )
        deckActor
        (\ deckID taskID -> do
            maybeTicket <- lift $ getTicket deckID taskID
            (_deck, _task, Entity ticketID _, _author, maybeResolve) <-
                fromMaybeE maybeTicket "I don't have such a ticket in DB"
            return (ticketID, maybeResolve)
        )
        GrantResourceDeck
        LocalStageDeckFollowers
        LocalStageTicketFollowers
        LocalActorDeck
        now
        deckHash

loomResolveF
    :: UTCTime
    -> KeyHashid Loom
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Resolve URIMode
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
loomResolveF now loomHash =
    trackerResolveF
        (\case
            ClothR trackerHash clothHash | trackerHash == loomHash ->
                Just clothHash
            _ -> Nothing
        )
        loomActor
        (\ loomID clothID -> do
            maybeCloth <- lift $ getCloth loomID clothID
            (_loom, _cloth, Entity ticketID _, _author, maybeResolve, _merge) <-
                fromMaybeE maybeCloth "I don't have such a MR in DB"
            return (ticketID, maybeResolve)
        )
        GrantResourceLoom
        LocalStageLoomFollowers
        LocalStageClothFollowers
        LocalActorLoom
        now
        loomHash