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

    --, sharerRejectF

      personFollowF
    , deckFollowF
    , loomFollowF
    , repoFollowF

    , personUndoF
    , deckUndoF
    , loomUndoF
    , repoUndoF
    )
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 Data.Aeson
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.Time.Calendar
import Data.Time.Clock
import Data.Traversable
import Database.Persist
import Database.Persist.Sql
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.List.NonEmpty as NE
import qualified Data.List.Ordered as LO
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

import Database.Persist.JSON
import Network.FedURI
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 Vervis.Access
import Vervis.ActivityPub
import Vervis.Actor
import Vervis.Cloth
import Vervis.Data.Actor
import Vervis.FedURI
import Vervis.Federation.Auth
import Vervis.Federation.Util
import Vervis.Foundation
import Vervis.Model
import Vervis.Model.Ident
import Vervis.Model.Ticket
import Vervis.Persist.Actor
import Vervis.Recipient
import Vervis.Ticket
import Vervis.Web.Delivery

{-
sharerAcceptF
    :: KeyHashid Person
    -> UTCTime
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (LocalRecipientSet, ByteString)
    -> LocalURI
    -> Accept URIMode
    -> ExceptT Text Handler Text
sharerAcceptF recipHash now author body mfwd luAccept (Accept (ObjURI hOffer luOffer) mresult) = do
    error "sharerAcceptF temporarily disabled"



    mres <- lift $ runDB $ do
        Entity pidRecip recip <- do
            sid <- getKeyBy404 $ UniqueSharer shr
            getBy404 $ UniquePersonIdent sid
        mractid <- insertToInbox now author body (personInbox recip) luAccept True
        for mractid $ \ ractid -> do
            mv <- runMaybeT $ asum
                [ insertFollow pidRecip (personOutbox recip) ractid
                , updateTicket pidRecip (personOutbox recip) ractid
                , insertDep mfwd (personInbox recip) ractid
                ]
            for mv $ bitraverse pure $ traverse $ \ ((localRecips, sig), collections) -> do
                let sieve = makeRecipientSet [] collections
                remoteRecips <-
                    insertRemoteActivityToLocalInboxes
                        False ractid $
                            localRecipSieve'
                                sieve False False localRecips
                (sig,) <$> deliverRemoteDB_S (actbBL body) ractid (personIdent recip) sig remoteRecips
    case mres of
        Nothing -> return "Activity already in my inbox"
        Just Nothing -> return "Activity inserted to my inbox"
        Just (Just (t, mfwd)) -> do
            for_ mfwd $ \ (sig, remotes) -> do
                forkWorker "sharerAcceptF inbox-forwarding" $
                    deliverRemoteHTTP_S now shr (actbBL body) sig remotes
            return t
    where
    insertFollow pidRecip obidRecip ractidAccept = do
        guard =<< hostIsLocal hOffer
        route <- MaybeT . pure $ decodeRouteLocal luOffer
        obiid <-
            case route of
                SharerOutboxItemR shr' obikhid
                    | shr == shr' -> decodeKeyHashidM obikhid
                _ -> MaybeT $ pure Nothing
        obi <- MaybeT $ get obiid
        guard $ outboxItemOutbox obi == obidRecip
        Entity frrid frr <- MaybeT $ getBy $ UniqueFollowRemoteRequestActivity obiid
        guard $ followRemoteRequestPerson frr == pidRecip
        let originalRecip =
                case followRemoteRequestRecip frr of
                    Nothing -> followRemoteRequestTarget frr
                    Just u -> u
        guard $ originalRecip == remoteAuthorURI author
        lift $ delete frrid
        lift $ insert_ FollowRemote
            { followRemotePerson = pidRecip
            , followRemoteRecip  = remoteAuthorId author
            , followRemoteTarget = followRemoteRequestTarget frr
            , followRemotePublic = followRemoteRequestPublic frr
            , followRemoteFollow = followRemoteRequestActivity frr
            , followRemoteAccept = ractidAccept
            }
        return ("Accept received for my follow request", Nothing)
    updateTicket pidRecip obidRecip ractidAccept = do
        guard =<< hostIsLocal hOffer
        route <- MaybeT . pure $ decodeRouteLocal luOffer
        obiid <-
            case route of
                SharerOutboxItemR shr' obikhid
                    | shr == shr' -> decodeKeyHashidM obikhid
                _ -> MaybeT $ pure Nothing
        obi <- MaybeT $ get obiid
        guard $ outboxItemOutbox obi == obidRecip
        Entity talid tal <- MaybeT $ getBy $ UniqueTicketAuthorLocalOpen obiid
        guard $ ticketAuthorLocalAuthor tal == pidRecip
        Entity tprid tpr <- MaybeT $ getBy $ UniqueTicketProjectRemote talid
        guard $ remoteAuthorId author == ticketProjectRemoteTracker tpr
        _tpraid <- MaybeT $ insertUnique TicketProjectRemoteAccept
            { ticketProjectRemoteAcceptTicket   = tprid
            , ticketProjectRemoteAcceptActivity = ractidAccept
            , ticketProjectRemoteAcceptAccept   = True
            , ticketProjectRemoteAcceptResult   = mresult
            }
        return ("Accept received for my ticket", Nothing)
    insertDep msig ibidRecip ractidAccept = do
        luResult <- MaybeT $ pure mresult
        hl <- hostIsLocal hOffer
        ibiidOffer <-
            if hl
                then do
                    route <- MaybeT . pure $ decodeRouteLocal luOffer
                    obiid <-
                        case route of
                            SharerOutboxItemR shr' obikhid -> do
                                obiid <- decodeKeyHashidM obikhid
                                obi <- MaybeT $ get obiid
                                p <- do
                                    sid <- MaybeT $ getKeyBy $ UniqueSharer shr'
                                    MaybeT $ getValBy $ UniquePersonIdent sid
                                guard $ personOutbox p == outboxItemOutbox obi
                                return obiid
                            _ -> MaybeT $ pure Nothing
                    inboxItemLocalItem <$>
                        MaybeT (getValBy $ UniqueInboxItemLocal ibidRecip obiid)
                else do
                    iid <- MaybeT $ getKeyBy $ UniqueInstance hOffer
                    roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luOffer
                    ractid <- MaybeT $ getKeyBy $ UniqueRemoteActivity roid
                    inboxItemRemoteItem <$>
                        MaybeT (getValBy $ UniqueInboxItemRemote ibidRecip ractid)
        Entity tdoid tdo <-
            MaybeT $ getBy $ UniqueTicketDependencyOffer ibiidOffer
        let ltidChild = ticketDependencyOfferChild tdo
        child <- lift $ getWorkItem ltidChild
        (talid, patch) <-
            case child of
                WorkItemSharerTicket shr' t p | shr == shr' -> return (t, p)
                _ -> MaybeT $ pure Nothing
        lift $ do
            delete tdoid
            roidResult <-
                let iid = remoteAuthorInstance author
                in  either entityKey id <$>
                        insertBy' (RemoteObject iid luResult)
            insert_ RemoteTicketDependency
                { remoteTicketDependencyIdent  = roidResult
                , remoteTicketDependencyChild  = ltidChild
                , remoteTicketDependencyAccept = ractidAccept
                }
        talkhid <- encodeKeyHashid talid
        let collections =
                [ let coll =
                        if patch
                            then LocalPersonCollectionSharerProposalFollowers
                            else LocalPersonCollectionSharerTicketFollowers
                  in  coll shr talkhid
                ]
        return
            ( "Inserted remote reverse ticket dep"
            , (,collections) <$> msig
            )
-}

