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

module Vervis.Actor.Person
    (
    )
where

import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
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.Barbie
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.ByteString (ByteString)
import Data.Foldable
import Data.Maybe
import Data.Text (Text)
import Data.Time.Clock
import Data.Traversable
import Database.Persist
import Database.Persist.Sql
import Optics.Core
import Yesod.Persist.Core

import qualified Data.Text as T

import Control.Concurrent.Actor
import Network.FedURI
import Web.Actor
import Web.Actor.Persist
import Yesod.MonadSite

import qualified Web.ActivityPub as AP

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

import Vervis.Access
import Vervis.ActivityPub
import Vervis.Actor
import Vervis.Actor.Common
import Vervis.Actor.Person.Client
import Vervis.Actor2
import Vervis.Cloth
import Vervis.Data.Actor
import Vervis.Data.Collab
import Vervis.Data.Discussion
import Vervis.Data.Follow
import Vervis.Data.Ticket
import Vervis.FedURI
import Vervis.Federation.Util
import Vervis.Foundation
import Vervis.Model
import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience)
import Vervis.Persist.Actor
import Vervis.Persist.Collab
import Vervis.Persist.Discussion
import Vervis.Persist.Follow
import Vervis.Ticket

-- Meaning: Someone is offering a ticket or dependency to a tracker
-- Behavior:
--      * Insert to my inbox
personOffer
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Offer URIMode
    -> ActE (Text, Act (), Next)
personOffer now recipPersonID (Verse authorIdMsig body) (AP.Offer object uTarget) = do

    -- Check input
    ticket <-
        case object of
            AP.OfferTicket t -> pure t
            _ -> throwE "Unsupported Offer.object type"
    ObjURI hAuthor _ <- lift $ getActorURI authorIdMsig
    let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
    WorkItemOffer {..} <- checkOfferTicket hAuthor ticket uTarget
    unless (bimap LocalActorPerson id wioAuthor == author) $
        throwE "Offering a Ticket attributed to someone else"

    maybeNew <- withDBExcept $ do

        -- Grab me from DB
        (personRecip, actorRecip) <- lift $ do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)

        maybeOfferDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
        for maybeOfferDB $ \ _offerDB ->
            return $ personActor personRecip

    case maybeNew of
        Nothing -> done "I already have this activity in my inbox"
        Just _actorID -> done "Inserted this Offer to my inbox"

-- Meaning: Someone has asked to resolve a ticket/MR
-- Behavior:
--      * Insert to my inbox
personResolve
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Resolve URIMode
    -> ActE (Text, Act (), Next)
personResolve now recipPersonID (Verse authorIdMsig body) (AP.Resolve uObject) = do

    maybeNew <- withDBExcept $ do

        -- Grab me from DB
        (personRecip, actorRecip) <- lift $ do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)

        maybeResolveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
        for maybeResolveDB $ \ _resolveDB ->
            return $ personActor personRecip

    case maybeNew of
        Nothing -> done "I already have this activity in my inbox"
        Just _actorID -> done "Inserted this Resolve to my inbox"

------------------------------------------------------------------------------
-- Following
------------------------------------------------------------------------------

-- Meaning: Someone is following someone
-- Behavior:
--      * Verify I'm the target
--      * Record the follow in DB
--      * Publish and send an Accept to the sender and its followers
personFollow
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Follow URIMode
    -> ActE (Text, Act (), Next)
personFollow now recipPersonID verse follow = do
    recipPersonHash <- encodeKeyHashid recipPersonID
    actorFollow
        (\case
            PersonR p | p == recipPersonHash -> pure ()
            _ -> throwE "Asking to follow someone else"
        )
        personActor
        True
        (\ recipPersonActor () ->
            pure $ actorFollowers recipPersonActor
        )
        (\ () -> pure $ makeRecipientSet [] [])
        LocalActorPerson
        (\ () -> pure [])
        now recipPersonID verse follow

-- Meaning: Someone is undoing some previous action
-- Behavior:
--      * Insert to my inbox
--      * If they're undoing their Following of me:
--          * Record it in my DB
--          * Publish and send an Accept only to the sender
personUndo
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Undo URIMode
    -> ActE (Text, Act (), Next)
personUndo now recipPersonID (Verse authorIdMsig body) (AP.Undo uObject) = do

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

    maybeUndo <- withDBExcept $ do

        -- Grab me from DB
        (personRecip, actorRecip) <- lift $ do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)

        -- Insert the Undo to person's inbox
        maybeUndoDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
        for maybeUndoDB $ \ undoDB -> do

            maybeUndo <- runMaybeT $ do

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

                let followers = actorFollowers actorRecip
                tryUnfollow followers undoneDB undoDB

            for maybeUndo $ \ () -> do

                -- Prepare an Accept activity and insert to person's outbox
                acceptID <- lift $ insertEmptyOutboxItem' (actorOutbox actorRecip) now
                accept@(actionAccept, _, _, _) <- lift $ lift prepareAccept
                _luAccept <- lift $ updateOutboxItem' (LocalActorPerson recipPersonID) acceptID actionAccept

                return (personActor personRecip, acceptID, accept)

    case maybeUndo of
        Nothing -> done "I already have this activity in my inbox"
        Just Nothing -> done "Unrelated to me, just inserted to inbox"
        Just (Just (actorID, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept))) -> do
            lift $ sendActivity
                (LocalActorPerson recipPersonID) actorID localRecipsAccept
                remoteRecipsAccept fwdHostsAccept acceptID actionAccept
            done "Undid the Follow and published Accept"

    where

    tryUnfollow personFollowersID (Right remoteActivityID) (Right (author, _, _)) = do
        Entity remoteFollowID remoteFollow <-
            MaybeT $ lift $ getBy $ UniqueRemoteFollowFollow remoteActivityID
        let followerID = remoteFollowActor remoteFollow
            followerSetID = remoteFollowTarget remoteFollow
        guard $ followerSetID == personFollowersID
        unless (followerID == remoteAuthorId author) $
            lift $ throwE "You're trying to Undo someone else's Follow"
        lift $ lift $ delete remoteFollowID
    tryUnfollow personFollowersID (Left (_, _, outboxItemID)) (Left (_, actorID, _)) = do
        Entity followID follow <-
            MaybeT $ lift $ getBy $ UniqueFollowFollow outboxItemID
        let followerID = followActor follow
            followerSetID = followTarget follow
        guard $ followerSetID == personFollowersID
        unless (followerID == actorID) $
            lift $ throwE "You're trying to Undo someone else's Follow"
        lift $ lift $ delete followID
    tryUnfollow _ _ _ = mzero

    prepareAccept = do
        encodeRouteHome <- getEncodeRouteHome

        audSender <- makeAudSenderOnly authorIdMsig
        uUndo <- getActivityURI authorIdMsig
        let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audSender]

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

        return (action, recipientSet, remoteActors, fwdHosts)