{-
sharerRejectF
    :: KeyHashid Person
    -> UTCTime
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (LocalRecipientSet, ByteString)
    -> LocalURI
    -> Reject URIMode
    -> ExceptT Text Handler Text
sharerRejectF recipHash now author body mfwd luReject (Reject (ObjURI hOffer luOffer)) = do
    error "sharerRejectF temporarily disabled"





    lift $ runDB $ do
        Entity pidRecip recip <- do
            sid <- getKeyBy404 $ UniqueSharer shr
            getBy404 $ UniquePersonIdent sid
        mractid <- insertToInbox now author body (personInbox recip) luReject True
        encodeRouteLocal <- getEncodeRouteLocal
        let me = localUriPath $ encodeRouteLocal $ SharerR shr
        case mractid of
            Nothing -> return $ "Activity already exists in inbox of " <> me
            Just ractid -> do
                mv <- deleteFollow pidRecip (personOutbox recip)
                case mv of
                    Nothing ->
                        return $ "Activity inserted to inbox of " <> me
                    Just () ->
                        return $ "Reject received for follow request by " <> me
    where
    deleteFollow pidRecip obidRecip = runMaybeT $ do
        guard =<< hostIsLocal hOffer
        route <- MaybeT . pure $ decodeRouteLocal luOffer
        obiid <-
            case route of
                SharerOutboxItemR shr' obikhid
                    | shr == shr' -> decodeKeyHashidM obikhid
                _ -> MaybeT $ pure Nothing
        obi <- MaybeT $ get obiid
        guard $ outboxItemOutbox obi == obidRecip
        Entity frrid frr <- MaybeT $ getBy $ UniqueFollowRemoteRequestActivity obiid
        guard $ followRemoteRequestPerson frr == pidRecip
        let originalRecip =
                case followRemoteRequestRecip frr of
                    Nothing -> followRemoteRequestTarget frr
                    Just u -> u
        guard $ originalRecip == remoteAuthorURI author
        lift $ delete frrid
-}

followF
    :: (PersistRecordBackend r SqlBackend, ToBackendKey SqlBackend r)
    => (Route App -> ExceptT Text Handler a)
    -> (r -> ActorId)
    -> Bool
    -> (Key r -> Actor -> a -> ExceptT Text AppDB FollowerSetId)
    -> (a -> AppDB RecipientRoutes)
    -> (forall f. f r -> LocalActorBy f)
    -> (a -> Handler [Aud URIMode])
    -> UTCTime
    -> KeyHashid r
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Follow URIMode
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
followF parseFollowee grabActor unread getFollowee getSieve makeLocalActor makeAudience now recipHash author body mfwd luFollow (AP.Follow uObject _ hide) = (,Nothing) <$> do

    -- Check input
    recipID <- decodeKeyHashid404 recipHash
    followee <- nameExceptT "Follow object" $ do
        route <- do
            routeOrRemote <- parseFedURIOld uObject
            case routeOrRemote of
                Left route -> pure route
                Right _ -> throwE "Remote, so definitely not me/mine"
        parseFollowee route
    verifyNothingE
        (AP.activityCapability $ actbActivity body)
        "Capability not needed"

    maybeHttp <- runDBExcept $ do

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

        -- Insert the Follow to actor's inbox
        mractid <- lift $ insertToInbox now author body (actorInbox recipActor) luFollow unread
        for mractid $ \ followID -> do

            -- Find followee in DB
            followerSetID <- getFollowee recipID recipActor followee

            -- Verify not already following us
            let followerID = remoteAuthorId author
            maybeFollow <-
                lift $ getBy $ UniqueRemoteFollow followerID followerSetID
            verifyNothingE maybeFollow "You're already following this object"

            -- Forward the Follow activity to relevant local stages, and
            -- schedule delivery for unavailable remote members of them
            maybeHttpFwdFollow <- lift $ for mfwd $ \ (localRecips, sig) -> do
                sieve <- getSieve followee
                forwardActivityDB
                    (actbBL body) localRecips sig recipActorID
                    (makeLocalActor recipHash) sieve followID

            -- Record the new follow in DB
            acceptID <-
                lift $ insertEmptyOutboxItem (actorOutbox recipActor) now
            lift $ insert_ $ RemoteFollow followerID followerSetID (not hide) followID acceptID

            -- Prepare an Accept activity and insert to actor's outbox
            (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                lift $ prepareAccept followee
            _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 Follow
            -- activity, and for HTTP delivery of the Accept activity to
            -- remote recipients
            return (maybeHttpFwdFollow, deliverHttpAccept)

    -- Launch asynchronous HTTP forwarding of the Follow activity and HTTP
    -- delivery of the Accept activity
    case maybeHttp of
        Nothing ->
            return "I already have this activity in my inbox, doing nothing"
        Just (maybeHttpFwdFollow, deliverHttpAccept) -> do
            for_ maybeHttpFwdFollow $ forkWorker "followF inbox-forwarding"
            forkWorker "followF Accept HTTP delivery" deliverHttpAccept
            return $
                case maybeHttpFwdFollow of
                    Nothing -> "Recorded follow, no inbox-forwarding to do"
                    Just _ ->
                        "Recorded follow and ran inbox-forwarding of the Follow"

    where

    prepareAccept followee = do
        encodeRouteHome <- getEncodeRouteHome

        ra <- getJust $ remoteAuthorId author

        let ObjURI hAuthor luAuthor = remoteAuthorURI author

            audSender =
                AudRemote hAuthor
                    [luAuthor]
                    (maybeToList $ remoteActorFollowers ra)

        audsRecip <- lift $ makeAudience followee

        let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience $ audSender : audsRecip

            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 luFollow
                    , AP.acceptResult   = Nothing
                    }
                }

        return (action, recipientSet, remoteActors, fwdHosts)

{-
followF
    :: (Route App -> Maybe a)
    -> Route App
    -> (a -> AppDB (Maybe b))
    -> (b -> InboxId)
    -> (b -> OutboxId)
    -> (b -> FollowerSetId)
    -> (KeyHashid OutboxItem -> Route App)
    -> UTCTime
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (LocalRecipientSet, ByteString)
    -> LocalURI
    -> AP.Follow URIMode
    -> ExceptT Text Handler Text
followF
    objRoute recipRoute getRecip recipInbox recipOutbox recipFollowers outboxItemRoute
    now author body mfwd luFollow (AP.Follow (ObjURI hObj luObj) _mcontext hide) = do
        mobj <- do
            local <- hostIsLocal hObj
            return $
                if local
                    then objRoute =<< decodeRouteLocal luObj
                    else Nothing
        case mobj of
            Nothing -> return "Follow object unrelated to me, ignoring activity"
            Just obj -> do
                emsg <- lift $ runDB $ do
                    mrecip <- getRecip obj
                    case mrecip of
                        Nothing -> return $ Left "Follow object not found, ignoring activity"
                        Just recip -> do
                            newItem <- insertToInbox luFollow $ recipInbox recip
                            case newItem of
                                Nothing -> return $ Left "Activity already exists in inbox, not using"
                                Just ractid -> do
                                    let raidAuthor = remoteAuthorId author
                                    ra <- getJust raidAuthor
                                    ro <- getJust $ remoteActorIdent ra
                                    (obiid, doc) <-
                                        insertAcceptToOutbox
                                            ra
                                            luFollow
                                            (recipOutbox recip)
                                    newFollow <- insertFollow ractid obiid $ recipFollowers recip
                                    if newFollow
                                        then Right <$> do
                                            let raInfo = RemoteRecipient raidAuthor (remoteObjectIdent ro) (remoteActorInbox ra) (remoteActorErrorSince ra)
                                                iidAuthor = remoteAuthorInstance author
                                                hAuthor = objUriAuthority $ remoteAuthorURI author
                                                hostSection = ((iidAuthor, hAuthor), raInfo :| [])
                                            (obiid, doc,) <$> deliverRemoteDB [] obiid [] [hostSection]
                                        else do
                                            delete obiid
                                            return $ Left "You're already a follower of me"
                case emsg of
                    Left msg -> return msg
                    Right (obiid, doc, remotesHttp) -> do
                        forkWorker "followF: Accept delivery" $
                            deliverRemoteHttp' [] obiid doc remotesHttp
                        return "Follow request accepted"
    where
    insertToInbox luFollow ibidRecip = do
        let iidAuthor = remoteAuthorInstance author
        roid <-
            either entityKey id <$> insertBy' (RemoteObject iidAuthor luFollow)
        let jsonObj = persistJSONFromBL $ actbBL body
            ract = RemoteActivity roid jsonObj now
        ractid <- either entityKey id <$> insertBy' ract
        ibiid <- insert $ InboxItem True
        mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid
        case mibrid of
            Nothing -> do
                delete ibiid
                return Nothing
            Just _ -> return $ Just ractid

    insertFollow ractid obiidA fsid = do
        let raid = remoteAuthorId author
        mrfid <- insertUnique $ RemoteFollow raid fsid (not hide) ractid obiidA
        return $ isJust mrfid

    insertAcceptToOutbox ra luFollow obidRecip = do
        now <- liftIO getCurrentTime
        let uAuthor@(ObjURI hAuthor luAuthor) = remoteAuthorURI author
        encodeRouteLocal <- getEncodeRouteLocal
        hLocal <- asksSite siteInstanceHost
        let recipPath = localUriPath $ encodeRouteLocal recipRoute
        summary <-
            TextHtml . TL.toStrict . renderHtml <$>
                withUrlRenderer
                    [hamlet|
                        <p>
                          <a href="#{renderObjURI uAuthor}">
                            $maybe name <- remoteActorName ra
                              #{name}
                            $nothing
                              #{renderAuthority hAuthor}#{localUriPath luAuthor}
                          \'s follow request accepted by #
                          <a href=@{recipRoute}>
                            #{renderAuthority hLocal}#{recipPath}
                          .
                    |]
        let accept luAct = Doc hLocal Activity
                { activityId       = luAct
                , activityActor    = encodeRouteLocal recipRoute
                , activityCapability = Nothing
                , activitySummary  = Just summary
                , activityAudience = Audience [uAuthor] [] [] [] [] []
                , activitySpecific = AcceptActivity Accept
                    { acceptObject = ObjURI hAuthor luFollow
                    , acceptResult = Nothing
                    }
                }
        obiid <- insert OutboxItem
            { outboxItemOutbox    = obidRecip
            , outboxItemActivity  = persistJSONObjectFromDoc $ accept Nothing
            , outboxItemPublished = now
            }
        obikhid <- encodeKeyHashid obiid
        let luAct = encodeRouteLocal $ outboxItemRoute obikhid
            doc = accept $ Just luAct
        update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]
        return (obiid, doc)