-- Meaning: An actor accepted something
-- Behavior:
--      * Insert to my inbox
--      * If it's on a Follow I sent to them:
--          * Add to my following list in DB
--      * If it's on an Invite-for-me to collaborate on a resource:
--          * Verify I haven't yet seen the resource's accept
--          * Verify the Accept author is the resource
--          * Store it in the Permit record in DB
--          * Forward to my followers
personAccept
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Accept URIMode
    -> ActE (Text, Act (), Next)
personAccept now recipPersonID (Verse authorIdMsig body) accept = do

    -- Check input
    acceptee <- parseAccept accept

    maybeNew <- withDBExcept $ do

        -- Grab me from DB
        (personRecip, actorRecip) <- lift $ do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)

        maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
        for maybeAcceptDB $ \ acceptDB -> runMaybeT $ do

            -- Find the accepted activity in our DB
            accepteeDB <- MaybeT $ getActivity acceptee

            let recipActorID = personActor personRecip
            Left <$> tryFollow recipActorID accepteeDB acceptDB <|>
                Right <$> tryInvite recipActorID accepteeDB acceptDB

    case maybeNew of
        Nothing -> done "I already have this activity in my inbox"
        Just Nothing -> done "Not my Follow/Invite; Just inserted to my inbox"
        Just (Just (Left ())) ->
            done "Recorded this Accept on the Follow request I sent"
        Just (Just (Right (actorID, sieve))) -> do
            forwardActivity
                authorIdMsig body (LocalActorPerson recipPersonID)
                actorID sieve
            done
                "Recorded this Accept on the Invite I've had & \
                \forwarded to my followers"

    where

    tryFollow actorID (Left (_, _, outboxItemID)) (Right (author, _, acceptID)) = do
        Entity key val <-
            MaybeT $ lift $
                getBy $ UniqueFollowRemoteRequestActivity outboxItemID
        guard $ followRemoteRequestPerson val == recipPersonID
        let uRecip =
                fromMaybe
                    (followRemoteRequestTarget val)
                    (followRemoteRequestRecip val)
        unless (remoteAuthorURI author == uRecip) $
            lift $ throwE "You're Accepting a Follow I sent to someone else"
        lift $ lift $ delete key
        lift $ lift $ insert_ FollowRemote
            { followRemoteActor  = actorID
            , followRemoteRecip  = remoteAuthorId author
            , followRemoteTarget = followRemoteRequestTarget val
            , followRemotePublic = followRemoteRequestPublic val
            , followRemoteFollow = outboxItemID
            , followRemoteAccept = acceptID
            }
    tryFollow actorID (Left (_, _, outboxItemID)) (Left (authorByKey, _, acceptID)) = do
        Entity key val <-
            MaybeT $ lift $ getBy $ UniqueFollowRequestFollow outboxItemID
        guard $ followRequestActor val == actorID
        targetByKey <-
            lift $ lift $ followeeActor <$> getFollowee' (followRequestTarget val)
        unless (authorByKey == targetByKey) $
            lift $ throwE "You're Accepting a Follow I sent to someone else"
        lift $ lift $ delete key
        -- The followee already inserted a Follow, so we just make sure it
        -- already exists
        followKey <- do
            mf <- lift $ lift $ getKeyBy $ UniqueFollowAccept acceptID
            lift $ fromMaybeE mf "Can't find a Follow record in DB"
        mf1 <-
            lift $ lift $ getKeyBy $ UniqueFollow actorID (followRequestTarget val)
        mf2 <-
            lift $ lift $ getKeyBy $ UniqueFollowFollow outboxItemID
        unless (mf1 == Just followKey && mf2 == Just followKey) $
            lift $ throwE "Weird inconsistency with Follow uniques"
        {-
        lift $ lift $ insert_ Follow
            { followActor  = actorID
            , followTarget = followRequestTarget val
            , followPublic = followRequestPublic val
            , followFollow = outboxItemID
            , followAccept = acceptID
            }
        -}
    tryFollow _ (Right _) _ = mzero

    tryInvite recipActorID accepteeDB acceptDB = do

        -- Find a PermitFulfillsInvite
        (permitID, fulfillsID) <-
            case accepteeDB of
                Left (actorByKey, _actorEntity, itemID) -> do
                    PermitTopicGestureLocal fulfillsID _ <-
                        MaybeT $ lift $ getValBy $ UniquePermitTopicGestureLocalInvite itemID
                    PermitFulfillsInvite permitID <- lift . lift $ getJust fulfillsID
                    return (permitID, fulfillsID)
                Right remoteActivityID -> do
                    PermitTopicGestureRemote fulfillsID _ _ <-
                        MaybeT $ lift $ getValBy $ UniquePermitTopicGestureRemoteInvite remoteActivityID
                    PermitFulfillsInvite permitID <- lift . lift $ getJust fulfillsID
                    return (permitID, fulfillsID)

        -- Find the local person and verify it's me
        Permit p _role <- lift . lift $ getJust permitID
        guard $ p == recipPersonID

        lift $ do
            -- Find the topic
            topic <- lift $ getPermitTopic permitID

            -- Verify I haven't seen the topic's accept yet
            maybeTopicAccept <-
                lift $ case bimap fst fst topic of
                    Left localID -> void <$> getBy (UniquePermitTopicAcceptLocalTopic localID)
                    Right remoteID -> void <$> getBy (UniquePermitTopicAcceptRemoteTopic remoteID)
            unless (isNothing maybeTopicAccept) $
                throwE "I've already seen the topic's Accept"

            -- Verify topic is the Accept sender
            case (bimap snd snd topic, bimap (view _1) (view _1) acceptDB) of
                (Left la, Left la') | la == la' -> pure ()
                (Right raID, Right ra) | raID == remoteAuthorId ra -> pure ()
                _ -> throwE "Accept sender isn't the Invite topic"

            -- Update the Permit record
            lift $ case (bimap fst fst topic, bimap (view _3) (view _3) acceptDB)  of
                (Left localID, Left acceptID) -> insert_ $ PermitTopicAcceptLocal fulfillsID localID acceptID
                (Right remoteID, Right acceptID) -> insert_ $ PermitTopicAcceptRemote fulfillsID remoteID acceptID
                _ -> error "personAccept impossible"

            -- Prepare forwarding Accept to my followers
            recipPersonHash <- encodeKeyHashid recipPersonID
            let sieve = makeRecipientSet [] [LocalStagePersonFollowers recipPersonHash]

            return (recipActorID, sieve)

-- Meaning: An actor rejected something
-- Behavior:
--      * Insert to my inbox
--      * If it's a Follow I sent to them, remove record from my DB
personReject
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Reject URIMode
    -> ActE (Text, Act (), Next)
personReject now recipPersonID (Verse authorIdMsig body) reject = do

    -- Check input
    rejectee <- parseReject reject

    maybeNew <- withDBExcept $ do

        -- Grab me from DB
        (personRecip, actorRecip) <- lift $ do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)

        maybeRejectDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
        for maybeRejectDB $ \ _rejectDB -> runMaybeT $ do

            -- Find the rejected activity in our DB
            rejecteeDB <- MaybeT $ getActivity rejectee

            tryFollow (personActor personRecip) rejecteeDB authorIdMsig

    case maybeNew of
        Nothing -> done "I already have this activity in my inbox"
        Just Nothing -> done "Not my Follow; Just inserted to my inbox"
        Just (Just ()) ->
            done "Recorded this Reject on the Follow request I sent"

    where

    tryFollow _actorID (Left (_, _, outboxItemID)) (Right (author, _, _)) = do
        Entity key val <-
            MaybeT $ lift $
                getBy $ UniqueFollowRemoteRequestActivity outboxItemID
        guard $ followRemoteRequestPerson val == recipPersonID
        let uRecip =
                fromMaybe
                    (followRemoteRequestTarget val)
                    (followRemoteRequestRecip val)
        unless (remoteAuthorURI author == uRecip) $
            lift $ throwE "You're Rejecting a Follow I sent to someone else"
        lift $ lift $ delete key
    tryFollow actorID (Left (_, _, outboxItemID)) (Left (authorByKey, _, _)) = do
        Entity key val <-
            MaybeT $ lift $ getBy $ UniqueFollowRequestFollow outboxItemID
        guard $ followRequestActor val == actorID
        targetByKey <-
            lift $ lift $ followeeActor <$> getFollowee' (followRequestTarget val)
        unless (authorByKey == targetByKey) $
            lift $ throwE "You're Rejecting a Follow I sent to someone else"
        lift $ lift $ delete key
    tryFollow _ (Right _) _ = mzero