-}

personFollowF
    :: UTCTime
    -> KeyHashid Person
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Follow URIMode
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
personFollowF now recipPersonHash =
    followF
        (\case
            PersonR p | p == recipPersonHash -> pure ()
            _ -> throwE "Asking to follow someone else"
        )
        personActor
        True
        (\ _recipPersonID recipPersonActor () ->
            pure $ actorFollowers recipPersonActor
        )
        (\ () -> pure $ makeRecipientSet [] [])
        LocalActorPerson
        (\ () -> pure [])
        now
        recipPersonHash

deckFollowF
    :: UTCTime
    -> KeyHashid Deck
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Follow URIMode
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
deckFollowF now recipDeckHash =
    followF
        (\case
            DeckR d | d == recipDeckHash -> pure Nothing
            TicketR d t | d == recipDeckHash ->
                Just <$> decodeKeyHashidE t "Invalid task keyhashid"
            _ -> throwE "Asking to follow someone else"
        )
        deckActor
        False
        (\ recipDeckID recipDeckActor maybeTaskID ->
            case maybeTaskID of
                Nothing -> pure $ actorFollowers recipDeckActor
                Just taskID -> do
                    maybeTicket <- lift $ getTicket recipDeckID taskID
                    (_deck, _task, Entity _ ticket, _author, _resolve) <-
                        fromMaybeE maybeTicket "I don't have this ticket in DB"
                    return $ ticketFollowers ticket
        )
        (\ _ -> pure $ makeRecipientSet [] [])
        LocalActorDeck
        (\ _ -> pure [])
        now
        recipDeckHash

loomFollowF
    :: UTCTime
    -> KeyHashid Loom
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Follow URIMode
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
loomFollowF now recipLoomHash =
    followF
        (\case
            LoomR l | l == recipLoomHash -> pure Nothing
            ClothR l c | l == recipLoomHash ->
                Just <$> decodeKeyHashidE c "Invalid cloth keyhashid"
            _ -> throwE "Asking to follow someone else"
        )
        loomActor
        False
        (\ recipLoomID recipLoomActor maybeClothID ->
            case maybeClothID of
                Nothing -> pure $ actorFollowers recipLoomActor
                Just clothID -> do
                    maybeCloth <- lift $ getCloth recipLoomID clothID
                    (_loom, _cloth, Entity _ ticket, _author, _resolve, _merge) <-
                        fromMaybeE maybeCloth "I don't have this MR in DB"
                    return $ ticketFollowers ticket
        )
        (\ _ -> pure $ makeRecipientSet [] [])
        LocalActorLoom
        (\ _ -> pure [])
        now
        recipLoomHash

repoFollowF
    :: UTCTime
    -> KeyHashid Repo
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Follow URIMode
    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
repoFollowF now recipRepoHash =
    followF
        (\case
            RepoR r | r == recipRepoHash -> pure ()
            _ -> throwE "Asking to follow someone else"
        )
        repoActor
        False
        (\ _recipRepoID recipRepoActor () ->
            pure $ actorFollowers recipRepoActor
        )
        (\ () -> pure $ makeRecipientSet [] [])
        LocalActorRepo
        (\ () -> pure [])
        now
        recipRepoHash

personUndoF
    :: UTCTime
    -> KeyHashid Person
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Undo URIMode
    -> ExceptT Text Handler Text