------------------------------------------------------------------------------
-- Commenting
------------------------------------------------------------------------------

-- Meaning: Someone commented on an issue/PR
-- Behavior: Insert to inbox
personCreateNote
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Note URIMode
    -> ActE (Text, Act (), Next)
personCreateNote now recipPersonID (Verse authorIdMsig body) note = do

    -- Check input
    (luNote, published, Comment maybeParent topic source content) <- do
        (luId, luAuthor, published, comment) <- parseRemoteComment note
        uCreateAuthor <- lift $ getActorURI authorIdMsig
        unless (luAuthor == objUriLocal uCreateAuthor) $
            throwE "Create author != note author"
        return (luId, published, comment)

    mractid <- withDBExcept $ do
        Entity recipActorID recipActor <- lift $ do
            person <- getJust recipPersonID
            let actorID = personActor person
            Entity actorID <$> getJust actorID

        case topic of

            Right uContext -> do
                checkContextParent uContext maybeParent
                lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) True

            Left (CommentTopicTicket deckID taskID) -> do
                (_, _, Entity _ ticket, _, _) <- do
                    mticket <- lift $ getTicket deckID taskID
                    fromMaybeE mticket "Context: No such deck-ticket"
                let did = ticketDiscuss ticket
                _ <- traverse (getMessageParent did) maybeParent
                lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) True

            Left (CommentTopicCloth loomID clothID) -> do
                (_, _, Entity _ ticket, _, _, _) <- do
                    mticket <- lift $ getCloth loomID clothID
                    fromMaybeE mticket "Context: No such loom-cloth"
                let did = ticketDiscuss ticket
                _ <- traverse (getMessageParent did) maybeParent
                lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) True

    done $
        case mractid of
            Nothing -> "I already have this activity in my inbox, doing nothing"
            Just _ -> "Inserted Create{Note} to my inbox"
    where
    checkContextParent (ObjURI hContext luContext) mparent = do
        mdid <- lift $ runMaybeT $ do
            iid <- MaybeT $ getKeyBy $ UniqueInstance hContext
            roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luContext
            rd <- MaybeT $ getValBy $ UniqueRemoteDiscussionIdent roid
            return $ remoteDiscussionDiscuss rd
        for_ mparent $ \ parent ->
            case parent of
                Left msg -> do
                    did <- fromMaybeE mdid "Local parent inexistent, no RemoteDiscussion"
                    void $ getLocalParentMessageId did msg
                Right (ObjURI hParent luParent) -> do
                    mrm <- lift $ runMaybeT $ do
                        iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
                        roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent
                        MaybeT $ getValBy $ UniqueRemoteMessageIdent roid
                    for_ mrm $ \ rm -> do
                        let mid = remoteMessageRest rm
                        m <- lift $ getJust mid
                        did <- fromMaybeE mdid "Remote parent known, but no context RemoteDiscussion"
                        unless (messageRoot m == did) $
                            throwE "Remote parent belongs to a different discussion"

------------------------------------------------------------------------------
-- Access
------------------------------------------------------------------------------

-- Meaning: Someone is adding something to something
-- Behavior:
--      * Insert to my inbox
personAdd
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Add URIMode
    -> ActE (Text, Act (), Next)
personAdd now recipPersonID (Verse authorIdMsig body) add = do

    -- Check input
    let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
    _ <- parseAdd author add

    maybeNew <- withDBExcept $ do

        -- Grab me from DB
        (personRecip, actorRecip) <- lift $ do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)

        maybeAddDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
        for maybeAddDB $ \ _addDB ->
            return $ personActor personRecip

    case maybeNew of
        Nothing -> done "I already have this activity in my inbox"
        Just _actorID -> done "Inserted this Add to my inbox"

-- Meaning: Someone invited someone to a resource
-- Behavior:
--      * Insert to my inbox
--      * If I'm being invited to the resource's collaborators/members
--        collection:
--          * For each Permit record I have for this resource:
--              * Verify it's not enabled yet, i.e. I'm not already a
--                collaborator, haven't received a direct-Grant
--              * Verify it's not in Invite-Accept state, already got the
--                resource's Accept and waiting for my approval or for the
--                topic's Grant
--              * Verify it's not a Join
--          * Create a Permit record in DB
--          * Forward the Invite to my followers
personInvite
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Invite URIMode
    -> ActE (Text, Act (), Next)
personInvite now recipPersonID (Verse authorIdMsig body) invite = do

    -- Check input
    maybeRoleAndResourceDB <- do
        let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
        (role, resource, recip) <- parseInvite author invite
        let recipIsMe =
                case recip of
                    Left (Left (GrantRecipPerson p)) | p == recipPersonID -> True
                    _ -> False
        if not recipIsMe
            then pure Nothing
            else
                -- If resource collabs URI is remote, HTTP GET it and its resource and its
                -- managing actor, and insert to our DB. If resource is local, find it in
                -- our DB.
                case resource of
                    Left r ->
                        case r of
                            Left la -> withDBExcept $ Just . (role,) . Left <$> getLocalActorEntityE la "Invite resource not found in DB"
                            Right _j -> pure Nothing
                    Right u@(ObjURI h luColl) -> do
                        manager <- asksEnv envHttpManager
                        coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl
                        lu <- fromMaybeE (AP.collectionContext (coll :: AP.Collection FedURI URIMode)) "Remote topic collabs has no 'context'"
                        AP.ResourceWithCollections _ mluCollabs _mluComps mluMembers <- ExceptT $ liftIO $ first (T.pack . show) <$> AP.fetchRWC manager h lu
                        if mluCollabs == Just luColl || mluMembers == Just luColl
                            then Just . (role,) . Right <$> do
                                instanceID <-
                                    lift $ withDB $ either entityKey id <$> insertBy' (Instance h)
                                result <-
                                    ExceptT $ first (T.pack . show) <$>
                                        fetchRemoteResource instanceID h lu
                                case result of
                                    Left (Entity actorID actor) ->
                                        return (remoteActorIdent actor, actorID, u)
                                    Right (objectID, luManager, (Entity actorID _)) ->
                                        return (objectID, actorID, ObjURI h luManager)
                            else pure Nothing

    maybeNew <- withDBExcept $ do

        -- Grab me from DB
        (personRecip, actorRecip) <- lift $ do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)

        maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
        for maybeInviteDB $ \ inviteDB -> do

            maybePermit <- for maybeRoleAndResourceDB $ \ (role, resourceDB) -> do

                -- Find existing Permit records I have for this topic
                -- Make sure none are enabled / in Join mode / in Invite-Accept
                -- mode
                checkExistingPermits
                    recipPersonID
                    (bimap (bmap entityKey) (view _2) resourceDB)

                -- Prepare forwarding Invite to my followers
                recipPersonHash <- encodeKeyHashid recipPersonID
                let sieve = makeRecipientSet [] [LocalStagePersonFollowers recipPersonHash]

                -- Insert Permit record to DB
                insertPermit resourceDB inviteDB role

                return sieve

            return (personActor personRecip, maybePermit)

    case maybeNew of
        Nothing -> done "I already have this activity in my inbox"
        Just (actorID, maybePermit) ->
            case maybePermit of
                Nothing -> done "I'm not the target; Inserted to inbox"
                Just sieve -> do
                    forwardActivity
                        authorIdMsig body (LocalActorPerson recipPersonID)
                        actorID sieve
                    done
                        "I'm the target; Inserted to inbox; Inserted Permit; \
                        \Forwarded to followers if addressed"

    where

    insertPermit resourceDB inviteDB role = do
        permitID <- lift $ insert $ Permit recipPersonID role
        case resourceDB of
            Left la -> do
                localID <- lift $ insert $ PermitTopicLocal permitID
                case bmap entityKey la of
                    LocalActorPerson _ -> throwE "insertPermit: Person not supported as a PermitTopicLocal type (you can't become a \"collaborator in a person\""
                    LocalActorRepo r -> lift $ insert_ $ PermitTopicRepo localID r
                    LocalActorDeck d -> lift $ insert_ $ PermitTopicDeck localID d
                    LocalActorLoom l -> lift $ insert_ $ PermitTopicLoom localID l
                    LocalActorProject j -> lift $ insert_ $ PermitTopicProject localID j
                    LocalActorGroup g -> lift $ insert_ $ PermitTopicGroup localID g
            Right (_, actorID, _) -> lift $ insert_ $ PermitTopicRemote permitID actorID
        lift $ do
            fulfillsID <- insert $ PermitFulfillsInvite permitID
            case inviteDB of
                Left (_, _, inviteID) ->
                    insert_ $ PermitTopicGestureLocal fulfillsID inviteID
                Right (author, _, inviteID) ->
                    insert_ $ PermitTopicGestureRemote fulfillsID (remoteAuthorId author) inviteID