personUndoF now recipPersonHash author body mfwd luUndo (AP.Undo uObject) = do

    -- Check input
    recipPersonID <- decodeKeyHashid404 recipPersonHash
    undone <-
        first (\ (actor, _, item) -> (actor, item)) <$>
            parseActivityURI uObject

    -- Verify the capability URI, if provided, is one of:
    --   * Outbox item URI of a local actor, i.e. a local activity
    --   * A remote URI
    maybeCapability <-
        for (AP.activityCapability $ actbActivity body) $ \ uCap ->
            nameExceptT "Undo capability" $
                first (\ (actor, _, item) -> (actor, item)) <$>
                    parseActivityURI uCap

    maybeHttp <- runDBExcept $ do

        -- Find recipient person in DB, returning 404 if doesn't exist because we're
        -- in the person's inbox post handler
        (recipPersonActorID, recipPersonActor) <- lift $ do
            person <- get404 recipPersonID
            let actorID = personActor person
            (actorID,) <$> getJust actorID

        -- Insert the Undo to person's inbox
        mractid <- lift $ insertToInbox now author body (actorInbox recipPersonActor) luUndo False
        for mractid $ \ undoID -> do

            maybeUndo <- runMaybeT $ do

                -- Find the undone activity in our DB
                undoneDB <- MaybeT $ getActivity undone

                let followers = actorFollowers recipPersonActor
                MaybeT $ lift $ runMaybeT $ tryUnfollow followers undoneDB

            for maybeUndo $ \ (remoteFollowID, followerID) -> do

                (sieve, acceptAudience) <- do
                    (audSenderOnly, _audSenderAndFollowers) <- do
                        ra <- lift $ getJust $ remoteAuthorId author
                        let ObjURI hAuthor luAuthor = remoteAuthorURI author
                        return
                            ( AudRemote hAuthor [luAuthor] []
                            , AudRemote hAuthor
                                [luAuthor]
                                (maybeToList $ remoteActorFollowers ra)
                            )
                    unless (followerID == remoteAuthorId author) $
                        throwE "Trying to undo someone else's Follow"
                    lift $ delete remoteFollowID
                    return
                        ( makeRecipientSet [] []
                        , [audSenderOnly]
                        )

                -- Forward the Undo activity to relevant local stages, and
                -- schedule delivery for unavailable remote members of them
                maybeHttpFwdUndo <- lift $ for mfwd $ \ (localRecips, sig) ->
                    forwardActivityDB
                        (actbBL body) localRecips sig recipPersonActorID
                        (LocalActorPerson recipPersonHash) sieve undoID


                -- Prepare an Accept activity and insert to person's outbox
                acceptID <- lift $ insertEmptyOutboxItem (actorOutbox recipPersonActor) now
                (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                    lift . lift $ prepareAccept acceptAudience
                _luAccept <- lift $ updateOutboxItem (LocalActorPerson recipPersonID) acceptID actionAccept

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

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

    -- Launch asynchronous HTTP forwarding of the Undo activity and HTTP
    -- delivery of the Accept activity
    case maybeHttp of
        Nothing -> return "I already have this activity in my inbox, doing nothing"
        Just Nothing -> return "Unrelated to me, just inserted to inbox"
        Just (Just (maybeHttpFwdUndo, deliverHttpAccept)) -> do
            forkWorker "personUndoF Accept HTTP delivery" deliverHttpAccept
            case maybeHttpFwdUndo of
                Nothing -> return "Undid, no inbox-forwarding to do"
                Just forwardHttpUndo -> do
                    forkWorker "personUndoF inbox-forwarding" forwardHttpUndo
                    return "Undid and ran inbox-forwarding of the Undo"

    where

    tryUnfollow _               (Left _)                 = mzero
    tryUnfollow personFollowersID (Right remoteActivityID) = do
        Entity remoteFollowID remoteFollow <-
            MaybeT $ getBy $ UniqueRemoteFollowFollow remoteActivityID
        let followerID = remoteFollowActor remoteFollow
            followerSetID = remoteFollowTarget remoteFollow
        guard $ followerSetID == personFollowersID
        return (remoteFollowID, followerID)

    prepareAccept audience = do
        encodeRouteHome <- getEncodeRouteHome

        let ObjURI hAuthor _ = remoteAuthorURI author

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience audience

            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 luUndo
                    , AP.acceptResult   = Nothing
                    }
                }

        return (action, recipientSet, remoteActors, fwdHosts)

deckUndoF
    :: UTCTime
    -> KeyHashid Deck
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Undo URIMode
    -> ExceptT Text Handler Text