-- Meaning: Someone removed someone from a resource
-- Behavior:
--      * Insert to my inbox
--      * If I'm the object, forward the Remove to my followers
personRemove
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Remove URIMode
    -> ActE (Text, Act (), Next)
personRemove now recipPersonID (Verse authorIdMsig body) remove = do

    -- Check input
    memberOrComp <- do
        let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
        (_resource, member) <- parseRemove author remove
        return member

    maybeNew <- withDBExcept $ do

        -- Grab me from DB
        (personRecip, actorRecip) <- lift $ do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)

        maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
        for maybeRemoveDB $ \ _removeDB ->
            return $ personActor personRecip

    case maybeNew of
        Nothing -> done "I already have this activity in my inbox"
        Just actorID -> do
            let memberIsMe =
                    case memberOrComp of
                        Left (LocalActorPerson p) -> p == recipPersonID
                        _ -> False
            if not memberIsMe
                then done "I'm not the member; Inserted to inbox"
                else do
                    recipHash <- encodeKeyHashid recipPersonID
                    let sieve =
                            makeRecipientSet
                                []
                                [LocalStagePersonFollowers recipHash]
                    forwardActivity
                        authorIdMsig body (LocalActorPerson recipPersonID)
                        actorID sieve
                    done
                        "I'm the member; Inserted to inbox; \
                        \Forwarded to followers if addressed"

-- Meaning: Someone asked to join a resource
-- Behavior: Insert to my inbox
personJoin
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Join URIMode
    -> ActE (Text, Act (), Next)
personJoin now recipPersonID (Verse authorIdMsig body) join = do

    -- Check input
    (_role, _resource) <- parseJoin join

    maybeJoinID <- lift $ withDB $ do

        -- Grab me from DB
        (_personRecip, actorRecip) <- do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)

        insertToInbox now authorIdMsig body (actorInbox actorRecip) True

    case maybeJoinID of
        Nothing -> done "I already have this activity in my inbox"
        Just _joinID -> done "Inserted to my inbox"

-- Meaning: An actor published a Grant
-- Behavior:
--      * Insert to my inbox
--
--      * If it's a direct-Grant that fulfills a Permit I have:
--          * Verify the Permit isn't already enabled
--          * Verify the sender is the Permit topic
--          * Verify the role is identical to what was requested
--          * Update the Permit record, storing the direct-Grant
--          * Forward the direct-Grant to my followers
--          * If topic is a Project or a Team:
--              * Send a delegator-Grant to the topic
--              * Update the Permit record, storing the delegator-Grant
--
--      * If it's a extension-Grant whose capability is a delegator-Grant from
--        a Permit I have:
--          * Verify the sender is the Permit topic
--          * Update the Permit record, storing the extension-Grant
personGrant
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Grant URIMode
    -> ActE (Text, Act (), Next)