deckUndoF now recipDeckHash author body mfwd luUndo (AP.Undo uObject) = do

    -- Check input
    recipDeckID <- decodeKeyHashid404 recipDeckHash
    undone <-
        first (\ (actor, _, item) -> (actor, item)) <$>
            parseActivityURI uObject

    -- Verify the capability URI, if provided, is one of:
    --   * Outbox item URI of a local actor, i.e. a local activity
    --   * A remote URI
    maybeCapability <-
        for (AP.activityCapability $ actbActivity body) $ \ uCap ->
            nameExceptT "Undo capability" $
                first (\ (actor, _, item) -> (actor, item)) <$>
                    parseActivityURI uCap

    maybeHttp <- runDBExcept $ do

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

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

            -- Find the undone activity in our DB
            undoneDB <- do
                a <- getActivity undone
                fromMaybeE a "Can't find undone in DB"

            (sieve, acceptAudience) <- do
                maybeUndo <- do
                    let followers = actorFollowers recipDeckActor
                    lift $ runMaybeT $
                        Left <$> tryUnfollow recipDeckID followers undoneDB <|>
                        Right <$> tryUnresolve recipDeckID undoneDB
                undo <- fromMaybeE maybeUndo "Undone activity isn't a Follow or Resolve related to me"
                (audSenderOnly, audSenderAndFollowers) <- do
                    ra <- lift $ getJust $ remoteAuthorId author
                    let ObjURI hAuthor luAuthor = remoteAuthorURI author
                    return
                        ( AudRemote hAuthor [luAuthor] []
                        , AudRemote hAuthor
                            [luAuthor]
                            (maybeToList $ remoteActorFollowers ra)
                        )
                case undo of
                    Left (remoteFollowID, followerID) -> do
                        unless (followerID == remoteAuthorId author) $
                            throwE "Trying to undo someone else's Follow"
                        lift $ delete remoteFollowID
                        return
                            ( makeRecipientSet [] []
                            , [audSenderOnly]
                            )
                    Right (deleteFromDB, taskID) -> do

                        -- Verify the sender is authorized by the deck to unresolve a ticket
                        capability <- do
                            cap <-
                                fromMaybeE
                                    maybeCapability
                                    "Asking to unresolve ticket but no capability provided"
                            case cap of
                                Left c -> pure c
                                Right _ -> throwE "Capability is a remote URI, i.e. not authored by me"
                        verifyCapability
                            capability
                            (Right $ remoteAuthorId author)
                            (GrantResourceDeck recipDeckID)

                        lift deleteFromDB

                        taskHash <- encodeKeyHashid taskID
                        return
                            ( makeRecipientSet
                                [LocalActorDeck recipDeckHash]
                                [ LocalStageDeckFollowers recipDeckHash
                                , LocalStageTicketFollowers recipDeckHash taskHash
                                ]
                            , [ AudLocal
                                    []
                                    [ LocalStageDeckFollowers recipDeckHash
                                    , LocalStageTicketFollowers recipDeckHash taskHash
                                    ]
                              , audSenderAndFollowers
                              ]
                            )

            -- Forward the Undo activity to relevant local stages, and
            -- schedule delivery for unavailable remote members of them
            maybeHttpFwdUndo <- lift $ for mfwd $ \ (localRecips, sig) ->
                forwardActivityDB
                    (actbBL body) localRecips sig recipDeckActorID
                    (LocalActorDeck recipDeckHash) sieve undoID


            -- Prepare an Accept activity and insert to deck's outbox
            acceptID <- lift $ insertEmptyOutboxItem (actorOutbox recipDeckActor) now
            (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                lift . lift $ prepareAccept acceptAudience
            _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 Undo
            -- activity, and for HTTP delivery of the Accept activity to
            -- remote recipients
            return (maybeHttpFwdUndo, deliverHttpAccept)

    -- Launch asynchronous HTTP forwarding of the Undo activity and HTTP
    -- delivery of the Accept activity
    case maybeHttp of
        Nothing -> return "I already have this activity in my inbox, doing nothing"
        Just (maybeHttpFwdUndo, deliverHttpAccept) -> do
            forkWorker "deckUndoF Accept HTTP delivery" deliverHttpAccept
            case maybeHttpFwdUndo of
                Nothing -> return "Undid, no inbox-forwarding to do"
                Just forwardHttpUndo -> do
                    forkWorker "deckUndoF inbox-forwarding" forwardHttpUndo
                    return "Undid and ran inbox-forwarding of the Undo"

    where

    tryUnfollow _      _               (Left _)                 = mzero
    tryUnfollow deckID deckFollowersID (Right remoteActivityID) = do
        Entity remoteFollowID remoteFollow <-
            MaybeT $ getBy $ UniqueRemoteFollowFollow remoteActivityID
        let followerID = remoteFollowActor remoteFollow
            followerSetID = remoteFollowTarget remoteFollow
        if followerSetID == deckFollowersID
            then pure ()
            else do
                ticketID <-
                    MaybeT $ getKeyBy $ UniqueTicketFollowers followerSetID
                TicketDeck _ d <-
                    MaybeT $ getValBy $ UniqueTicketDeck ticketID
                guard $ d == deckID
        return (remoteFollowID, followerID)

    tryUnresolve deckID undone = do
        (deleteFromDB, ticketID) <- findTicket undone
        Entity taskID (TicketDeck _ d) <-
            MaybeT $ getBy $ UniqueTicketDeck ticketID
        guard $ d == deckID
        return (deleteFromDB, taskID)
        where
        findTicket (Left (_actorByKey, _actorEntity, itemID)) = do
            Entity resolveLocalID resolveLocal <-
                MaybeT $ getBy $ UniqueTicketResolveLocalActivity itemID
            let resolveID = ticketResolveLocalTicket resolveLocal
            resolve <- lift $ getJust resolveID
            let ticketID = ticketResolveTicket resolve
            return
                ( delete resolveLocalID >> delete resolveID
                , ticketID
                )
        findTicket (Right remoteActivityID) = do
            Entity resolveRemoteID resolveRemote <-
                MaybeT $ getBy $
                    UniqueTicketResolveRemoteActivity remoteActivityID
            let resolveID = ticketResolveRemoteTicket resolveRemote
            resolve <- lift $ getJust resolveID
            let ticketID = ticketResolveTicket resolve
            return
                ( delete resolveRemoteID >> delete resolveID
                , ticketID
                )

    prepareAccept audience = do
        encodeRouteHome <- getEncodeRouteHome

        let ObjURI hAuthor _ = remoteAuthorURI author

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience audience

            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 luUndo
                    , AP.acceptResult   = Nothing
                    }
                }

        return (action, recipientSet, remoteActors, fwdHosts)

loomUndoF
    :: UTCTime
    -> KeyHashid Loom
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Undo URIMode
    -> ExceptT Text Handler Text
loomUndoF now recipLoomHash author body mfwd luUndo (AP.Undo uObject) = do

    -- Check input
    recipLoomID <- decodeKeyHashid404 recipLoomHash
    undone <-
        first (\ (actor, _, item) -> (actor, item)) <$>
            parseActivityURI uObject

    -- Verify the capability URI, if provided, is one of:
    --   * Outbox item URI of a local actor, i.e. a local activity
    --   * A remote URI
    maybeCapability <-
        for (AP.activityCapability $ actbActivity body) $ \ uCap ->
            nameExceptT "Undo capability" $
                first (\ (actor, _, item) -> (actor, item)) <$>
                    parseActivityURI uCap

    maybeHttp <- runDBExcept $ do

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

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

            -- Find the undone activity in our DB
            undoneDB <- do
                a <- getActivity undone
                fromMaybeE a "Can't find undone in DB"

            (sieve, acceptAudience) <- do
                maybeUndo <- do
                    let followers = actorFollowers recipLoomActor
                    lift $ runMaybeT $
                        Left <$> tryUnfollow recipLoomID followers undoneDB <|>
                        Right <$> tryUnresolve recipLoomID undoneDB
                undo <- fromMaybeE maybeUndo "Undone activity isn't a Follow or Resolve related to me"
                (audSenderOnly, audSenderAndFollowers) <- do
                    ra <- lift $ getJust $ remoteAuthorId author
                    let ObjURI hAuthor luAuthor = remoteAuthorURI author
                    return
                        ( AudRemote hAuthor [luAuthor] []
                        , AudRemote hAuthor
                            [luAuthor]
                            (maybeToList $ remoteActorFollowers ra)
                        )
                case undo of
                    Left (remoteFollowID, followerID) -> do
                        unless (followerID == remoteAuthorId author) $
                            throwE "Trying to undo someone else's Follow"
                        lift $ delete remoteFollowID
                        return
                            ( makeRecipientSet [] []
                            , [audSenderOnly]
                            )
                    Right (deleteFromDB, clothID) -> do

                        -- Verify the sender is authorized by the loom to unresolve a MR
                        capability <- do
                            cap <-
                                fromMaybeE
                                    maybeCapability
                                    "Asking to unresolve MR but no capability provided"
                            case cap of
                                Left c -> pure c
                                Right _ -> throwE "Capability is a remote URI, i.e. not authored by me"
                        verifyCapability
                            capability
                            (Right $ remoteAuthorId author)
                            (GrantResourceLoom recipLoomID)

                        lift deleteFromDB

                        clothHash <- encodeKeyHashid clothID
                        return
                            ( makeRecipientSet
                                [LocalActorLoom recipLoomHash]
                                [ LocalStageLoomFollowers recipLoomHash
                                , LocalStageClothFollowers recipLoomHash clothHash
                                ]
                            , [ AudLocal
                                    []
                                    [ LocalStageLoomFollowers recipLoomHash
                                    , LocalStageClothFollowers recipLoomHash clothHash
                                    ]
                              , audSenderAndFollowers
                              ]
                            )

            -- Forward the Undo activity to relevant local stages, and
            -- schedule delivery for unavailable remote members of them
            maybeHttpFwdUndo <- lift $ for mfwd $ \ (localRecips, sig) ->
                forwardActivityDB
                    (actbBL body) localRecips sig recipLoomActorID
                    (LocalActorLoom recipLoomHash) sieve undoID


            -- Prepare an Accept activity and insert to loom's outbox
            acceptID <- lift $ insertEmptyOutboxItem (actorOutbox recipLoomActor) now
            (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                lift . lift $ prepareAccept acceptAudience
            _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 Undo
            -- activity, and for HTTP delivery of the Accept activity to
            -- remote recipients
            return (maybeHttpFwdUndo, deliverHttpAccept)

    -- Launch asynchronous HTTP forwarding of the Undo activity and HTTP
    -- delivery of the Accept activity
    case maybeHttp of
        Nothing -> return "I already have this activity in my inbox, doing nothing"
        Just (maybeHttpFwdUndo, deliverHttpAccept) -> do
            forkWorker "loomUndoF Accept HTTP delivery" deliverHttpAccept
            case maybeHttpFwdUndo of
                Nothing -> return "Undid, no inbox-forwarding to do"
                Just forwardHttpUndo -> do
                    forkWorker "loomUndoF inbox-forwarding" forwardHttpUndo
                    return "Undid and ran inbox-forwarding of the Undo"

    where

    tryUnfollow _      _               (Left _)                 = mzero
    tryUnfollow loomID loomFollowersID (Right remoteActivityID) = do
        Entity remoteFollowID remoteFollow <-
            MaybeT $ getBy $ UniqueRemoteFollowFollow remoteActivityID
        let followerID = remoteFollowActor remoteFollow
            followerSetID = remoteFollowTarget remoteFollow
        if followerSetID == loomFollowersID
            then pure ()
            else do
                ticketID <-
                    MaybeT $ getKeyBy $ UniqueTicketFollowers followerSetID
                TicketLoom _ l _ <-
                    MaybeT $ getValBy $ UniqueTicketLoom ticketID
                guard $ l == loomID
        return (remoteFollowID, followerID)

    tryUnresolve loomID undone = do
        (deleteFromDB, ticketID) <- findTicket undone
        Entity clothID (TicketLoom _ l _) <-
            MaybeT $ getBy $ UniqueTicketLoom ticketID
        guard $ l == loomID
        return (deleteFromDB, clothID)
        where
        findTicket (Left (_actorByKey, _actorEntity, itemID)) = do
            Entity resolveLocalID resolveLocal <-
                MaybeT $ getBy $ UniqueTicketResolveLocalActivity itemID
            let resolveID = ticketResolveLocalTicket resolveLocal
            resolve <- lift $ getJust resolveID
            let ticketID = ticketResolveTicket resolve
            return
                ( delete resolveLocalID >> delete resolveID
                , ticketID
                )
        findTicket (Right remoteActivityID) = do
            Entity resolveRemoteID resolveRemote <-
                MaybeT $ getBy $
                    UniqueTicketResolveRemoteActivity remoteActivityID
            let resolveID = ticketResolveRemoteTicket resolveRemote
            resolve <- lift $ getJust resolveID
            let ticketID = ticketResolveTicket resolve
            return
                ( delete resolveRemoteID >> delete resolveID
                , ticketID
                )

    prepareAccept audience = do
        encodeRouteHome <- getEncodeRouteHome

        let ObjURI hAuthor _ = remoteAuthorURI author

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience audience

            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 luUndo
                    , AP.acceptResult   = Nothing
                    }
                }

        return (action, recipientSet, remoteActors, fwdHosts)