personGrant now recipPersonID (Verse authorIdMsig body) grant = do

    -- Check input
    maybeMine <- do
        -- 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 "Grant.capability" $
                    first (\ (actor, _, item) -> (actor, item)) <$>
                        parseActivityURI' uCap

        -- Basic sanity checks
        (role, resource, recip, _mresult, mstart, mend, usage, mdeleg) <-
            parseGrant' grant
        case (recip, authorIdMsig) of
            (Left (LocalActorPerson p), Left (LocalActorPerson p', _, _))
                | p == p' ->
                    throwE "Grant sender and target are the same local Person"
            (Right uRecip, Right (author, _, _))
                | uRecip == remoteAuthorURI author ->
                    throwE "Grant sender and target are the same remote actor"
            _ -> pure ()
        let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
        case mdeleg of
            Nothing ->
                unless (author == resource) $
                    throwE "Not an extension but resource and actor differ"
            Just _ ->
                when (author == resource) $
                    throwE "Extension but resource and actor are identical"

        -- For a direct-Grant, use 'fulfills' to identify the Permit
        -- For an extension-Grant, use 'capability' for that
        runMaybeT $ do
            guard $ usage == AP.Invoke
            guard $ recip == Left (LocalActorPerson recipPersonID)
            lift $ do
                for_ mstart $ \ start ->
                    unless (start <= now) $
                        throwE "Got a Grant that hasn't started"
                for_ mend $ \ _ -> throwE "Got a Grant with expiration"
            if isNothing mdeleg
                then do
                    uFulfills <-
                        case AP.activityFulfills $ actbActivity body of
                            [] -> mzero
                            [u] -> pure u
                            _ -> lift $ throwE "Multiple fulfills"
                    fulfills <-
                        lift $
                        first (\ (actor, _, item) -> (actor, item)) <$>
                            parseActivityURI' uFulfills
                    return $ Left (role, fulfills)
                else do
                    cap <- lift $ fromMaybeE maybeCapability "Extension-Grant doesn't specify a delegator-Grant capability"
                    delegatorID <-
                        case cap of
                            Left (LocalActorPerson p, itemID) | p == recipPersonID -> pure itemID
                            _ -> lift $ throwE "Extending access to me using a delegator-Grant capability that isn't mine"
                    return $ Right delegatorID

    maybeNew <- withDBExcept $ do

        -- Grab me from DB
        (personRecip, actorRecip) <- lift $ do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)

        maybePermit <-
            for maybeMine $
                bitraverse
                    (\ (role, fulfills) -> do

                        -- Find my Permit record, verify the roles match
                        fulfillsDB <- do
                            a <- getActivity fulfills
                            fromMaybeE a "Can't find fulfills in DB"
                        (permitID, maybeGestureID) <- do
                            mp <- runMaybeT $ do
                                x@(pt, mg) <-
                                    tryInvite fulfillsDB <|>
                                    tryJoin fulfillsDB <|>
                                    tryCreate fulfillsDB
                                Permit p role' <- lift . lift $ getJust pt
                                guard $ p == recipPersonID
                                lift $ unless (role == AP.RXRole role') $
                                    throwE "Requested and granted roles differ"
                                return x
                            fromMaybeE mp "Can't find a PermitFulfills*"

                        -- If Permit fulfills an Invite, verify I've approved
                        -- it
                        gestureID <- fromMaybeE maybeGestureID "I'm getting this Grant but I haven't yet approved the Invite"

                        -- Verify the Permit isn't already enabled
                        topic <- lift $ getPermitTopic permitID
                        maybeTopicEnable <-
                            lift $ case bimap fst fst topic of
                                Left localID -> void <$> getBy (UniquePermitTopicEnableLocalTopic localID)
                                Right remoteID -> void <$> getBy (UniquePermitTopicEnableRemoteTopic remoteID)
                        unless (isNothing maybeTopicEnable) $
                            throwE "I've already received the direct-Grant"

                        -- Verify the Grant sender is the Permit topic
                        case (bimap snd snd topic, bimap (view _1) (view _1) authorIdMsig) of
                            (Left la, Left la') | la == la' -> pure ()
                            (Right raID, Right ra) | raID == remoteAuthorId ra -> pure ()
                            _ -> throwE "Grant sender isn't the Permit topic"

                        return (gestureID, bimap fst fst topic)
                    )
                    (\ delegatorID -> do
                        Entity sendID (PermitPersonSendDelegator gestureID _) <- do
                            mp <- lift $ getBy $ UniquePermitPersonSendDelegatorGrant delegatorID
                            fromMaybeE mp "Extension-Grant.capability: I don't have such a delegator-Grant, can't find a PermitPersonSendDelegator record"
                        PermitPersonGesture permitID _ <- lift $ getJust gestureID

                        -- Verify the Grant sender is the Permit topic
                        topic <- lift $ getPermitTopic permitID
                        case (bimap snd snd topic, bimap (view _1) (view _1) authorIdMsig) of
                            (Left la, Left la') | la == la' -> pure ()
                            (Right raID, Right ra) | raID == remoteAuthorId ra -> pure ()
                            _ -> throwE "Grant sender isn't the Permit topic"

                        return (sendID, bimap fst fst topic)
                    )

        mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
        for mractid $ \ grantDB -> do

            for maybePermit $
                bitraverse
                    (\ (gestureID, topic) -> lift $ do

                        -- Update the Permit record, storing the direct-Grant
                        case (topic, grantDB) of
                            (Left localID, Left (_, _, grantID)) ->
                                insert_ $ PermitTopicEnableLocal gestureID localID grantID
                            (Right remoteID, Right (_, _, grantID)) ->
                                insert_ $ PermitTopicEnableRemote gestureID remoteID grantID
                            _ -> error "personGrant impossible"

                        -- Prepare forwarding direct-Grant to my followers
                        recipPersonHash <- encodeKeyHashid recipPersonID
                        let sieve = makeRecipientSet [] [LocalStagePersonFollowers recipPersonHash]

                         -- Prepapre delegator-Grant and update Permit
                        needDeleg <-
                            case grantDB of
                                Left (la, _, _) ->
                                    pure $ case la of
                                        LocalActorProject _ -> True
                                        LocalActorGroup _ -> True
                                        _ -> False
                                Right (author, _, _) -> do
                                    ra <- getJust $ remoteAuthorId author
                                    pure $ case remoteActorType ra of
                                        AP.ActorTypeProject -> True
                                        AP.ActorTypeTeam -> True
                                        _ -> False
                        maybeDeleg <-
                            if needDeleg
                                then Just <$> do
                                    delegID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now
                                    deleg@(actionDeleg, _, _, _) <- prepareDelegGrant
                                    let recipByKey = LocalActorPerson recipPersonID
                                    _luDeleg <- updateOutboxItem' recipByKey delegID actionDeleg

                                    insert_ $ PermitPersonSendDelegator gestureID delegID

                                    return (delegID, deleg)
                                else
                                    pure Nothing

                        return (personActor personRecip, sieve, maybeDeleg)
                    )
                    (\ (sendID, topic) ->
                        case (topic, grantDB) of
                            (Left localID, Left (_, _, extID)) -> lift $ do
                                enableID <- do
                                    me <- getKeyBy $ UniquePermitTopicEnableLocalTopic localID
                                    case me of
                                        Just e -> pure e
                                        Nothing -> error "Impossible, Permit has the delegator-Grant but no (local) Enable"
                                insert_ $ PermitTopicExtendLocal sendID enableID extID
                            (Right remoteID, Right (_, _, extID)) -> lift $ do
                                enableID <- do
                                    me <- getKeyBy $ UniquePermitTopicEnableRemoteTopic remoteID
                                    case me of
                                        Just e -> pure e
                                        Nothing -> error "Impossible, Permit has the delegator-Grant but no (remote) Enable"
                                insert_ $ PermitTopicExtendRemote sendID enableID extID
                            _ -> error "personGrant impossible 2"
                    )

    case maybeNew of
        Nothing -> done "I already have this activity in my inbox"
        Just Nothing -> done "Inserted Grant to my inbox"
        Just (Just (Left (recipActorID, sieve, maybeDeleg))) -> do
            let recipByID = LocalActorPerson recipPersonID
            forwardActivity authorIdMsig body recipByID recipActorID sieve
            lift $ for_ maybeDeleg $ \ (delegID, (actionDeleg, localRecipsDeleg, remoteRecipsDeleg, fwdHostsDeleg)) ->
                sendActivity
                    recipByID recipActorID localRecipsDeleg
                    remoteRecipsDeleg fwdHostsDeleg delegID actionDeleg
            done "Forwarded the direct-Grant, updated Permit, maybe published delegator-Grant"
        Just (Just (Right ())) ->
            done "Got an extension-Grant, updated Permit"

    where

    tryInvite fulfillsDB = do
        fulfillsID <-
            case fulfillsDB of
                Left (_actorByKey, _actorEntity, itemID) -> do
                    PermitTopicGestureLocal fulfillsID _ <-
                        MaybeT $ lift $ getValBy $ UniquePermitTopicGestureLocalInvite itemID
                    return fulfillsID
                Right remoteActivityID -> do
                    PermitTopicGestureRemote fulfillsID _ _ <-
                        MaybeT $ lift $ getValBy $ UniquePermitTopicGestureRemoteInvite remoteActivityID
                    return fulfillsID
        PermitFulfillsInvite permitID <- lift . lift $ getJust fulfillsID
        maybeGestureID <- lift . lift $ getKeyBy $ UniquePermitPersonGesture permitID
        return (permitID, maybeGestureID)

    tryJoin fulfillsDB = do
        Entity gestureID (PermitPersonGesture permitID _) <-
            case fulfillsDB of
                Left (_actorByKey, _actorEntity, itemID) ->
                    MaybeT $ lift $ getBy $ UniquePermitPersonGestureActivity itemID
                Right _remoteActivityID -> mzero
        _ <- MaybeT $ lift $ getBy $ UniquePermitFulfillsJoin permitID
        return (permitID, Just gestureID)

    tryCreate fulfillsDB = do
        Entity gestureID (PermitPersonGesture permitID _) <-
            case fulfillsDB of
                Left (_actorByKey, _actorEntity, itemID) ->
                    MaybeT $ lift $ getBy $ UniquePermitPersonGestureActivity itemID
                Right _remoteActivityID -> mzero
        _ <- MaybeT $ lift $ getBy $ UniquePermitFulfillsTopicCreation permitID
        return (permitID, Just gestureID)

    prepareDelegGrant = do
        encodeRouteHome <- getEncodeRouteHome
        encodeRouteLocal <- getEncodeRouteLocal

        personHash <- encodeKeyHashid recipPersonID
        audTopic <- lift $ makeAudSenderOnly authorIdMsig
        uTopic <- lift $ getActorURI authorIdMsig
        uDirectGrant <- lift $ getActivityURI authorIdMsig

        let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audTopic]

            recips = map encodeRouteHome audLocal ++ audRemote
            action = AP.Action
                { AP.actionCapability = Just uDirectGrant
                , AP.actionSummary    = Nothing
                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                , AP.actionFulfills   = [uDirectGrant]
                , AP.actionSpecific   = AP.GrantActivity AP.Grant
                    { AP.grantObject    = AP.RXDelegator
                    , AP.grantContext   = encodeRouteHome $ PersonR personHash
                    , AP.grantTarget    = uTopic
                    , AP.grantResult    = Nothing
                    , AP.grantStart     = Just now
                    , AP.grantEnd       = Nothing
                    , AP.grantAllows    = AP.Invoke
                    , AP.grantDelegates = Nothing
                    }
                }

        return (action, recipientSet, remoteActors, fwdHosts)

-- Meaning: An actor has revoked some previously published Grants
-- Behavior:
--  * Insert to my inbox
--  * For each revoked activity:
--      * If it's a direct-Grant given to me:
--          * Verify the sender is the Permit topic
--          * Delete the Permit record
--      * If it's an extension-Grant given to me:
--          * Verify the sender is the Permit topic
--          * Delete the PermitTopicExtend* record
personRevoke
    :: UTCTime
    -> PersonId
    -> Verse
    -> AP.Revoke URIMode
    -> ActE (Text, Act (), Next)
personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke lus) = do

    -- Check input
    grants <- nameExceptT "Revoke.object" $ do
        ObjURI h _ <- lift $ getActorURI authorIdMsig
        hl <- hostIsLocal h
        if hl
            then
                for lus $ \ lu ->
                    (\ (actor, _, item) -> Left (actor, item)) <$>
                        parseLocalActivityURI' lu
            else
                pure $ Right . ObjURI h <$> lus

    maybeNew <- withDBExcept $ do

        -- Grab me from DB
        (personRecip, actorRecip) <- lift $ do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)

        -- Look for the revoked Grants in my Permit records
        grantsDB <- for grants $ \ grant -> runMaybeT $ do
            grantDB <- MaybeT $ getActivity grant
            found <-
                Left <$> tryDirect grantDB <|>
                Right <$> tryExtension grantDB
            bitraverse
                (\ (gestureID, topicAndEnable) -> do

                    -- Verify the Permit is mine
                    PermitPersonGesture permitID _ <- lift . lift $ getJust gestureID
                    Permit p _ <- lift . lift $ getJust permitID
                    guard $ p == recipPersonID

                    -- Verify the Revoke sender is the Permit topic
                    lift $ do
                        topic <- lift $ getPermitTopic permitID
                        case (bimap snd snd topic, bimap (view _1) (view _1) authorIdMsig) of
                            (Left la, Left la') | la == la' -> pure ()
                            (Right raID, Right ra) | raID == remoteAuthorId ra -> pure ()
                            _ -> throwE "Revoke sender isn't the Permit topic"

                    -- Return data for Permit deletion
                    return (permitID, gestureID, topicAndEnable)
                )
                (\ extend -> do

                    -- Verify the Permit is mine
                    sendID <-
                        lift . lift $ case extend of
                            Left k -> permitTopicExtendLocalPermit <$> getJust k
                            Right k -> permitTopicExtendRemotePermit <$> getJust k
                    PermitPersonSendDelegator gestureID _ <- lift . lift $ getJust sendID
                    PermitPersonGesture permitID _ <- lift . lift $ getJust gestureID
                    Permit p _ <- lift . lift $ getJust permitID
                    guard $ p == recipPersonID

                    -- Verify the Revoke sender is the Permit topic
                    lift $ do
                        topic <- lift $ getPermitTopic permitID
                        case (bimap snd snd topic, bimap (view _1) (view _1) authorIdMsig) of
                            (Left la, Left la') | la == la' -> pure ()
                            (Right raID, Right ra) | raID == remoteAuthorId ra -> pure ()
                            _ -> throwE "Revoke sender isn't the Permit topic"

                    -- Return data for PermitTopicExtend* deletion
                    return extend
                )
                found

        mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
        lift $ for mractid $ \ _revokeDB ->
            -- Delete revoked records from DB
            for grantsDB $ traverse_ $
                bitraverse_
                    (\ (permitID, gestureID, topicAndEnable) -> do
                        case topicAndEnable of
                            Left (_, enableID) ->
                                deleteWhere [PermitTopicExtendLocalTopic ==. enableID]
                            Right (_, enableID) ->
                                deleteWhere [PermitTopicExtendRemoteTopic ==. enableID]
                        deleteBy $ UniquePermitPersonSendDelegator gestureID
                        case topicAndEnable of
                            Left (topicID, enableID) -> do
                                delete enableID
                                deleteBy $ UniquePermitTopicAcceptLocalTopic topicID
                            Right (topicID, enableID) -> do
                                delete enableID
                                deleteBy $ UniquePermitTopicAcceptRemoteTopic topicID
                        maybeInvite <- getKeyBy $ UniquePermitFulfillsInvite permitID
                        for_ maybeInvite $ \ inviteID -> do
                            deleteBy $ UniquePermitTopicGestureLocal inviteID
                            deleteBy $ UniquePermitTopicGestureRemote inviteID
                        delete gestureID
                        deleteBy $ UniquePermitFulfillsTopicCreation permitID
                        deleteBy $ UniquePermitFulfillsInvite permitID
                        deleteBy $ UniquePermitFulfillsJoin permitID
                        case topicAndEnable of
                            Left (topicID, _) -> do
                                deleteBy $ UniquePermitTopicRepo topicID
                                deleteBy $ UniquePermitTopicDeck topicID
                                deleteBy $ UniquePermitTopicLoom topicID
                                deleteBy $ UniquePermitTopicProject topicID
                                deleteBy $ UniquePermitTopicGroup topicID
                                delete topicID
                            Right (topicID, _) -> delete topicID
                        delete permitID
                    )
                    (\case
                        Left k -> delete k
                        Right k -> delete k
                    )

    case maybeNew of
        Nothing -> done "I already have this activity in my inbox"
        Just _ -> done "Deleted any relevant Permit/Extend records"

    where

    tryDirect objectDB =
        case objectDB of
            Left (_actorByKey, _actorEntity, itemID) -> do
                Entity enableID (PermitTopicEnableLocal gestureID topicID _) <-
                    MaybeT $ lift $ getBy $ UniquePermitTopicEnableLocalGrant itemID
                return (gestureID, Left (topicID, enableID))
            Right remoteActivityID -> do
                Entity enableID (PermitTopicEnableRemote gestureID topicID _) <-
                    MaybeT $ lift $ getBy $ UniquePermitTopicEnableRemoteGrant remoteActivityID
                return (gestureID, Right (topicID, enableID))

    tryExtension objectDB =
        case objectDB of
            Left (_actorByKey, _actorEntity, itemID) -> do
                Entity extendID (PermitTopicExtendLocal _ _ _) <-
                    MaybeT $ lift $ getBy $ UniquePermitTopicExtendLocalGrant itemID
                return $ Left extendID
            Right remoteActivityID -> do
                Entity extendID (PermitTopicExtendRemote _ _ _) <-
                    MaybeT $ lift $ getBy $ UniquePermitTopicExtendRemoteGrant remoteActivityID
                return $ Right extendID

------------------------------------------------------------------------------
-- Main behavior function
------------------------------------------------------------------------------

personBehavior :: UTCTime -> PersonId -> VerseExt -> ActE (Text, Act (), Next)
personBehavior now personID (Left verse@(Verse _authorIdMsig body)) =
    case AP.activitySpecific $ actbActivity body of
        AP.AcceptActivity accept -> personAccept now personID verse accept
        AP.AddActivity add -> personAdd now personID verse add
        AP.CreateActivity (AP.Create obj mtarget) ->
            case obj of
                AP.CreateNote _ note ->
                    personCreateNote now personID verse note
                _ -> throwE "Unsupported create object type for people"
        AP.FollowActivity follow -> personFollow now personID verse follow
        AP.GrantActivity grant   -> personGrant now personID verse grant
        AP.InviteActivity invite -> personInvite now personID verse invite
        AP.JoinActivity join     -> personJoin now personID verse join
        AP.OfferActivity offer   -> personOffer now personID verse offer
        AP.RejectActivity reject -> personReject now personID verse reject
        AP.RemoveActivity remove -> personRemove now personID verse remove
        AP.ResolveActivity resolve -> personResolve now personID verse resolve
        AP.RevokeActivity revoke -> personRevoke now personID verse revoke
        AP.UndoActivity undo     -> personUndo now personID verse undo
        _ -> throwE "Unsupported activity type for Person"
personBehavior now personID (Right msg) = clientBehavior now personID msg

instance VervisActor Person where
    actorBehavior = personBehavior