repoUndoF
    :: UTCTime
    -> KeyHashid Repo
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Undo URIMode
    -> ExceptT Text Handler Text
repoUndoF now recipRepoHash author body mfwd luUndo (AP.Undo uObject) = do

    -- Check input
    recipRepoID <- decodeKeyHashid404 recipRepoHash
    undone <-
        first (\ (actor, _, item) -> (actor, item)) <$>
            parseActivityURI uObject

    -- Verify the capability URI, if provided, is one of:
    --   * Outbox item URI of a local actor, i.e. a local activity
    --   * A remote URI
    maybeCapability <-
        for (AP.activityCapability $ actbActivity body) $ \ uCap ->
            nameExceptT "Undo capability" $
                first (\ (actor, _, item) -> (actor, item)) <$>
                    parseActivityURI uCap

    maybeHttp <- runDBExcept $ do

        -- Find recipient repo in DB, returning 404 if doesn't exist because we're
        -- in the repo's inbox post handler
        (recipRepoActorID, recipRepoActor) <- lift $ do
            repo <- get404 recipRepoID
            let actorID = repoActor repo
            (actorID,) <$> getJust actorID

        -- Insert the Undo to repo's inbox
        mractid <- lift $ insertToInbox now author body (actorInbox recipRepoActor) luUndo False
        for mractid $ \ undoID -> do

            -- Find the undone activity in our DB
            undoneDB <- do
                a <- getActivity undone
                fromMaybeE a "Can't find undone in DB"

            (sieve, acceptAudience) <- do
                (remoteFollowID, followerID) <- do
                    maybeUndo <- do
                        let followers = actorFollowers recipRepoActor
                        lift $ runMaybeT $ tryUnfollow followers undoneDB
                    fromMaybeE maybeUndo "Undone activity isn't a Follow related to me"
                (audSenderOnly, _audSenderAndFollowers) <- do
                    ra <- lift $ getJust $ remoteAuthorId author
                    let ObjURI hAuthor luAuthor = remoteAuthorURI author
                    return
                        ( AudRemote hAuthor [luAuthor] []
                        , AudRemote hAuthor
                            [luAuthor]
                            (maybeToList $ remoteActorFollowers ra)
                        )
                unless (followerID == remoteAuthorId author) $
                    throwE "Trying to undo someone else's Follow"
                lift $ delete remoteFollowID
                return
                    ( makeRecipientSet [] []
                    , [audSenderOnly]
                    )

            -- Forward the Undo activity to relevant local stages, and
            -- schedule delivery for unavailable remote members of them
            maybeHttpFwdUndo <- lift $ for mfwd $ \ (localRecips, sig) ->
                forwardActivityDB
                    (actbBL body) localRecips sig recipRepoActorID
                    (LocalActorRepo recipRepoHash) sieve undoID


            -- Prepare an Accept activity and insert to repo's outbox
            acceptID <- lift $ insertEmptyOutboxItem (actorOutbox recipRepoActor) now
            (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
                lift . lift $ prepareAccept acceptAudience
            _luAccept <- lift $ updateOutboxItem (LocalActorRepo recipRepoID) acceptID actionAccept

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

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

    -- Launch asynchronous HTTP forwarding of the Undo activity and HTTP
    -- delivery of the Accept activity
    case maybeHttp of
        Nothing -> return "I already have this activity in my inbox, doing nothing"
        Just (maybeHttpFwdUndo, deliverHttpAccept) -> do
            forkWorker "repoUndoF Accept HTTP delivery" deliverHttpAccept
            case maybeHttpFwdUndo of
                Nothing -> return "Undid, no inbox-forwarding to do"
                Just forwardHttpUndo -> do
                    forkWorker "repoUndoF inbox-forwarding" forwardHttpUndo
                    return "Undid and ran inbox-forwarding of the Undo"

    where

    tryUnfollow _               (Left _)                 = mzero
    tryUnfollow repoFollowersID (Right remoteActivityID) = do
        Entity remoteFollowID remoteFollow <-
            MaybeT $ getBy $ UniqueRemoteFollowFollow remoteActivityID
        let followerID = remoteFollowActor remoteFollow
            followerSetID = remoteFollowTarget remoteFollow
        guard $ followerSetID == repoFollowersID
        return (remoteFollowID, followerID)

    prepareAccept audience = do
        encodeRouteHome <- getEncodeRouteHome

        let ObjURI hAuthor _ = remoteAuthorURI author

            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience audience

            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 luUndo
                    , AP.acceptResult   = Nothing
                    }
                }

        return (action, recipientSet, remoteActors, fwdHosts)