Switch to factory-based creation of Deck, Project and Group

- UI for creating a Factory - UI for specifying a Factory when creating resource actors - Old way of creation doesn't work anymore, except for Factory itself - UI indicates whether you're an admin user - Settings allow to choose "resident" factories, i.e. ones automatically offered to every newly verified user Caveats: - Factories are all-in-one, no mechanism yet for choosing actor types - No UI/logic for auto-offering a Factory to all users of a different instance, and signaling other instances about newly verified local users
2024-08-06 12:33:02 +03:00 · 2024-08-06 12:33:02 +03:00 · e196ee6f34
commit e196ee6f34
parent 66870458b7
34 changed files with 1607 additions and 816 deletions
--- a/config/settings-default.yaml
+++ b/config/settings-default.yaml
@ -110,6 +110,13 @@ max-accounts: 3
 # Person usernames who are allowed to create Factory actors
 can-create-factories: []
 # KeyHashids of local Factory actors who will auto-send a develop-Grant to
 # every newly created account
 #
 # If empty or unset, and there's exactly 1 local factory in DB, it will
 # automatically become the resident
 resident-factories: []
 ###############################################################################
 # Mail
 ###############################################################################
--- a/migrations/650_2024-08-03_fulfills_resident.model
+++ b/migrations/650_2024-08-03_fulfills_resident.model
@ -0,0 +1,24 @@
 CollabFulfillsResidentFactory
    collab CollabId
    UniqueCollabFulfillsResidentFactory collab
 PermitFulfillsResidentFactory
    permit PermitId
    UniquePermitFulfillsResidentFactory permit
 ActorCreateLocal
    actor  ActorId
    create OutboxItemId
    UniqueActorCreateLocalActor  actor
    UniqueActorCreateLocalCreate create
 ActorCreateRemote
    actor  ActorId
    create RemoteActivityId
    sender RemoteActorId
    UniqueActorCreateRemoteActor  actor
    UniqueActorCreateRemoteCreate create
--- a/migrations/651_2024-08-03_actor_create.model
+++ b/migrations/651_2024-08-03_actor_create.model
@ -0,0 +1,114 @@
 Komponent
 Workflow
 Outbox
 OutboxItem
    outbox    OutboxId
    activity  PersistJSONObject
    published UTCTime
 Inbox
 FollowerSet
 Actor
    name      Text
    desc      Text
    createdAt UTCTime
    inbox     InboxId
    outbox    OutboxId
    followers FollowerSetId
    justCreatedBy ActorId Maybe
    errbox    InboxId
    UniqueActorInbox     inbox
    UniqueActorOutbox    outbox
    UniqueActorFollowers followers
 ActorCreateLocal
    actor  ActorId
    create OutboxItemId
 Person
    username            Username
    login               Text
    passphraseHash      ByteString
    email               EmailAddress
    verified            Bool
    verifiedKey         Text
    verifiedKeyCreated  UTCTime
    resetPassKey        Text
    resetPassKeyCreated UTCTime
    actor               ActorId
 --  reviewFollow        Bool
    UniquePersonUsername username
    UniquePersonLogin    login
    UniquePersonEmail    email
    UniquePersonActor    actor
 Resource
    actor ActorId
    UniqueResource actor
 Factory
    resource ResourceId
    create   OutboxItemId
    UniqueFactory       resource
    UniqueFactoryCreate create
 Group
    actor    ActorId
    resource ResourceId
    create   OutboxItemId
    UniqueGroupActor  actor
    UniqueGroupCreate create
 Project
    actor    ActorId
    resource ResourceId
    create   OutboxItemId
    UniqueProjectActor  actor
    UniqueProjectCreate create
 Deck
    actor      ActorId
    resource   ResourceId
    komponent  KomponentId
    workflow   WorkflowId
    nextTicket Int
    wiki       RepoId        Maybe
    create     OutboxItemId
    UniqueDeckActor  actor
    UniqueDeckCreate create
 Loom
    nextTicket Int
    actor      ActorId
    resource   ResourceId
    komponent  KomponentId
    repo       RepoId
    create     OutboxItemId
    UniqueLoomActor  actor
    UniqueLoomRepo   repo
    UniqueLoomCreate create
 Repo
    vcs        VersionControlSystem
    project    DeckId               Maybe
    mainBranch Text
    actor      ActorId
    resource   ResourceId
    komponent  KomponentId
    create     OutboxItemId
    loom       LoomId               Maybe
    UniqueRepoActor  actor
    UniqueRepoCreate create
--- a/src/Control/Concurrent/Actor.hs
+++ b/src/Control/Concurrent/Actor.hs
@ -486,9 +486,10 @@ hSendTo
    :: ( Actor a
       , Eq (ActorKey a), Hashable (ActorKey a)
       )
-    => (TVar (ActorRefMap a), (HashSet (ActorKey a), ActorMessage a))
+    => (TVar (ActorRefMap a), Maybe (HashSet (ActorKey a), ActorMessage a))
    -> IO ()
-hSendTo (tvar, (recips, msg)) = do
+hSendTo (_   , Nothing)            = pure ()
 hSendTo (tvar, Just (recips, msg)) = do
    allActors <- readTVarIO tvar
    for_ (HM.intersection allActors (HS.toMap recips)) $
        \ actor -> sendIO' actor msg
@ -497,7 +498,7 @@ data HSendTo = HSendTo
 instance
    ( Actor a
    , Eq (ActorKey a), Hashable (ActorKey a)
-    , i ~ (TVar (ActorRefMap a), (HashSet (ActorKey a), ActorMessage a))
+    , i ~ (TVar (ActorRefMap a), Maybe (HashSet (ActorKey a), ActorMessage a))
    ) =>
    H.ApplyAB HSendTo i (IO ()) where
        applyAB _ a = hSendTo a
@ -509,7 +510,7 @@ type instance Eval (B_ a) =
    )
 data Set_ :: Type -> Exp Type
-type instance Eval (Set_ a) = (HashSet (ActorKey a), ActorMessage a)
+type instance Eval (Set_ a) = Maybe (HashSet (ActorKey a), ActorMessage a)
 data Pair__ :: Type -> Exp Type
 type instance Eval (Pair__ a) = (Eval (Item_ a), Eval (Set_ a))
--- a/src/Vervis/API.hs
+++ b/src/Vervis/API.hs
@ -147,7 +147,7 @@ handleViaActor personID maybeCap localRecips remoteRecips fwdHosts action = do
    let maybeCap' = first (\ (byKey, _, i) -> (byKey, i)) <$> maybeCap
        msg = ClientMsg maybeCap' localRecips remoteRecips fwdHosts action
    maybeResult <-
-        liftIO $ callIO theater personID (MsgP $ Right msg)
+        liftIO $ callIO theater personID (PersonMsgClient msg)
    itemText <-
        case maybeResult of
            Nothing -> error "Person not found in theater"
@ -1150,7 +1150,7 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips
    insertLoom now name msummary obiidCreate repoID = do
        actor@(Entity actorID _) <-
-            insertActor now name (fromMaybe "" msummary) (Just $ personActor personUser)
+            insertActor now name (fromMaybe "" msummary) $ Left (error "insertLoom1", error "insertLoom2", obiidCreate)
        resourceID <- insert $ Resource actorID
        komponentID <- insert $ Komponent resourceID
        loomID <- insert Loom
@ -1159,7 +1159,7 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips
            , loomResource   = resourceID
            , loomKomponent  = komponentID
            , loomRepo       = repoID
-            , loomCreate     = obiidCreate
+            --, loomCreate     = obiidCreate
            }
        return (loomID, resourceID, actor)
@ -1185,7 +1185,7 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips
            repo = encodeRouteHome $ RepoR repoHash
            specific = CreateActivity Create
                { createObject   = CreatePatchTracker ptdetail (repo :| []) (Just (hLocal, ptlocal))
-                , createTarget   = Nothing
+                , createOrigin   = Nothing
                }
        return action { actionSpecific = specific }
@ -1395,7 +1395,7 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r
    insertRepo now name msummary createID = do
        actor@(Entity actorID _) <-
-            insertActor now name (fromMaybe "" msummary) (Just $ personActor personUser)
+            insertActor now name (fromMaybe "" msummary) $ Left (error "insertRepo1", error "insertRepo2", createID)
        resourceID <- insert $ Resource actorID
        komponentID <- insert $ Komponent resourceID
        repoID <- insert Repo
@ -1405,7 +1405,7 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r
            , repoActor      = actorID
            , repoResource   = resourceID
            , repoKomponent  = komponentID
-            , repoCreate     = createID
+            --, repoCreate     = createID
            , repoLoom       = Nothing
            }
        return (repoID, resourceID, actor)
@ -1430,7 +1430,7 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r
                }
            specific = CreateActivity Create
                { createObject = CreateRepository rdetail vcs (Just (hLocal, rlocal))
-                , createTarget = Nothing
+                , createOrigin = Nothing
                }
        return action { actionSpecific = specific }
--- a/src/Vervis/Actor.hs
+++ b/src/Vervis/Actor.hs
@ -506,12 +506,17 @@ instance Actor Person where
    type ActorStage   Person = Staje
    type ActorKey     Person = PersonId
    type ActorReturn  Person = Either Text Text
-    data ActorMessage Person = MsgP (Either Verse ClientMsg)
+    data ActorMessage Person
        = PersonMsgVerse Verse
        | PersonMsgClient ClientMsg
        | PersonMsgInit
 instance Actor Deck where
    type ActorStage   Deck = Staje
    type ActorKey     Deck = DeckId
    type ActorReturn  Deck = Either Text Text
-    data ActorMessage Deck = MsgD Verse
+    data ActorMessage Deck
        = DeckMsgVerse Verse
        | DeckMsgInit (Either (LocalActorBy Key, ActorId, OutboxItemId) (RemoteAuthor, LocalURI))
 instance Actor Loom where
    type ActorStage   Loom = Staje
    type ActorKey     Loom = LoomId
@ -526,33 +531,40 @@ instance Actor Project where
    type ActorStage   Project = Staje
    type ActorKey     Project = ProjectId
    type ActorReturn  Project = Either Text Text
-    data ActorMessage Project = MsgJ Verse
+    data ActorMessage Project
        = ProjectMsgVerse Verse
        | ProjectMsgInit (Either (LocalActorBy Key, ActorId, OutboxItemId) (RemoteAuthor, LocalURI))
 instance Actor Group where
    type ActorStage   Group = Staje
    type ActorKey     Group = GroupId
    type ActorReturn  Group = Either Text Text
-    data ActorMessage Group = MsgG Verse
+    data ActorMessage Group
        = TeamMsgVerse Verse
        | TeamMsgInit (Either (LocalActorBy Key, ActorId, OutboxItemId) (RemoteAuthor, LocalURI))
 instance Actor Factory where
    type ActorStage   Factory = Staje
    type ActorKey     Factory = FactoryId
    type ActorReturn  Factory = Either Text Text
-    data ActorMessage Factory = MsgF Verse
+    data ActorMessage Factory
        = FactoryMsgVerse Verse
        | FactoryMsgVerified PersonId
 instance VervisActor Person where
-    actorVerse = MsgP . Left
+    actorVerse = PersonMsgVerse
-    toVerse (MsgP e) =
+    toVerse (PersonMsgVerse v) = Just v
-        case e of
+    toVerse _                  = Nothing
            Left v -> Just v
            Right _ -> Nothing
 instance VervisActor Project where
-    actorVerse = MsgJ
+    actorVerse = ProjectMsgVerse
-    toVerse (MsgJ v) = Just v
+    toVerse (ProjectMsgVerse v) = Just v
    toVerse _                   = Nothing
 instance VervisActor Group where
-    actorVerse = MsgG
+    actorVerse = TeamMsgVerse
-    toVerse (MsgG v) = Just v
+    toVerse (TeamMsgVerse v) = Just v
    toVerse _                = Nothing
 instance VervisActor Deck where
-    actorVerse = MsgD
+    actorVerse = DeckMsgVerse
-    toVerse (MsgD v) = Just v
+    toVerse (DeckMsgVerse v) = Just v
    toVerse _                = Nothing
 instance VervisActor Loom where
    actorVerse = MsgL
    toVerse (MsgL v) = Just v
@ -563,8 +575,9 @@ instance VervisActor Repo where
            Left v -> Just v
            Right _ -> Nothing
 instance VervisActor Factory where
-    actorVerse = MsgF
+    actorVerse = FactoryMsgVerse
-    toVerse (MsgF v) = Just v
+    toVerse (FactoryMsgVerse v) = Just v
    toVerse _                   = Nothing
 instance Stage Staje where
    data StageEnv Staje = forall y. (Typeable y, Yesod y) => Env
@ -594,13 +607,17 @@ instance Stage Staje where
    type StageActors Staje = [Person, Project, Group, Deck, Loom, Repo, Factory]
 instance Message (ActorMessage Person) where
-    summarize (MsgP (Left verse)) = summarizeVerse verse
+    summarize (PersonMsgVerse verse) = summarizeVerse verse
-    summarize (MsgP (Right _)) = "ClientMsg"
+    summarize (PersonMsgClient _)    = "PersonMsgClient"
-    refer (MsgP (Left verse)) = referVerse verse
+    summarize PersonMsgInit          = "PersonMsgInit"
-    refer (MsgP (Right _)) = "ClientMsg"
+    refer (PersonMsgVerse verse) = referVerse verse
    refer (PersonMsgClient _)    = "PersonMsgClient"
    refer PersonMsgInit          = "PersonMsgInit"
 instance Message (ActorMessage Deck) where
-    summarize (MsgD verse) = summarizeVerse verse
+    summarize (DeckMsgVerse verse) = summarizeVerse verse
-    refer (MsgD verse) = referVerse verse
+    summarize (DeckMsgInit _)      = "DeckMsgInit"
    refer (DeckMsgVerse verse) = referVerse verse
    refer (DeckMsgInit _)      = "DeckMsgInit"
 instance Message (ActorMessage Loom) where
    summarize (MsgL verse) = summarizeVerse verse
    refer (MsgL verse) = referVerse verse
@ -610,14 +627,20 @@ instance Message (ActorMessage Repo) where
    refer (MsgR (Left verse)) = referVerse verse
    refer (MsgR (Right _)) = "WaitPushCompletion"
 instance Message (ActorMessage Project) where
-    summarize (MsgJ verse) = summarizeVerse verse
+    summarize (ProjectMsgVerse verse) = summarizeVerse verse
-    refer (MsgJ verse) = referVerse verse
+    summarize (ProjectMsgInit _)      = "ProjectMsgInit"
    refer (ProjectMsgVerse verse) = referVerse verse
    refer (ProjectMsgInit _)      = "ProjectMsgInit"
 instance Message (ActorMessage Group) where
-    summarize (MsgG verse) = summarizeVerse verse
+    summarize (TeamMsgVerse verse) = summarizeVerse verse
-    refer (MsgG verse) = referVerse verse
+    summarize (TeamMsgInit _)      = "TeamMsgInit"
    refer (TeamMsgVerse verse) = referVerse verse
    refer (TeamMsgInit _)      = "TeamMsgInit"
 instance Message (ActorMessage Factory) where
-    summarize (MsgF verse) = summarizeVerse verse
+    summarize (FactoryMsgVerse verse) = summarizeVerse verse
-    refer (MsgF verse) = referVerse verse
+    summarize (FactoryMsgVerified _)  = "FactoryMsgVerified"
    refer (FactoryMsgVerse verse) = referVerse verse
    refer (FactoryMsgVerified _)  = "FactoryMsgVerified"
 type YesodRender y = Route y -> [(Text, Text)] -> Text
@ -935,13 +958,13 @@ sendToLocalActors authorAndId body requireOwner mauthor maidAuthor recips = do
            partitionByActor liveRecips
        verse = Verse authorAndId' body
    sendMany $
-        (liveRecipsP, actorVerse verse) `H.HCons`
+        (Just (liveRecipsP, actorVerse verse)) `H.HCons`
-        (liveRecipsJ, actorVerse verse) `H.HCons`
+        (Just (liveRecipsJ, actorVerse verse)) `H.HCons`
-        (liveRecipsG, actorVerse verse) `H.HCons`
+        (Just (liveRecipsG, actorVerse verse)) `H.HCons`
-        (liveRecipsD, actorVerse verse) `H.HCons`
+        (Just (liveRecipsD, actorVerse verse)) `H.HCons`
-        (liveRecipsL, actorVerse verse) `H.HCons`
+        (Just (liveRecipsL, actorVerse verse)) `H.HCons`
-        (liveRecipsR, actorVerse verse) `H.HCons`
+        (Just (liveRecipsR, actorVerse verse)) `H.HCons`
-        (liveRecipsF, actorVerse verse) `H.HCons` H.HNil
+        (Just (liveRecipsF, actorVerse verse)) `H.HCons` H.HNil
    -- Return remote followers, to whom we need to deliver via HTTP
    return remoteFollowers
--- a/src/Vervis/Actor/Common.hs
+++ b/src/Vervis/Actor/Common.hs
@ -19,12 +19,14 @@
 module Vervis.Actor.Common
    ( actorFollow
    , actorFollow'
    , topicAccept
    , topicReject
    , componentInvite
    , componentRemove
    , topicJoin
    , topicCreateMe
    , topicInit
    , componentGrant
    , componentAdd
    , componentRevoke
@ -86,11 +88,13 @@ import Vervis.Data.Actor
 import Vervis.Data.Collab
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Persist.Actor
 import Vervis.Persist.Collab
 import Vervis.Persist.Discussion
 import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience, localActorFollowers, renderLocalActor)
 import Vervis.RemoteActorStore
 import Vervis.Settings
 import Vervis.Ticket
 import Vervis.Web.Collab
@ -113,7 +117,24 @@ actorFollow
    -> Verse
    -> AP.Follow URIMode
    -> ActE (Text, Act (), Next)
-actorFollow parseFollowee grabActor unread getFollowee getSieve makeLocalActor makeAudience now recipID (Verse authorIdMsig body) (AP.Follow uObject _ hide) = do
+actorFollow parseFollowee grabActor =
    actorFollow' parseFollowee (pure . grabActor)
 actorFollow'
    :: (PersistRecordBackend r SqlBackend, ToBackendKey SqlBackend r)
    => (Route App -> ActE a)
    -> (r -> ActDB ActorId)
    -> Bool
    -> (Actor -> a -> ActDBE FollowerSetId)
    -> (a -> ActDB RecipientRoutes)
    -> (forall f. f r -> LocalActorBy f)
    -> (a -> Act [Aud URIMode])
    -> UTCTime
    -> Key r
    -> Verse
    -> AP.Follow URIMode
    -> ActE (Text, Act (), Next)
 actorFollow' parseFollowee grabActor unread getFollowee getSieve makeLocalActor makeAudience now recipID (Verse authorIdMsig body) (AP.Follow uObject _ hide) = do
    -- Check input
    followee <- nameExceptT "Follow object" $ do
@ -132,7 +153,7 @@ actorFollow parseFollowee grabActor unread getFollowee getSieve makeLocalActor m
        -- Find me in DB
        recip <- lift $ getJust recipID
-        let recipActorID = grabActor recip
+        recipActorID <- lift $ grabActor recip
        recipActor <- lift $ getJust recipActorID
        -- Insert the Follow to my inbox
@ -2248,82 +2269,148 @@ topicJoin grabResource topicResource now topicKey (Verse authorIdMsig body) join
                recipID <- insert $ CollabRecipRemote collabID authorID
                insert_ $ CollabRecipRemoteJoin recipID fulfillsID joinID
 -- Meaning: Someone has created an actor with my ID URI
 -- Behavior:
 --     * Verify I have no Collab records, implying just-been-created state
 --     * Verify my (local!) creator and the Create sender are the same actor
 --     * Possibly: Verify the creator is in the can-create-factories list
 --     * Possibly:
 --          If I'm the first in my table and listed as resident (or no
 --          residents are listed),
 --          send out develop-Grants (and create Collab records) to all verified
 --          local Persons
 --     * Create an admin Collab record in DB
 --     * Send an admin Grant to the creator
 topicCreateMe
    :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
-    => (topic -> ResourceId)
+    => Bool
    -> Bool
    -> (topic -> ResourceId)
    -> (forall f. f topic -> LocalResourceBy f)
    -> UTCTime
    -> Key topic
    -> Verse
    -> ActE (Text, Act (), Next)
-topicCreateMe grabResource topicResource now recipKey (Verse authorIdMsig body) = do
+topicCreateMe checkCan sendGrants grabResource meToResource now meID (Verse authorIdMsig body) = do
    maybeNew <- withDBExcept $ do
        -- Grab me from DB
-        resourceID <- lift $ grabResource <$> getJust recipKey
+        resourceMeID <- lift $ grabResource <$> getJust meID
-        Resource recipActorID <- lift $ getJust resourceID
+        Resource actorMeID <- lift $ getJust resourceMeID
-        recipActor <- lift $ getJust recipActorID
+        actorMe <- lift $ getJust actorMeID
-        -- Verify I'm in the initial just-been-created state
+        -- Verify I'm in initial state
-        creatorActorID <-
+        creatorActorID <- do
-            fromMaybeE
+            create <-
-                (actorJustCreatedBy recipActor)
+                lift $
-                "I already sent the initial Grant, why am I receiving this Create?"
+                requireEitherAlt
                    (getValBy $ UniqueActorCreateLocalActor actorMeID)
                    (getValBy $ UniqueActorCreateRemoteActor actorMeID)
                    "Neither local nor remote"
                    "Both local and remote"
            case create of
                Left (ActorCreateLocal _ createID) -> do
                    OutboxItem outboxID _ _ <- lift $ getJust createID
                    mk <- lift $ getKeyBy $ UniqueActorOutbox outboxID
                    fromMaybeE mk "Creator actor not found"
                Right _ -> error "topicCreateMe used on a remotely-created actor"
        creatorPersonID <- do
            mp <- lift $ getKeyBy $ UniquePersonActor creatorActorID
            fromMaybeE mp "Granting access to local non-Person actors isn't suppported currently"
        existingCollabIDs <-
-            lift $ selectList [CollabTopic ==. resourceID] []
+            lift $ selectList [CollabTopic ==. resourceMeID] []
        unless (null existingCollabIDs) $
-            error "Just-been-created but I somehow already have Collabs"
+            throwE "I already have Collab records"
        -- Verify the Create author is my creator indeed
        case authorIdMsig of
            Left (_, actorID, _) | actorID == creatorActorID -> pure ()
            _ -> throwE "Create author isn't why I believe my creator is - is this Create fake?"
-        maybeCreateDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
+        -- Verify creator is in can-create-factories list
        when checkCan $ do
            u <- lift $ personUsername <$> getJust creatorPersonID
            cans <- asksEnv $ appCanCreateFactories . envSettings
            unless (u `elem` map text2username cans) $
                throwE "Creator person isn't in can-create-factories list"
        maybeCreateDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorMe) False
        lift $ for maybeCreateDB $ \ (inboxItemID, _createDB) -> do
-            -- Create a Collab record and exit just-been-created state
+            -- Create a Collab record
-            grantID <- insertEmptyOutboxItem' (actorOutbox recipActor) now
+            grantID <- insertEmptyOutboxItem' (actorOutbox actorMe) now
-            insertCollab resourceID creatorPersonID grantID
+            insertCollab resourceMeID creatorPersonID grantID
            update creatorActorID [ActorJustCreatedBy =. Nothing]
            -- Prepare a Grant activity and insert to my outbox
            grant@(actionGrant, _, _, _) <- lift prepareGrant
-            let recipByKey = resourceToActor $ topicResource recipKey
+            let recipByKey = resourceToActor $ meToResource meID
            _luGrant <- updateOutboxItem' recipByKey grantID actionGrant
-            return (recipActorID, grantID, grant, inboxItemID)
+            writes <-
                if sendGrants
                    then do
                        residents <- asksEnv $ appResidentFactories . envSettings
                        meHash <- encodeKeyHashid meID
                        let meHashText = keyHashidText meHash
                        ids <- selectKeysList [] []
                        let meResident =
                                null residents || meHashText `elem` residents
                        if meResident && ids == [meID]
                            then do
                                ps <- selectList [PersonId !=. creatorPersonID, PersonVerified ==. True] []
                                for ps $ \ p@(Entity personID _) -> do
                                    writeID <- insertEmptyOutboxItem' (actorOutbox actorMe) now
                                    insertResidentCollab resourceMeID personID writeID
                                    write@(actionWrite, _, _, _) <- prepareResidentGrant p
                                    let recipByKey = resourceToActor $ meToResource meID
                                    _luWrite <- updateOutboxItem' recipByKey writeID actionWrite
                                    return (writeID, write)
                            else pure []
                    else pure []
            return (actorMeID, grantID, grant, writes, inboxItemID)
    case maybeNew of
        Nothing -> done "I already have this activity in my inbox"
-        Just (recipActorID, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant), inboxItemID) -> do
+        Just (actorMeID, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant), writes, inboxItemID) -> do
-            let recipByID = resourceToActor $ topicResource recipKey
+            let recipByID = resourceToActor $ meToResource meID
-            lift $ sendActivity
+            lift $ do
-                recipByID recipActorID localRecipsGrant
+                sendActivity
                    recipByID actorMeID localRecipsGrant
                    remoteRecipsGrant fwdHostsGrant grantID actionGrant
-            doneDB inboxItemID "Created a Collab record and published a Grant"
+                for_ writes $ \ (writeID, (actionWrite, localRecipsWrite, remoteRecipsWrite, fwdHostsWrite)) ->
                    sendActivity
                        recipByID actorMeID localRecipsWrite
                        remoteRecipsWrite fwdHostsWrite writeID actionWrite
            doneDB inboxItemID "Created a Collab record and published a Grant, possibly sent write-Grants"
    where
-    insertCollab resourceID personID grantID = do
+    insertCollab resourceMeID personID grantID = do
-        collabID <- insert $ Collab AP.RoleAdmin resourceID
+        collabID <- insert $ Collab AP.RoleAdmin resourceMeID
        insert_ $ CollabEnable collabID grantID
        insert_ $ CollabRecipLocal collabID personID
        insert_ $ CollabFulfillsLocalTopicCreation collabID
    insertResidentCollab resourceMeID personID grantID = do
        collabID <- insert $ Collab AP.RoleWrite resourceMeID
        insert_ $ CollabEnable collabID grantID
        insert_ $ CollabRecipLocal collabID personID
        insert_ $ CollabFulfillsResidentFactory collabID
    prepareGrant = do
        encodeRouteHome <- getEncodeRouteHome
        encodeRouteLocal <- getEncodeRouteLocal
        audCreator <- makeAudSenderOnly authorIdMsig
-        recipHash <- encodeKeyHashid recipKey
+        recipHash <- encodeKeyHashid meID
        uCreator <- getActorURI authorIdMsig
        uCreate <- getActivityURI authorIdMsig
-        let topicByHash = resourceToActor $ topicResource recipHash
+        let topicByHash = resourceToActor $ meToResource recipHash
            audience =
                let audTopic = AudLocal [] [localActorFollowers topicByHash]
                in  [audCreator, audTopic]
@ -2352,6 +2439,167 @@ topicCreateMe grabResource topicResource now recipKey (Verse authorIdMsig body)
        return (action, recipientSet, remoteActors, fwdHosts)
    prepareResidentGrant (Entity personID person) = do
        encodeRouteHome <- getEncodeRouteHome
        encodeRouteLocal <- getEncodeRouteLocal
        personHash <- encodeKeyHashid personID
        let audPerson = AudLocal [LocalActorPerson personHash] []
        meHash <- encodeKeyHashid meID
        uCreate <- do
            selfCreateID <- do
                mc <- getValBy $ UniqueActorCreateLocalActor $ personActor person
                case mc of
                    Nothing -> error "Person doesn't have an ActorCreateLocal record"
                    Just c -> pure $ actorCreateLocalCreate c
            createHash <- encodeKeyHashid selfCreateID
            return $ encodeRouteHome $ PersonOutboxItemR personHash createHash
        let topicByHash = resourceToActor $ meToResource meHash
            audience =
                let audTopic = AudLocal [] [localActorFollowers topicByHash]
                in  [audPerson, audTopic]
            (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   = [uCreate]
                , AP.actionSpecific   = AP.GrantActivity AP.Grant
                    { AP.grantObject    = AP.RXRole AP.RoleWrite
                    , AP.grantContext   =
                        encodeRouteHome $ renderLocalActor topicByHash
                    , AP.grantTarget    = encodeRouteHome $ PersonR personHash
                    , AP.grantResult    = Nothing
                    , AP.grantStart     = Just now
                    , AP.grantEnd       = Nothing
                    , AP.grantAllows    = AP.Invoke
                    , AP.grantDelegates = Nothing
                    }
                }
        return (action, recipientSet, remoteActors, fwdHosts)
 -- Meaning: I've just been created
 -- Behavior:
 --     * Verify my creator and the Create sender are the same actor
 --     * Create an admin Collab record in DB
 --     * Send an admin Grant to the creator
 topicInit
    :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
    => (topic -> ActDB ResourceId)
    -> (forall f. f topic -> LocalResourceBy f)
    -> UTCTime
    -> Key topic
    -> Either (LocalActorBy Key, ActorId, OutboxItemId) (RemoteAuthor, LocalURI)
    -> ActE (Text, Act (), Next)
 topicInit grabResource meToResource now meID creator = do
    (actorMeID, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) <- withDBExcept $ do
        -- Grab me from DB
        resourceMeID <- lift $ grabResource =<< getJust meID
        Resource actorMeID <- lift $ getJust resourceMeID
        actorMe <- lift $ getJust actorMeID
        -- Verify I don't have any Collab records
        collabIDs <- lift $ selectKeysList [CollabTopic ==. resourceMeID] []
        unless (null collabIDs) $
            throwE "I already have Collab records"
        -- Verify my creator in DB and the one passed to me are the same actor
        create <-
            lift $
            requireEitherAlt
                (getValBy $ UniqueActorCreateLocalActor actorMeID)
                (getValBy $ UniqueActorCreateRemoteActor actorMeID)
                "Neither local nor remote"
                "Both local and remote"
        let create' =
                bimap actorCreateLocalCreate actorCreateRemoteSender create
            creator' =
                bimap (view _3) (remoteAuthorId . fst) creator
        unless (create' == creator') $
            throwE "Creator in DB and in argument aren't the same"
        -- If creator is local, verify it's a Person, because the DB schema
        -- currently allows only Person to be the recipient of a Collab
        let verifyIsPerson = \case
                LocalActorPerson p -> pure p
                _ -> throwE "Local creator isn't a Person"
        creatorPerson <-
            traverseOf _Left (traverseOf _1 verifyIsPerson) creator
        -- Create a Collab record
        grantID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now
        lift $ insertCollab resourceMeID creatorPerson grantID
        -- Prepare a Grant activity and insert to my outbox
        grant@(actionGrant, _, _, _) <- lift $ lift prepareGrant
        let recipByKey = resourceToActor $ meToResource meID
        _luGrant <- lift $ updateOutboxItem' recipByKey grantID actionGrant
        return (actorMeID, grantID, grant)
    let recipByID = resourceToActor $ meToResource meID
    lift $ sendActivity
        recipByID actorMeID localRecipsGrant
        remoteRecipsGrant fwdHostsGrant grantID actionGrant
    done "Created a Collab record and published a Grant"
    where
    insertCollab resourceMeID creatorPerson grantID = do
        collabID <- insert $ Collab AP.RoleAdmin resourceMeID
        insert_ $ CollabEnable collabID grantID
        case creatorPerson of
            Left (personID, _, _) ->
                insert_ $ CollabRecipLocal collabID personID
            Right (author, _) ->
                insert_ $ CollabRecipRemote collabID (remoteAuthorId author)
        insert_ $ CollabFulfillsLocalTopicCreation collabID
    prepareGrant = do
        encodeRouteHome <- getEncodeRouteHome
        encodeRouteLocal <- getEncodeRouteLocal
        let creatorMsig = second (\ (ra, lu) -> (ra, lu, Nothing)) creator
        audCreator <- makeAudSenderOnly creatorMsig
        meHash <- encodeKeyHashid meID
        uCreator <- getActorURI creatorMsig
        uCreate <- getActivityURI creatorMsig
        let meActorHash = resourceToActor $ meToResource meHash
            audience =
                let audMe = AudLocal [] [localActorFollowers meActorHash]
                in  [audCreator, audMe]
            (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   = [uCreate]
                , AP.actionSpecific   = AP.GrantActivity AP.Grant
                    { AP.grantObject    = AP.RXRole AP.RoleAdmin
                    , AP.grantContext   =
                        encodeRouteHome $ renderLocalActor meActorHash
                    , AP.grantTarget    = uCreator
                    , 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 is granting access-to-some-resource to another actor
 -- Behavior:
 --      * If I approved an Add-to-project where I'm the component, and the
--- a/src/Vervis/Actor/Deck.hs
+++ b/src/Vervis/Actor/Deck.hs
@ -107,42 +107,6 @@ deckAdd
    -> ActE (Text, Act (), Next)
 deckAdd = componentAdd deckKomponent ComponentDeck
 -- Meaning: Someone has created a ticket tracker with my ID URI
 -- Behavior:
 --     * Verify I'm in a just-been-created state
 --     * Verify my creator and the Create sender are the same actor
 --     * Create an admin Collab record in DB
 --     * Send an admin Grant to the creator
 --     * Get out of the just-been-created state
 deckCreateMe
    :: UTCTime
    -> DeckId
    -> Verse
    -> ActE (Text, Act (), Next)
 deckCreateMe = topicCreateMe deckResource LocalResourceDeck
 deckCreate
    :: UTCTime
    -> DeckId
    -> Verse
    -> AP.Create URIMode
    -> ActE (Text, Act (), Next)
 deckCreate now deckID verse (AP.Create obj _muTarget) =
    case obj of
        AP.CreateTicketTracker _ mlocal -> do
            (h, local) <- fromMaybeE mlocal "No tracker id provided"
            let luTracker = AP.actorId local
            uMe <- do
                deckHash <- encodeKeyHashid deckID
                encodeRouteHome <- getEncodeRouteHome
                return $ encodeRouteHome $ DeckR deckHash
            unless (uMe == ObjURI h luTracker) $
                throwE "The created tracker id isn't me"
            deckCreateMe now deckID verse
        _ -> throwE "Unsupported Create object for Deck"
 -- Meaning: An actor A is offering a ticket or a ticket dependency
 -- Behavior:
 --      * Verify I'm the target
@ -822,11 +786,10 @@ deckUndo now recipDeckID (Verse authorIdMsig body) (AP.Undo uObject) = do
 ------------------------------------------------------------------------------
 deckBehavior :: UTCTime -> DeckId -> ActorMessage Deck -> ActE (Text, Act (), Next)
-deckBehavior now deckID (MsgD verse@(Verse _authorIdMsig body)) =
+deckBehavior now deckID (DeckMsgVerse verse@(Verse _authorIdMsig body)) =
    case AP.activitySpecific $ actbActivity body of
        AP.AcceptActivity accept -> deckAccept now deckID verse accept
        AP.AddActivity add       -> deckAdd now deckID verse add
        AP.CreateActivity create -> deckCreate now deckID verse create
        AP.FollowActivity follow -> deckFollow now deckID verse follow
        AP.GrantActivity grant   -> deckGrant now deckID verse grant
        AP.InviteActivity invite -> deckInvite now deckID verse invite
@ -838,6 +801,9 @@ deckBehavior now deckID (MsgD verse@(Verse _authorIdMsig body)) =
        AP.RevokeActivity revoke -> deckRevoke now deckID verse revoke
        AP.UndoActivity undo     -> deckUndo now deckID verse undo
        _ -> throwE "Unsupported activity type for Deck"
 deckBehavior now deckID (DeckMsgInit creator) =
    let grabResource = fmap komponentResource . getJust . deckKomponent
    in  topicInit grabResource LocalResourceDeck now deckID creator
 instance VervisActorLaunch Deck where
    actorBehavior' now deckID ve = do
--- a/src/Vervis/Actor/Factory.hs
+++ b/src/Vervis/Actor/Factory.hs
@ -18,43 +18,451 @@ module Vervis.Actor.Factory
    )
 where
 import Control.Applicative
 import Control.Exception.Base
 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.Either
 import Data.Foldable
 import Data.List.NonEmpty (NonEmpty (..))
 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 qualified Database.Esqueleto as E
 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 Data.Either.Local
 import Database.Persist.Local
 import Vervis.Access
 import Vervis.ActivityPub
 import Vervis.Actor
 import Vervis.Actor.Common
 import Vervis.Actor.Deck
 import Vervis.Actor.Group
 import Vervis.Actor.Project
 import Vervis.Actor2
 import Vervis.Cloth
 import Vervis.Data.Actor
 import Vervis.Data.Collab
 import Vervis.Data.Discussion
 import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience, localActorFollowers, renderLocalActor)
 import Vervis.RemoteActorStore
 import Vervis.Persist.Actor
 import Vervis.Persist.Collab
 import Vervis.Persist.Discussion
 import Vervis.Settings
 import Vervis.Ticket
 import Vervis.Web.Collab
 data NewActor = NADeck | NAProject | NATeam
 factoryCreateMe
    :: UTCTime
    -> FactoryId
    -> Verse
    -> ActE (Text, Act (), Next)
 factoryCreateMe = topicCreateMe True True factoryResource LocalResourceFactory
 -- Meaning: An actor is asking me to create a new actor
 -- Behavior:
 --      * Create a record on DB
 --      * Launch the actor
 --      * Forward the Create to followers
 --      * Send Accept on the Create, with result being the new actor's URI
 factoryCreateNew
    :: NewActor
    -> UTCTime
    -> FactoryId
    -> Verse
    -> AP.ActorDetail
    -> ActE (Text, Act (), Next)
 factoryCreateNew new now factoryMeID (Verse authorIdMsig body) detail = do
    -- Check input
    (name, msummary) <- parseDetail detail
    -- Verify that a capability is provided
    uCap <- do
        let muCap = AP.activityCapability $ actbActivity body
        fromMaybeE muCap "No capability provided"
    -- Verify the sender is authorized by me to create actors
    verifyCapability''
        uCap
        authorIdMsig
        (LocalResourceFactory factoryMeID)
        AP.RoleWrite
    maybeNew <- withDBExcept $ do
        -- Grab me from DB
        factoryMe <- lift $ getJust factoryMeID
        let resourceMeID = factoryResource factoryMe
        Resource actorMeID <- lift $ getJust resourceMeID
        actorMe <- lift $ getJust actorMeID
        -- Insert the Create to my inbox
        mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorMe) False
        for mractid $ \ (inboxItemID, createDB) -> do
            -- Insert new actor to DB
            (newLocalResource, launchNewActor, sendInit, newResourceID) <-
                insertNewActor now name msummary createDB actorMeID
            -- Prepare forwarding the Create to my followers
            factoryHash <- encodeKeyHashid factoryMeID
            let sieve =
                    makeRecipientSet
                        []
                        [LocalStageFactoryFollowers factoryHash]
            -- Prepare an Accept activity and insert to my outbox
            acceptID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now
            accept@(actionAccept, _, _, _) <- lift $ prepareAccept newLocalResource
            let recipByKey = LocalActorFactory factoryMeID
            _luAccept <- lift $ updateOutboxItem' recipByKey acceptID actionAccept
            return (actorMeID, sieve, acceptID, accept, inboxItemID, launchNewActor, sendInit)
    case maybeNew of
        Nothing -> done "I already have this activity in my inbox"
        Just (actorMeID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID, launchNewActor, sendInit) -> do
            -- Spawn new actor
            success <- lift launchNewActor
            unless success $
                error "Failed to spawn new actor, somehow ID already in Theater"
            -- Forward Create to my followers
            forwardActivity
                authorIdMsig body (LocalActorFactory factoryMeID) actorMeID sieve
            -- Send Accept back to sender
            lift $ sendActivity
                (LocalActorFactory factoryMeID) actorMeID localRecipsAccept
                remoteRecipsAccept fwdHostsAccept acceptID actionAccept
            -- Send message to new actor, for it to self-initialize
            there <- lift sendInit
            unless there $
                error "Failed to find new actor, somehow ID not in Theater"
            doneDB inboxItemID "Inserted and launched new actor in just-been-created mode, and sent my Accept"
    where
    naToActorType = \case
        NADeck -> AP.ActorTypeTicketTracker
        NAProject -> AP.ActorTypeProject
        NATeam -> AP.ActorTypeTeam
    parseDetail (AP.ActorDetail typ muser mname msummary) = do
        unless (typ == naToActorType new) $
            error "factoryCreate: Create object not the expected value"
        verifyNothingE muser "Can't have a username"
        name <- fromMaybeE mname "Doesn't specify name"
        return (name, msummary)
    findWorkflow = do
        mw <- lift $ selectFirst ([] :: [Filter Workflow]) []
        entityKey <$> fromMaybeE mw "Can't find a workflow"
    insertNewActor now name msummary createDB actorMeID = do
        wid <- findWorkflow
        Entity aid a <- lift $ insertActor now name (fromMaybe "" msummary) createDB
        rid <- lift $ insert $ Resource aid
        let authorId = second (\ (ra, lu, _) -> (ra, lu)) authorIdMsig
        (lr, launch, sendInit) <-
            lift $
            case new of
                NADeck -> do
                    kid <- insert $ Komponent rid
                    did <- insert Deck
                        { deckActor      = aid
                        , deckResource   = rid
                        , deckKomponent  = kid
                        , deckWorkflow   = wid
                        , deckNextTicket = 1
                        , deckWiki       = Nothing
                        }
                    return
                        ( LocalResourceDeck did
                        , launchActor did
                        , send did $ DeckMsgInit authorId
                        )
                NAProject -> do
                    jid <- insert Project
                        { projectActor      = aid
                        , projectResource   = rid
                        }
                    return
                        ( LocalResourceProject jid
                        , launchActor jid
                        , send jid $ ProjectMsgInit authorId
                        )
                NATeam -> do
                    gid <- insert Group
                        { groupActor      = aid
                        , groupResource   = rid
                        }
                    return
                        ( LocalResourceGroup gid
                        , launchActor gid
                        , send gid $ TeamMsgInit authorId
                        )
        return (lr, launch, sendInit, rid)
    prepareAccept newLocalResource = do
        encodeRouteHome <- getEncodeRouteHome
        encodeRouteLocal <- getEncodeRouteLocal
        factoryHash <- encodeKeyHashid factoryMeID
        newLocalActorHash <- hashLocalActor $ resourceToActor newLocalResource
        audSender <- makeAudSenderWithFollowers authorIdMsig
        let audMe = AudLocal [] [LocalStageFactoryFollowers factoryHash]
            --audNew = AudLocal [newLocalActorHash] []
        uCreate <- lift $ getActivityURI authorIdMsig
        let luNew = encodeRouteLocal $ renderLocalActor newLocalActorHash
            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audSender, audMe{-, audNew-}]
            recips = map encodeRouteHome audLocal ++ audRemote
            action = AP.Action
                { AP.actionCapability = Nothing
                , AP.actionSummary    = Nothing
                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                , AP.actionFulfills   = [uCreate]
                , AP.actionSpecific   = AP.AcceptActivity AP.Accept
                    { AP.acceptObject   = uCreate
                    , AP.acceptResult   = Just luNew
                    }
                }
        return (action, recipientSet, remoteActors, fwdHosts)
 factoryCreate
    :: UTCTime
    -> FactoryId
    -> Verse
    -> AP.Create URIMode
    -> ActE (Text, Act (), Next)
 factoryCreate now factoryID verse (AP.Create obj muOrigin) = do
    uMe <- do
        encodeRouteHome <- getEncodeRouteHome
        factoryHash <- encodeKeyHashid factoryID
        return $ encodeRouteHome $ FactoryR factoryHash
    case obj of
        AP.CreateTicketTracker detail mlocal -> do
            verifyNothingE mlocal "Object's id must not be provided"
            uOrigin <- fromMaybeE muOrigin "'origin' expected in Create-TicketTracker"
            unless (uOrigin == uMe) $
                throwE "This Create-TicketTracker isn't for me"
            factoryCreateNew NADeck now factoryID verse detail
        AP.CreateProject detail mlocal -> do
            verifyNothingE mlocal "Object's id must not be provided"
            uOrigin <- fromMaybeE muOrigin "'origin' expected in Create-Project"
            unless (uOrigin == uMe) $
                throwE "This Create-Project isn't for me"
            factoryCreateNew NAProject now factoryID verse detail
        AP.CreateTeam detail mlocal -> do
            verifyNothingE mlocal "Object's id must not be provided"
            uOrigin <- fromMaybeE muOrigin "'origin' expected in Create-Team"
            unless (uOrigin == uMe) $
                throwE "This Create-Team isn't for me"
            factoryCreateNew NATeam now factoryID verse detail
        AP.CreateFactory _ mlocal -> do
            (h, local) <- fromMaybeE mlocal "No factory id provided"
            let luFactory = AP.actorId local
            unless (uMe == ObjURI h luFactory) $
                throwE "The created factory id isn't me"
            factoryCreateMe now factoryID verse
        _ -> throwE "Unsupported Create object for Factory"
 -- Meaning: A local account just for verified
 -- Behavior:
 --      If I’m a resident, OR no-residents-listed-and-I’m-the-only-factory,
 --      send a write-Grant to new Person and insert Collab record
 factoryCheckPerson
    :: UTCTime
    -> FactoryId
    -> PersonId
    -> ActE (Text, Act (), Next)
 factoryCheckPerson now factoryMeID personID = do
    result <- withDBExcept $ do
        -- Grab me from DB
        factoryMe <- lift $ getJust factoryMeID
        let resourceMeID = factoryResource factoryMe
        Resource actorMeID <- lift $ getJust resourceMeID
        actorMe <- lift $ getJust actorMeID
        existingCollabs <-
            lift $ E.select $ E.from $ \ (collab `E.InnerJoin` recip) -> do
                E.on $ collab E.^. CollabId E.==. recip E.^. CollabRecipLocalCollab
                E.where_ $
                    collab E.^. CollabTopic E.==. E.val resourceMeID E.&&.
                    recip E.^. CollabRecipLocalPerson E.==. E.val personID
                return collab
        residents <- asksEnv $ appResidentFactories . envSettings
        factoryMeHash <- encodeKeyHashid factoryMeID
        let meHashText = keyHashidText factoryMeHash
        factoryIDs <- lift $ selectKeysList [] []
        let meResident =
                meHashText `elem` residents ||
                null residents && factoryIDs == [factoryMeID]
        if not meResident
            then pure $ Left "I'm not a resident, nothing to do"
        else if not $ null existingCollabs
            then pure $ Left "I'm a resident but already have a Collab for this person, so nothing to do"
            else lift $ Right <$> do
                p <- getJust personID
                grantID <- insertEmptyOutboxItem' (actorOutbox actorMe) now
                insertResidentCollab resourceMeID grantID
                grant@(actionGrant, _, _, _) <- prepareResidentGrant p
                let recipByKey = LocalActorFactory factoryMeID
                _luGrant <- updateOutboxItem' recipByKey grantID actionGrant
                return (actorMeID, grantID, grant)
    case result of
        Left msg -> done msg
        Right (actorMeID, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) -> do
            lift $ sendActivity
                (LocalActorFactory factoryMeID) actorMeID localRecipsGrant
                remoteRecipsGrant fwdHostsGrant grantID actionGrant
            done "Sent write-Grant to person and inserted Collab record"
    where
    insertResidentCollab resourceMeID grantID = do
        collabID <- insert $ Collab AP.RoleWrite resourceMeID
        insert_ $ CollabEnable collabID grantID
        insert_ $ CollabRecipLocal collabID personID
        insert_ $ CollabFulfillsResidentFactory collabID
    prepareResidentGrant person = do
        encodeRouteHome <- getEncodeRouteHome
        encodeRouteLocal <- getEncodeRouteLocal
        personHash <- encodeKeyHashid personID
        let audPerson = AudLocal [LocalActorPerson personHash] []
        meHash <- encodeKeyHashid factoryMeID
        uCreate <- do
            selfCreateID <- do
                mc <- getValBy $ UniqueActorCreateLocalActor $ personActor person
                case mc of
                    Nothing -> error "Person doesn't have an ActorCreateLocal record"
                    Just c -> pure $ actorCreateLocalCreate c
            createHash <- encodeKeyHashid selfCreateID
            return $ encodeRouteHome $ PersonOutboxItemR personHash createHash
        let topicByHash = LocalActorFactory meHash
            audience =
                let audTopic = AudLocal [] [localActorFollowers topicByHash]
                in  [audPerson, audTopic]
            (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   = [uCreate]
                , AP.actionSpecific   = AP.GrantActivity AP.Grant
                    { AP.grantObject    = AP.RXRole AP.RoleWrite
                    , AP.grantContext   =
                        encodeRouteHome $ renderLocalActor topicByHash
                    , AP.grantTarget    = encodeRouteHome $ PersonR personHash
                    , 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 is following someone/something
 -- Behavior:
 --      * Verify the target is me
 --      * Record the follow in DB
 --      * Publish and send an Accept to the sender and its followers
 factoryFollow
    :: UTCTime
    -> FactoryId
    -> Verse
    -> AP.Follow URIMode
    -> ActE (Text, Act (), Next)
 factoryFollow now recipFactoryID verse follow = do
    recipFactoryHash <- encodeKeyHashid recipFactoryID
    actorFollow'
        (\case
            FactoryR d | d == recipFactoryHash -> pure ()
            _ -> throwE "Asking to follow someone else"
        )
        (fmap resourceActor . getJust . factoryResource)
        False
        (\ recipFactoryActor () -> pure $ actorFollowers recipFactoryActor)
        (\ _ -> pure $ makeRecipientSet [] [])
        LocalActorFactory
        (\ _ -> pure [])
        now recipFactoryID verse follow
 factoryBehavior :: UTCTime -> FactoryId -> ActorMessage Factory -> ActE (Text, Act (), Next)
-factoryBehavior now factoryID (MsgF _verse@(Verse _authorIdMsig body)) =
+factoryBehavior now factoryID (FactoryMsgVerse verse@(Verse _authorIdMsig body)) =
    case AP.activitySpecific $ actbActivity body of
        AP.CreateActivity create -> factoryCreate now factoryID verse create
        AP.FollowActivity follow -> factoryFollow now factoryID verse follow
        _ -> throwE "Unsupported activity type for Factory"
 factoryBehavior now factoryID (FactoryMsgVerified personID) =
    factoryCheckPerson now factoryID personID
 instance VervisActorLaunch Factory where
    actorBehavior' now factoryID ve = do
--- a/src/Vervis/Actor/Group.hs
+++ b/src/Vervis/Actor/Group.hs
@ -71,7 +71,7 @@ import Vervis.Data.Discussion
 import Vervis.FedURI
 import Vervis.Foundation
-import Vervis.Model hiding (groupCreate)
+import Vervis.Model
 import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience, localActorFollowers, renderLocalActor)
 import Vervis.RemoteActorStore
 import Vervis.Persist.Actor
@ -2441,42 +2441,6 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do
            return (action, recipientSet, remoteActors, fwdHosts)
 -- Meaning: Someone has created a group with my ID URI
 -- Behavior:
 --     * Verify I'm in a just-been-created state
 --     * Verify my creator and the Create sender are the same actor
 --     * Create an admin Collab record in DB
 --     * Send an admin Grant to the creator
 --     * Get out of the just-been-created state
 groupCreateMe
    :: UTCTime
    -> GroupId
    -> Verse
    -> ActE (Text, Act (), Next)
 groupCreateMe = topicCreateMe groupResource LocalResourceGroup
 groupCreate
    :: UTCTime
    -> GroupId
    -> Verse
    -> AP.Create URIMode
    -> ActE (Text, Act (), Next)
 groupCreate now groupID verse (AP.Create obj _muTarget) =
    case obj of
        AP.CreateTeam _ mlocal -> do
            (h, local) <- fromMaybeE mlocal "No group id provided"
            let luGroup = AP.actorId local
            uMe <- do
                groupHash <- encodeKeyHashid groupID
                encodeRouteHome <- getEncodeRouteHome
                return $ encodeRouteHome $ GroupR groupHash
            unless (uMe == ObjURI h luGroup) $
                throwE "The created group id isn't me"
            groupCreateMe now groupID verse
        _ -> throwE "Unsupported Create object for Group"
 -- Meaning: An actor is following someone/something
 -- Behavior:
 --      * Verify the target is me
@ -5927,11 +5891,10 @@ groupUndo now recipGroupID (Verse authorIdMsig body) (AP.Undo uObject) = do
        return (action, recipientSet, remoteActors, fwdHosts)
 groupBehavior :: UTCTime -> GroupId -> ActorMessage Group -> ActE (Text, Act (), Next)
-groupBehavior now groupID (MsgG verse@(Verse _authorIdMsig body)) =
+groupBehavior now groupID (TeamMsgVerse verse@(Verse _authorIdMsig body)) =
    case AP.activitySpecific $ actbActivity body of
        AP.AcceptActivity accept -> groupAccept now groupID verse accept
        AP.AddActivity add       -> groupAdd now groupID verse add
        AP.CreateActivity create -> groupCreate now groupID verse create
        AP.FollowActivity follow -> groupFollow now groupID verse follow
        AP.GrantActivity grant   -> groupGrant now groupID verse grant
        AP.InviteActivity invite -> groupInvite now groupID verse invite
@ -5941,6 +5904,9 @@ groupBehavior now groupID (MsgG verse@(Verse _authorIdMsig body)) =
        AP.RevokeActivity revoke -> groupRevoke now groupID verse revoke
        AP.UndoActivity undo     -> groupUndo now groupID verse undo
        _ -> throwE "Unsupported activity type for Group"
 groupBehavior now groupID (TeamMsgInit creator) =
    let grabResource = pure . groupResource
    in  topicInit grabResource LocalResourceGroup now groupID creator
 instance VervisActorLaunch Group where
    actorBehavior' now groupID ve = do
--- a/src/Vervis/Actor/Person.hs
+++ b/src/Vervis/Actor/Person.hs
@ -72,11 +72,12 @@ import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Persist.Actor
 import Vervis.Persist.Collab
 import Vervis.Persist.Discussion
 import Vervis.Persist.Follow
-import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience)
+import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience, renderLocalActor)
 import Vervis.RemoteActorStore
 import Vervis.Ticket
@ -282,13 +283,19 @@ personUndo now recipPersonID (Verse authorIdMsig body) (AP.Undo uObject) = do
 -- 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
 --
 --      * If it's on a Create-actor-via-factory I'd sent
 --          * Insert PermitTopic*
 --          * Send a Follow on the newly created actor
 personAccept
    :: UTCTime
    -> PersonId
@ -300,6 +307,34 @@ personAccept now recipPersonID (Verse authorIdMsig body) accept = do
    -- Check input
    acceptee <- parseAccept accept
    -- Discover Accept.result, before DB access since we might use HTTP
    maybeRightResult <-
        for (AP.acceptResult accept) $ \ luResult -> lift $ runExceptT $ do
            let h = objUriAuthority $ AP.acceptObject accept
                uResult = ObjURI h luResult
            routeOrRemote <- parseFedURI uResult
            bitraverse
                (\ route -> do
                    lr <- parseLocalResourceE' route
                    resourceID <- withDBExcept $ do
                        lre <- getLocalResourceEntityE lr "Local Accept.result actor not found in DB"
                        lift $ grabLocalResourceID lre
                    return (lr, resourceID)
                )
                (\ u@(ObjURI h lu) -> do
                    instanceID <-
                        lift $ withDB $ either entityKey id <$> insertBy' (Instance h)
                    result <-
                        ExceptT $ first (T.pack . displayException) <$>
                            fetchRemoteActor' instanceID h lu
                    case result of
                        Left Nothing -> throwE "Result @id mismatch"
                        Left (Just err) -> throwE $ T.pack $ displayException err
                        Right Nothing -> throwE "Result isn't an actor"
                        Right (Just actor) -> return (u, actor)
                )
                routeOrRemote
    maybeNew <- withDBExcept $ do
        -- Grab me from DB
@ -314,26 +349,113 @@ personAccept now recipPersonID (Verse authorIdMsig body) accept = do
            accepteeDB <- MaybeT $ getActivity acceptee
            let recipActorID = personActor personRecip
-            Left <$> tryFollow recipActorID accepteeDB acceptDB <|>
+            Left . Left <$> tryFollow recipActorID accepteeDB acceptDB <|>
-                Right <$> tryInvite recipActorID accepteeDB acceptDB
+                Left . Right <$> tryInvite recipActorID accepteeDB acceptDB <|>
                Right <$> tryCreate maybeRightResult recipActorID accepteeDB acceptDB
    case maybeNew of
        Nothing -> done "I already have this activity in my inbox"
        Just (inboxItemID, result) ->
            case result of
                Nothing -> doneDB inboxItemID "Not my Follow/Invite; Just inserted to my inbox"
-                Just (Left ()) ->
+                Just (Left (Left ())) ->
                    doneDB inboxItemID "Recorded this Accept on the Follow request I sent"
-                Just (Right (actorID, sieve)) -> do
+                Just (Left (Right (actorID, sieve))) -> do
                    forwardActivity
                        authorIdMsig body (LocalActorPerson recipPersonID)
                        actorID sieve
                    doneDB inboxItemID
                        "Recorded this Accept on the Invite I've had & \
                        \forwarded to my followers"
                Just (Right Nothing) ->
                    doneDB inboxItemID "Inserted PermitTopic*, Follow/Request already exists"
                Just (Right (Just (actorMeID, followID, follow))) -> do
                    let (actionFollow, localRecipsFollow, remoteRecipsFollow, fwdHostsFollow) = follow
                    lift $ sendActivity
                        (LocalActorPerson recipPersonID) actorMeID localRecipsFollow
                        remoteRecipsFollow fwdHostsFollow followID actionFollow
                    doneDB inboxItemID "Inserted PermitTopic* & sent Follow"
    where
    tryCreate maybeRightResult actorMeID (Left (_, _, outboxItemID)) _ = do
        -- Verify Accept specifies a result
        result <- do
            r <- hoistMaybe maybeRightResult
            case r of
                Left e -> lift $ throwE e
                Right actor -> pure actor
        -- Find an admin-Permit-Fulfills-Create I have
        PermitPersonGesture permitID _ <-
            MaybeT $ lift $ getValBy $ UniquePermitPersonGestureActivity outboxItemID
        _ <- MaybeT $ lift $ getBy $ UniquePermitFulfillsTopicCreation permitID
        Permit p role <- lift $ lift $ getJust permitID
        guard $ p == recipPersonID
        guard $ role == AP.RoleAdmin
        -- Grab the Create's origin, verify it's identical to Accept sender
        AP.Doc _ act <- lift $ lift $ getActivityBody $ Left outboxItemID
        uOrigin <-
            case AP.activitySpecific act of
                AP.CreateActivity (AP.Create _ (Just u)) -> pure u
                _ -> lift $ throwE "Expected acceptee to be a Create with origin"
        uAcceptSender <- lift $ lift $ lift $ getActorURI authorIdMsig
        unless (uAcceptSender == uOrigin) $
            lift $ throwE "Accept sender isn't the Create.origin"
        -- Verify permit topic is missing
        mptl <- lift $ lift $ getBy $ UniquePermitTopicLocal permitID
        mptr <- lift $ lift $ getBy $ UniquePermitTopicRemote permitID
        unless (isNothing mptl && isNothing mptr) $
            lift $ throwE "PermitTopic* already exists in DB"
        -- Insert permit topic, the new actor
        lift $ lift $
            case result of
                Left (_, resourceID) ->
                    insert_ $ PermitTopicLocal permitID resourceID
                Right (_, Entity actorID _) ->
                    insert_ $ PermitTopicRemote permitID actorID
        lift $ lift $ do
            -- Look for an existing follow/request record in DB
            existing <-
                case result of
                    Left (_, resourceID) -> do
                        Resource actorNewID <- getJust resourceID
                        fsID <- actorFollowers <$> getJust actorNewID
                        mf <- getBy $ UniqueFollow actorMeID fsID
                        mfr <- getBy $ UniqueFollowRequest actorMeID fsID
                        return $ isJust mf || isJust mfr
                    Right (uNewActor, _) -> do
                        mf <- getBy $ UniqueFollowRemote actorMeID uNewActor
                        mfr <- getBy $ UniqueFollowRemoteRequest recipPersonID uNewActor
                        return $ isJust mf || isJust mfr
            -- If none, insert request and prepare Follow activity
            if existing
                then pure Nothing
                else Just <$> do
                    actorMe <- getJust actorMeID
                    followID <- insertEmptyOutboxItem' (actorOutbox actorMe) now
                    case result of
                        Left (_, resourceID) -> do
                            Resource actorNewID <- getJust resourceID
                            fsID <- actorFollowers <$> getJust actorNewID
                            insert_ $ FollowRequest actorMeID fsID True followID
                        Right (uNewActor, _) ->
                            insert_ $ FollowRemoteRequest recipPersonID uNewActor Nothing True followID
                    follow@(actionFollow, _, _, _) <- lift $ prepareFollow result
                    luFollow <- updateOutboxItem' (LocalActorPerson recipPersonID) followID actionFollow
                    return (actorMeID, followID, follow)
    tryCreate _ _ (Right _) _ = mzero
    tryFollow actorID (Left (_, _, outboxItemID)) (Right (author, _, acceptID)) = do
        Entity key val <-
            MaybeT $ lift $
@ -435,6 +557,37 @@ personAccept now recipPersonID (Verse authorIdMsig body) accept = do
            return (recipActorID, sieve)
    prepareFollow result = do
        encodeRouteHome <- getEncodeRouteHome
        (uNewActor, audNewActor) <-
            case result of
                Left (lr, _) -> do
                    la <- resourceToActor <$> hashLocalResource lr
                    return
                        ( encodeRouteHome $ renderLocalActor la
                        , AudLocal [la] []
                        )
                Right (u@(ObjURI h lu), _) ->
                    return (u, AudRemote h [lu] [])
        uAccept <- getActivityURI authorIdMsig
        let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audNewActor]
            recips = map encodeRouteHome audLocal ++ audRemote
            action = AP.Action
                { AP.actionCapability = Nothing
                , AP.actionSummary    = Nothing
                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                , AP.actionFulfills   = [uAccept]
                , AP.actionSpecific   = AP.FollowActivity AP.Follow
                    { AP.followObject  = uNewActor
                    , AP.followContext = Nothing
                    , AP.followHide    = False
                    }
                }
        return (action, recipientSet, remoteActors, fwdHosts)
 -- Meaning: An actor rejected something
 -- Behavior:
 --      * Insert to my inbox
@ -806,6 +959,11 @@ personJoin now recipPersonID (Verse authorIdMsig body) join = do
 -- Behavior:
 --      * Insert to my inbox
 --
 --      * If it's a developer direct-Grant from a local Factory, and there's no
 --        Permit record:
 --          * Insert a Permit record, storing the direct-Grant
 --          * Forward the direct-Grant to my followers
 --
 --      * 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
@ -924,6 +1082,11 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do
        (personRecip, actorRecip) <- lift $ do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)
        selfCreateID <- lift $ do
            mc <- getValBy $ UniqueActorCreateLocalActor $ personActor personRecip
            case mc of
                Nothing -> error "I don't have an ActorCreateLocal record"
                Just c -> pure $ actorCreateLocalCreate c
        maybePermit <-
            for maybeMine' $
@ -934,7 +1097,6 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do
                        fulfillsDB <- do
                            a <- getActivity fulfills
                            fromMaybeE a "Can't find fulfills in DB"
                        (permitID, maybeGestureID) <- do
                        mp <- runMaybeT $ do
                            x@(pt, mg) <-
                                tryInvite fulfillsDB <|>
@ -945,7 +1107,8 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do
                            lift $ unless (role == AP.RXRole role') $
                                throwE "Requested and granted roles differ"
                            return x
-                            fromMaybeE mp "Can't find a PermitFulfills*"
+                        case mp of
                            Just (permitID, maybeGestureID) -> do
                                -- If Permit fulfills an Invite, verify I've approved
                                -- it
@ -966,7 +1129,13 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do
                                    (Right raID, Right ra) | raID == remoteAuthorId ra -> pure ()
                                    _ -> throwE "Grant sender isn't the Permit topic"
-                        return (gestureID, bimap fst fst topic)
+                                return $ Left (gestureID, bimap fst fst topic)
                            Nothing -> do
                                case (authorIdMsig, role) of
                                    (Left (LocalActorFactory factoryID, actorID, grantID), AP.RXRole AP.RoleWrite) ->
                                        return $ Right (factoryID, actorID, grantID)
                                    _ -> throwE "No Permit found & sender-and-role not local-Factory-and-write"
                    )
                    (\ (resourceDB, role, delegatorID) -> do
                        Entity sendID (PermitPersonSendDelegator gestureID _) <- do
@ -990,7 +1159,19 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do
            fmap (inboxItemID,) $
            for maybePermit $
                bitraverse
-                    (\ (gestureID, topic) -> lift $ do
+                    (\ mode -> lift $ do
                        -- In factory-mode, we need to create a Permit record
                        (gestureID, topic) <-
                            case mode of
                                Left permit -> pure permit
                                Right (factoryID, _actorID, _grantID) -> do
                                    resourceID <- factoryResource <$> getJust factoryID
                                    permitID <- insert $ Permit recipPersonID AP.RoleWrite
                                    topicID <- insert $ PermitTopicLocal permitID resourceID
                                    insert_ $ PermitFulfillsResidentFactory permitID
                                    gestureID <- insert $ PermitPersonGesture permitID selfCreateID
                                    return (gestureID, Left topicID)
                        -- Update the Permit record, storing the direct-Grant
                        case (topic, grantDB) of
@ -1072,7 +1253,7 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do
                        sendActivity
                            recipByID recipActorID localRecipsDeleg
                            remoteRecipsDeleg fwdHostsDeleg delegID actionDeleg
-                    doneDB inboxItemID "Forwarded the direct-Grant, updated Permit, maybe published delegator-Grant"
+                    doneDB inboxItemID "Forwarded the direct-Grant, created/updated Permit, maybe published delegator-Grant"
                Just (Right ()) ->
                    doneDB inboxItemID "Got an extension-Grant, updated Permit"
@ -1316,8 +1497,80 @@ personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke lus) = do
 -- Main behavior function
 ------------------------------------------------------------------------------
 -- Meaning: I've just been verified
 -- Behavior: Publish a Create-self activity & record ActorCreateLocal in DB
 personInit
    :: UTCTime
    -> PersonId
    -> ActE (Text, Act (), Next)
 personInit now personMeID = do
    _ <- withDBExcept $ do
        -- Grab me from DB
        personMe <- lift $ getJust personMeID
        let actorMeID = personActor personMe
        actorMe <- lift $ getJust actorMeID
        -- Grab ActorCreate* record, make sure it doesn't exist
        ml <- lift $ getKeyBy $ UniqueActorCreateLocalActor actorMeID
        mr <- lift $ getKeyBy $ UniqueActorCreateRemoteActor actorMeID
        unless (isNothing ml && isNothing mr) $
            throwE "ActorCreate* already exists"
        -- Prepare a Create activity and insert to my outbox
        createID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now
        create@(actionCreate, _, _, _) <- lift $ lift $ prepareCreate personMe actorMe
        _luCreate <- lift $ updateOutboxItem' (LocalActorPerson personMeID) createID actionCreate
        return (actorMeID, createID, create)
    -- Not sending the activity anywhere
    done "Published a Create-self activity"
    where
    prepareCreate personMe actorMe = do
        hLocal <- asksEnv stageInstanceHost
        encodeRouteHome <- getEncodeRouteHome
        encodeRouteLocal <- getEncodeRouteLocal
        personMeHash <- encodeKeyHashid personMeID
        let audMe = AudLocal [] [LocalStagePersonFollowers personMeHash]
            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audMe]
            recips = map encodeRouteHome audLocal ++ audRemote
            pdetail = AP.ActorDetail
                { AP.actorType     = AP.ActorTypeTicketTracker
                , AP.actorUsername = Just $ username2text $ personUsername personMe
                , AP.actorName     = Just $ actorName actorMe
                , AP.actorSummary  = Just $ actorDesc actorMe
                }
            plocal = AP.ActorLocal
                { AP.actorId         = encodeRouteLocal $ PersonR personMeHash
                , AP.actorInbox      = encodeRouteLocal $ PersonInboxR personMeHash
                , AP.actorOutbox     = Nothing
                , AP.actorFollowers  = Nothing
                , AP.actorFollowing  = Nothing
                , AP.actorPublicKeys = []
                , AP.actorSshKeys    = []
                }
            action = AP.Action
                { AP.actionCapability = Nothing
                , AP.actionSummary    = Nothing
                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                , AP.actionFulfills   = []
                , AP.actionSpecific   = AP.CreateActivity AP.Create
                    { AP.createObject = AP.CreatePerson pdetail (Just (hLocal, plocal))
                    , AP.createOrigin = Nothing
                    }
                }
        return (action, recipientSet, remoteActors, fwdHosts)
 personBehavior :: UTCTime -> PersonId -> ActorMessage Person -> ActE (Text, Act (), Next)
-personBehavior now personID (MsgP (Left verse@(Verse _authorIdMsig body))) =
+personBehavior now personID (PersonMsgVerse 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
@ -1337,7 +1590,8 @@ personBehavior now personID (MsgP (Left verse@(Verse _authorIdMsig body))) =
        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 (MsgP (Right msg)) = clientBehavior now personID msg
+personBehavior now personID (PersonMsgClient msg) = clientBehavior now personID msg
 personBehavior now personID PersonMsgInit         = personInit now personID
 instance VervisActorLaunch Person where
    actorBehavior' now personID ve = do
--- a/src/Vervis/Actor/Person/Client.hs
+++ b/src/Vervis/Actor/Person/Client.hs
@ -358,26 +358,35 @@ clientAdd now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts a
        fwdHosts addID action
    return addID
-- Meaning: The human wants to create a ticket tracker
+-- Meaning: The human wants to create an actor via a Factory
 -- Behavior:
--      * Create a deck on DB
+--      * Ensure the origin is addressed
--      * Create a Permit record in DB
+--      * Insert Create to outbox
--      * Launch a deck actor
+--      * Create an open permit record
--      * Record a FollowRequest in DB
+--      * Send the Create to recipients
--      * Create and send Create and Follow to it
+clientCreateActor
 clientCreateDeck
    :: UTCTime
    -> PersonId
    -> ClientMsg
    -> AP.ActorDetail
    -> FedURI
    -> ActE OutboxItemId
-clientCreateDeck now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) tracker = do
+clientCreateActor now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) detail uOrigin = do
    -- Check input
-    verifyNothingE maybeCap "Capability not needed"
+    _ <- fromMaybeE maybeCap "Capability not provided"
-    (name, msummary) <- parseTracker tracker
+    _ <- parseDetail detail
    origin <- do
        routeOrRemote <- parseFedURI uOrigin
        bitraverse parseLocalActorE' pure routeOrRemote
-    (actorMeID, localRecipsFinal, createID, actionCreate, followID, follow, deckID) <- withDBExcept $ do
+    -- Verify origin is addressed
    bitraverse_
        (verifyActorAddressed localRecips)
        (verifyRemoteAddressed remoteRecips)
        origin
    (actorMeID, createID) <- withDBExcept $ do
        -- Grab me from DB
        (personMe, actorMe) <- lift $ do
@ -385,455 +394,35 @@ clientCreateDeck now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd
            (p,) <$> getJust (personActor p)
        let actorMeID = personActor personMe
-        -- Insert new deck to DB
+        -- Insert the Create activity to my outbox
        createID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now
-        wid <- findWorkflow
+        _luCreate <- lift $ updateOutboxItem' (LocalActorPerson personMeID) createID action
        (deckID, resourceID, deckFollowerSetID) <-
            lift $ insertDeck now name msummary createID wid actorMeID
-        -- Insert a Permit record
+        -- Insert a partial Permit record, i.e. without topic
        -- (Is this a good idea?
        -- It's a way to remember the createID for when the Accept from the
        -- Factory arrives, which is when we insert the missing topic)
        lift $ do
            permitID <- insert $ Permit personMeID AP.RoleAdmin
            topicID <- insert $ PermitTopicLocal permitID resourceID
            insert_ $ PermitFulfillsTopicCreation permitID
            insert_ $ PermitPersonGesture permitID createID
-        -- Insert the Create activity to my outbox
+        return (personActor personMe, createID)
        deckHash <- encodeKeyHashid deckID
        actionCreate <- prepareCreate name msummary deckHash
        luCreate <- lift $ updateOutboxItem' (LocalActorPerson personMeID) createID actionCreate
        -- Prepare recipient sieve for sending the Create
        personMeHash <- lift $ encodeKeyHashid personMeID
        let sieve =
                makeRecipientSet
                    [LocalActorDeck deckHash]
                    [LocalStagePersonFollowers personMeHash]
            onlyDeck = DeckFamilyRoutes (DeckRoutes True False) []
            addMe' decks = (deckHash, onlyDeck) : decks
            addMe rs = rs { recipDecks = addMe' $ recipDecks rs }
        -- Insert a follow request, since I'm about to send a Follow
        followID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now
        lift $ insert_ $ FollowRequest actorMeID deckFollowerSetID True followID
        -- Insert a Follow to my outbox
        follow@(actionFollow, _, _, _) <- lift $ lift $ prepareFollow deckID luCreate
        _luFollow <- lift $ updateOutboxItem' (LocalActorPerson personMeID) followID actionFollow
        return
            ( personActor personMe
            , localRecipSieve sieve False $ addMe localRecips
            , createID
            , actionCreate
            , followID
            , follow
            , deckID
            )
    -- Spawn new Deck actor
    success <- lift $ launchActor deckID
    unless success $
        error "Failed to spawn new Deck, somehow ID already in Theater"
    -- Send the Create
    lift $ sendActivity
-        (LocalActorPerson personMeID) actorMeID localRecipsFinal remoteRecips
+        (LocalActorPerson personMeID) actorMeID localRecips remoteRecips
-        fwdHosts createID actionCreate
+        fwdHosts createID action
    -- Send the Follow
    let (actionFollow, localRecipsFollow, remoteRecipsFollow, fwdHostsFollow) = follow
    lift $ sendActivity
        (LocalActorPerson personMeID) actorMeID localRecipsFollow
        remoteRecipsFollow fwdHostsFollow followID actionFollow
    return createID
    where
-    parseTracker (AP.ActorDetail typ muser mname msummary) = do
+    parseDetail (AP.ActorDetail typ muser mname msummary) = do
-        unless (typ == AP.ActorTypeTicketTracker) $
+        verifyNothingE muser "Can't have a username"
-            error "createTicketTrackerC: Create object isn't a TicketTracker"
+        name <- fromMaybeE mname "Doesn't specify name"
        verifyNothingE muser "TicketTracker can't have a username"
        name <- fromMaybeE mname "TicketTracker doesn't specify name"
        return (name, msummary)
    findWorkflow = do
        mw <- lift $ selectFirst ([] :: [Filter Workflow]) []
        entityKey <$> fromMaybeE mw "Can't find a workflow"
    insertDeck now name msummary obiidCreate wid actorMeID = do
        Entity aid a <- insertActor now name (fromMaybe "" msummary) (Just actorMeID)
        rid <- insert $ Resource aid
        kid <- insert $ Komponent rid
        did <- insert Deck
            { deckActor      = aid
            , deckResource   = rid
            , deckKomponent  = kid
            , deckWorkflow   = wid
            , deckNextTicket = 1
            , deckWiki       = Nothing
            , deckCreate     = obiidCreate
            }
        return (did, rid, actorFollowers a)
    prepareCreate name msummary deckHash = do
        encodeRouteLocal <- getEncodeRouteLocal
        hLocal <- asksEnv stageInstanceHost
        let ttdetail = AP.ActorDetail
                { AP.actorType     = AP.ActorTypeTicketTracker
                , AP.actorUsername = Nothing
                , AP.actorName     = Just name
                , AP.actorSummary  = msummary
                }
            ttlocal = AP.ActorLocal
                { AP.actorId         = encodeRouteLocal $ DeckR deckHash
                , AP.actorInbox      = encodeRouteLocal $ DeckInboxR deckHash
                , AP.actorOutbox     = Nothing
                , AP.actorFollowers  = Nothing
                , AP.actorFollowing  = Nothing
                , AP.actorPublicKeys = []
                , AP.actorSshKeys    = []
                }
            specific = AP.CreateActivity AP.Create
                { AP.createObject = AP.CreateTicketTracker ttdetail (Just (hLocal, ttlocal))
                , AP.createTarget = Nothing
                }
        return action { AP.actionSpecific = specific }
    prepareFollow deckID luCreate = do
        encodeRouteHome <- getEncodeRouteHome
        h <- asksEnv stageInstanceHost
        deckHash <- encodeKeyHashid deckID
        let audTopic = AudLocal [LocalActorDeck deckHash] []
            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audTopic]
            recips = map encodeRouteHome audLocal ++ audRemote
            action = AP.Action
                { AP.actionCapability = Nothing
                , AP.actionSummary    = Nothing
                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                , AP.actionFulfills   = [ObjURI h luCreate]
                , AP.actionSpecific   = AP.FollowActivity AP.Follow
                    { AP.followObject  = encodeRouteHome $ DeckR deckHash
                    , AP.followContext = Nothing
                    , AP.followHide    = False
                    }
                }
        return (action, recipientSet, remoteActors, fwdHosts)
 -- Meaning: The human wants to create a project
 -- Behavior:
 --      * Create a project on DB
 --      * Create a Permit record in DB
 --      * Launch a project actor
 --      * Record a FollowRequest in DB
 --      * Create and send Create and Follow to it
 clientCreateProject
    :: UTCTime
    -> PersonId
    -> ClientMsg
    -> AP.ActorDetail
    -> ActE OutboxItemId
 clientCreateProject now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) tracker = do
    -- Check input
    verifyNothingE maybeCap "Capability not needed"
    (name, msummary) <- parseTracker tracker
    (actorMeID, localRecipsFinal, createID, actionCreate, followID, follow, projectID) <- lift $ withDB $ do
        -- Grab me from DB
        (personMe, actorMe) <- do
            p <- getJust personMeID
            (p,) <$> getJust (personActor p)
        let actorMeID = personActor personMe
        -- Insert new project to DB
        createID <- insertEmptyOutboxItem' (actorOutbox actorMe) now
        (projectID, resourceID, projectFollowerSetID) <-
            insertProject now name msummary createID actorMeID
        -- Insert a Permit record
        permitID <- insert $ Permit personMeID AP.RoleAdmin
        topicID <- insert $ PermitTopicLocal permitID resourceID
        insert_ $ PermitFulfillsTopicCreation permitID
        insert_ $ PermitPersonGesture permitID createID
        -- Insert the Create activity to my outbox
        projectHash <- lift $ encodeKeyHashid projectID
        actionCreate <- lift $ prepareCreate name msummary projectHash
        luCreate <- updateOutboxItem' (LocalActorPerson personMeID) createID actionCreate
        -- Prepare recipient sieve for sending the Create
        personMeHash <- lift $ encodeKeyHashid personMeID
        let sieve =
                makeRecipientSet
                    [LocalActorProject projectHash]
                    [LocalStagePersonFollowers personMeHash]
            onlyProject = ProjectRoutes True False
            addMe' projects = (projectHash, onlyProject) : projects
            addMe rs = rs { recipProjects = addMe' $ recipProjects rs }
        -- Insert a follow request, since I'm about to send a Follow
        followID <- insertEmptyOutboxItem' (actorOutbox actorMe) now
        insert_ $ FollowRequest actorMeID projectFollowerSetID True followID
        -- Insert a Follow to my outbox
        follow@(actionFollow, _, _, _) <- lift $ prepareFollow projectID luCreate
        _luFollow <- updateOutboxItem' (LocalActorPerson personMeID) followID actionFollow
        return
            ( personActor personMe
            , localRecipSieve sieve False $ addMe localRecips
            , createID
            , actionCreate
            , followID
            , follow
            , projectID
            )
    -- Spawn new Project actor
    success <- lift $ launchActor projectID
    unless success $
        error "Failed to spawn new Project, somehow ID already in Theater"
    -- Send the Create
    lift $ sendActivity
        (LocalActorPerson personMeID) actorMeID localRecipsFinal remoteRecips
        fwdHosts createID actionCreate
    -- Send the Follow
    let (actionFollow, localRecipsFollow, remoteRecipsFollow, fwdHostsFollow) = follow
    lift $ sendActivity
        (LocalActorPerson personMeID) actorMeID localRecipsFollow
        remoteRecipsFollow fwdHostsFollow followID actionFollow
    return createID
    where
    parseTracker (AP.ActorDetail typ muser mname msummary) = do
        unless (typ == AP.ActorTypeProject) $
            error "clientCreateProject: Create object isn't a Project"
        verifyNothingE muser "Project can't have a username"
        name <- fromMaybeE mname "Project doesn't specify name"
        return (name, msummary)
    insertProject now name msummary obiidCreate actorMeID = do
        Entity aid a <- insertActor now name (fromMaybe "" msummary) (Just actorMeID)
        rid <- insert $ Resource aid
        did <- insert Project
            { projectActor      = aid
            , projectResource   = rid
            , projectCreate     = obiidCreate
            }
        return (did, rid, actorFollowers a)
    prepareCreate name msummary projectHash = do
        encodeRouteLocal <- getEncodeRouteLocal
        hLocal <- asksEnv stageInstanceHost
        let ttdetail = AP.ActorDetail
                { AP.actorType     = AP.ActorTypeProject
                , AP.actorUsername = Nothing
                , AP.actorName     = Just name
                , AP.actorSummary  = msummary
                }
            ttlocal = AP.ActorLocal
                { AP.actorId         = encodeRouteLocal $ ProjectR projectHash
                , AP.actorInbox      = encodeRouteLocal $ ProjectInboxR projectHash
                , AP.actorOutbox     = Nothing
                , AP.actorFollowers  = Nothing
                , AP.actorFollowing  = Nothing
                , AP.actorPublicKeys = []
                , AP.actorSshKeys    = []
                }
            specific = AP.CreateActivity AP.Create
                { AP.createObject = AP.CreateProject ttdetail (Just (hLocal, ttlocal))
                , AP.createTarget = Nothing
                }
        return action { AP.actionSpecific = specific }
    prepareFollow projectID luCreate = do
        encodeRouteHome <- getEncodeRouteHome
        h <- asksEnv stageInstanceHost
        projectHash <- encodeKeyHashid projectID
        let audTopic = AudLocal [LocalActorProject projectHash] []
            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audTopic]
            recips = map encodeRouteHome audLocal ++ audRemote
            action = AP.Action
                { AP.actionCapability = Nothing
                , AP.actionSummary    = Nothing
                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                , AP.actionFulfills   = [ObjURI h luCreate]
                , AP.actionSpecific   = AP.FollowActivity AP.Follow
                    { AP.followObject  = encodeRouteHome $ ProjectR projectHash
                    , AP.followContext = Nothing
                    , AP.followHide    = False
                    }
                }
        return (action, recipientSet, remoteActors, fwdHosts)
 -- Meaning: The human wants to create a team
 -- Behavior:
 --      * Create a team on DB
 --      * Create a Permit record in DB
 --      * Launch a team actor
 --      * Record a FollowRequest in DB
 --      * Create and send Create and Follow to it
 clientCreateTeam
    :: UTCTime
    -> PersonId
    -> ClientMsg
    -> AP.ActorDetail
    -> ActE OutboxItemId
 clientCreateTeam now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) tracker = do
    -- Check input
    verifyNothingE maybeCap "Capability not needed"
    (name, msummary) <- parseTracker tracker
    (actorMeID, localRecipsFinal, createID, actionCreate, followID, follow, groupID) <- lift $ withDB $ do
        -- Grab me from DB
        (personMe, actorMe) <- do
            p <- getJust personMeID
            (p,) <$> getJust (personActor p)
        let actorMeID = personActor personMe
        -- Insert new team to DB
        createID <- insertEmptyOutboxItem' (actorOutbox actorMe) now
        (groupID, resourceID, projectFollowerSetID) <-
            insertTeam now name msummary createID actorMeID
        -- Insert a Permit record
        permitID <- insert $ Permit personMeID AP.RoleAdmin
        topicID <- insert $ PermitTopicLocal permitID resourceID
        insert_ $ PermitFulfillsTopicCreation permitID
        insert_ $ PermitPersonGesture permitID createID
        -- Insert the Create activity to my outbox
        groupHash <- lift $ encodeKeyHashid groupID
        actionCreate <- lift $ prepareCreate name msummary groupHash
        luCreate <- updateOutboxItem' (LocalActorPerson personMeID) createID actionCreate
        -- Prepare recipient sieve for sending the Create
        personMeHash <- lift $ encodeKeyHashid personMeID
        let sieve =
                makeRecipientSet
                    [LocalActorGroup groupHash]
                    [LocalStagePersonFollowers personMeHash]
            onlyGroup = GroupRoutes True False
            addMe' groups = (groupHash, onlyGroup) : groups
            addMe rs = rs { recipGroups = addMe' $ recipGroups rs }
        -- Insert a follow request, since I'm about to send a Follow
        followID <- insertEmptyOutboxItem' (actorOutbox actorMe) now
        insert_ $ FollowRequest actorMeID projectFollowerSetID True followID
        -- Insert a Follow to my outbox
        follow@(actionFollow, _, _, _) <- lift $ prepareFollow groupID luCreate
        _luFollow <- updateOutboxItem' (LocalActorPerson personMeID) followID actionFollow
        return
            ( personActor personMe
            , localRecipSieve sieve False $ addMe localRecips
            , createID
            , actionCreate
            , followID
            , follow
            , groupID
            )
    -- Spawn new Group actor
    success <- lift $ launchActor groupID
    unless success $
        error "Failed to spawn new Group, somehow ID already in Theater"
    -- Send the Create
    lift $ sendActivity
        (LocalActorPerson personMeID) actorMeID localRecipsFinal remoteRecips
        fwdHosts createID actionCreate
    -- Send the Follow
    let (actionFollow, localRecipsFollow, remoteRecipsFollow, fwdHostsFollow) = follow
    lift $ sendActivity
        (LocalActorPerson personMeID) actorMeID localRecipsFollow
        remoteRecipsFollow fwdHostsFollow followID actionFollow
    return createID
    where
    parseTracker (AP.ActorDetail typ muser mname msummary) = do
        unless (typ == AP.ActorTypeTeam) $
            error "clientCreateTeam: Create object isn't a Team"
        verifyNothingE muser "Team can't have a username"
        name <- fromMaybeE mname "Team doesn't specify name"
        return (name, msummary)
    insertTeam now name msummary obiidCreate actorMeID = do
        Entity aid a <- insertActor now name (fromMaybe "" msummary) (Just actorMeID)
        rid <- insert $ Resource aid
        gid <- insert Group
            { groupActor      = aid
            , groupResource   = rid
            , groupCreate     = obiidCreate
            }
        return (gid, rid, actorFollowers a)
    prepareCreate name msummary groupHash = do
        encodeRouteLocal <- getEncodeRouteLocal
        hLocal <- asksEnv stageInstanceHost
        let ttdetail = AP.ActorDetail
                { AP.actorType     = AP.ActorTypeTeam
                , AP.actorUsername = Nothing
                , AP.actorName     = Just name
                , AP.actorSummary  = msummary
                }
            ttlocal = AP.ActorLocal
                { AP.actorId         = encodeRouteLocal $ GroupR groupHash
                , AP.actorInbox      = encodeRouteLocal $ GroupInboxR groupHash
                , AP.actorOutbox     = Nothing
                , AP.actorFollowers  = Nothing
                , AP.actorFollowing  = Nothing
                , AP.actorPublicKeys = []
                , AP.actorSshKeys    = []
                }
            specific = AP.CreateActivity AP.Create
                { AP.createObject = AP.CreateTeam ttdetail (Just (hLocal, ttlocal))
                , AP.createTarget = Nothing
                }
        return action { AP.actionSpecific = specific }
    prepareFollow groupID luCreate = do
        encodeRouteHome <- getEncodeRouteHome
        h <- asksEnv stageInstanceHost
        groupHash <- encodeKeyHashid groupID
        let audTopic = AudLocal [LocalActorGroup groupHash] []
            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
                collectAudience [audTopic]
            recips = map encodeRouteHome audLocal ++ audRemote
            action = AP.Action
                { AP.actionCapability = Nothing
                , AP.actionSummary    = Nothing
                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                , AP.actionFulfills   = [ObjURI h luCreate]
                , AP.actionSpecific   = AP.FollowActivity AP.Follow
                    { AP.followObject  = encodeRouteHome $ GroupR groupHash
                    , AP.followContext = Nothing
                    , AP.followHide    = False
                    }
                }
        return (action, recipientSet, remoteActors, fwdHosts)
 -- Meaning: The human wants to create a factory
 -- Behavior:
 --      * Verify human is allowed to
@ -939,11 +528,10 @@ clientCreateFactory now personMeID (ClientMsg maybeCap localRecips remoteRecips
        return (name, msummary)
    insertFactory now name msummary obiidCreate actorMeID = do
-        Entity aid a <- insertActor now name (fromMaybe "" msummary) (Just actorMeID)
+        Entity aid a <- insertActor now name (fromMaybe "" msummary) (Left (LocalActorPerson personMeID, actorMeID, obiidCreate))
        rid <- insert $ Resource aid
        fid <- insert Factory
            { factoryResource = rid
            , factoryCreate   = obiidCreate
            }
        return (fid, rid, actorFollowers a)
@ -967,7 +555,7 @@ clientCreateFactory now personMeID (ClientMsg maybeCap localRecips remoteRecips
                }
            specific = AP.CreateActivity AP.Create
                { AP.createObject = AP.CreateFactory ttdetail (Just (hLocal, ttlocal))
-                , AP.createTarget = Nothing
+                , AP.createOrigin = Nothing
                }
        return action { AP.actionSpecific = specific }
@ -1000,27 +588,27 @@ clientCreate
    -> ClientMsg
    -> AP.Create URIMode
    -> ActE OutboxItemId
-clientCreate now personMeID msg (AP.Create object muTarget) =
+clientCreate now personMeID msg (AP.Create object muOrigin) =
    case object of
        AP.CreateTicketTracker detail mlocal -> do
            verifyNothingE mlocal "Tracker id must not be provided"
-            verifyNothingE muTarget "'target' not supported in Create TicketTracker"
+            uOrigin <- fromMaybeE muOrigin "'origin' required for Create TicketTracker"
-            clientCreateDeck now personMeID msg detail
+            clientCreateActor now personMeID msg detail uOrigin
        AP.CreateProject detail mlocal -> do
            verifyNothingE mlocal "Project id must not be provided"
-            verifyNothingE muTarget "'target' not supported in Create Project"
+            uOrigin <- fromMaybeE muOrigin "'origin' required for Create TicketTracker"
-            clientCreateProject now personMeID msg detail
+            clientCreateActor now personMeID msg detail uOrigin
        AP.CreateTeam detail mlocal -> do
            verifyNothingE mlocal "Team id must not be provided"
-            verifyNothingE muTarget "'target' not supported in Create Team"
+            uOrigin <- fromMaybeE muOrigin "'origin' required for Create TicketTracker"
-            clientCreateTeam now personMeID msg detail
+            clientCreateActor now personMeID msg detail uOrigin
        AP.CreateFactory detail mlocal -> do
            verifyNothingE mlocal "Factory id must not be provided"
-            verifyNothingE muTarget "'target' not supported in Create Factory"
+            verifyNothingE muOrigin "'target' not supported in Create Factory"
            clientCreateFactory now personMeID msg detail
        _ -> throwE "Unsupported Create object for C2S"
--- a/src/Vervis/Actor/Project.hs
+++ b/src/Vervis/Actor/Project.hs
@ -71,7 +71,7 @@ import Vervis.Data.Discussion
 import Vervis.FedURI
 import Vervis.Foundation
-import Vervis.Model hiding (projectCreate)
+import Vervis.Model
 import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience, localActorFollowers, renderLocalActor)
 import Vervis.RemoteActorStore
 import Vervis.Persist.Actor
@ -2755,42 +2755,6 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
                Right (author, _, addID) ->
                    insert_ $ SquadThemGestureRemote themID (remoteAuthorId author) addID
 -- Meaning: Someone has created a project with my ID URI
 -- Behavior:
 --     * Verify I'm in a just-been-created state
 --     * Verify my creator and the Create sender are the same actor
 --     * Create an admin Collab record in DB
 --     * Send an admin Grant to the creator
 --     * Get out of the just-been-created state
 projectCreateMe
    :: UTCTime
    -> ProjectId
    -> Verse
    -> ActE (Text, Act (), Next)
 projectCreateMe = topicCreateMe projectResource LocalResourceProject
 projectCreate
    :: UTCTime
    -> ProjectId
    -> Verse
    -> AP.Create URIMode
    -> ActE (Text, Act (), Next)
 projectCreate now projectID verse (AP.Create obj _muTarget) =
    case obj of
        AP.CreateProject _ mlocal -> do
            (h, local) <- fromMaybeE mlocal "No project id provided"
            let luProject = AP.actorId local
            uMe <- do
                projectHash <- encodeKeyHashid projectID
                encodeRouteHome <- getEncodeRouteHome
                return $ encodeRouteHome $ ProjectR projectHash
            unless (uMe == ObjURI h luProject) $
                throwE "The created project id isn't me"
            projectCreateMe now projectID verse
        _ -> throwE "Unsupported Create object for Project"
 -- Meaning: An actor is following someone/something
 -- Behavior:
 --      * Verify the target is me
@ -7614,11 +7578,10 @@ projectUndo now recipProjectID (Verse authorIdMsig body) (AP.Undo uObject) = do
        return (action, recipientSet, remoteActors, fwdHosts)
 projectBehavior :: UTCTime -> ProjectId -> ActorMessage Project -> ActE (Text, Act (), Next)
-projectBehavior now projectID (MsgJ verse@(Verse _authorIdMsig body)) =
+projectBehavior now projectID (ProjectMsgVerse verse@(Verse _authorIdMsig body)) =
    case AP.activitySpecific $ actbActivity body of
        AP.AcceptActivity accept -> projectAccept now projectID verse accept
        AP.AddActivity add       -> projectAdd now projectID verse add
        AP.CreateActivity create -> projectCreate now projectID verse create
        AP.FollowActivity follow -> projectFollow now projectID verse follow
        AP.GrantActivity grant   -> projectGrant now projectID verse grant
        AP.InviteActivity invite -> projectInvite now projectID verse invite
@ -7628,6 +7591,9 @@ projectBehavior now projectID (MsgJ verse@(Verse _authorIdMsig body)) =
        AP.RevokeActivity revoke -> projectRevoke now projectID verse revoke
        AP.UndoActivity undo     -> projectUndo now projectID verse undo
        _ -> throwE "Unsupported activity type for Project"
 projectBehavior now projectID (ProjectMsgInit creator) =
    let grabResource = pure . projectResource
    in  topicInit grabResource LocalResourceProject now projectID creator
 instance VervisActorLaunch Project where
    actorBehavior' now projectID ve = do
--- a/src/Vervis/Client.hs
+++ b/src/Vervis/Client.hs
@ -1003,12 +1003,23 @@ createDeck
    => KeyHashid Person
    -> Text
    -> Text
-    -> m (Maybe HTML, [Aud URIMode], AP.ActorDetail)
+    -> FedURI
-createDeck senderHash name desc = do
+    -> ExceptT Text m (Maybe HTML, [Aud URIMode], AP.ActorDetail)
 createDeck senderHash name desc uFactory = do
    audFactory <- do
        routeOrRemote <- parseFedURIOld uFactory
        actorOrRemote <- bitraverse parseLocalActorE pure routeOrRemote
        case actorOrRemote of
            Left la -> do
                h <- VR.hashLocalActor la
                return $ AudLocal [h] []
            Right (ObjURI h lu) ->
                pure $ AudRemote h [lu] []
    let audAuthor =
            AudLocal [] [LocalStagePersonFollowers senderHash]
-        audience = [audAuthor]
+        audience = [audAuthor, audFactory]
        detail = AP.ActorDetail
            { AP.actorType     = AP.ActorTypeTicketTracker
@ -1074,12 +1085,23 @@ createProject
    => KeyHashid Person
    -> Text
    -> Text
-    -> m (Maybe HTML, [Aud URIMode], AP.ActorDetail)
+    -> FedURI
-createProject senderHash name desc = do
+    -> ExceptT Text m (Maybe HTML, [Aud URIMode], AP.ActorDetail)
 createProject senderHash name desc uFactory = do
    audFactory <- do
        routeOrRemote <- parseFedURIOld uFactory
        actorOrRemote <- bitraverse parseLocalActorE pure routeOrRemote
        case actorOrRemote of
            Left la -> do
                h <- VR.hashLocalActor la
                return $ AudLocal [h] []
            Right (ObjURI h lu) ->
                pure $ AudRemote h [lu] []
    let audAuthor =
            AudLocal [] [LocalStagePersonFollowers senderHash]
-        audience = [audAuthor]
+        audience = [audAuthor, audFactory]
        detail = AP.ActorDetail
            { AP.actorType     = AP.ActorTypeProject
@ -1095,12 +1117,23 @@ createGroup
    => KeyHashid Person
    -> Text
    -> Text
-    -> m (Maybe HTML, [Aud URIMode], AP.ActorDetail)
+    -> FedURI
-createGroup senderHash name desc = do
+    -> ExceptT Text m (Maybe HTML, [Aud URIMode], AP.ActorDetail)
 createGroup senderHash name desc uFactory = do
    audFactory <- do
        routeOrRemote <- parseFedURIOld uFactory
        actorOrRemote <- bitraverse parseLocalActorE pure routeOrRemote
        case actorOrRemote of
            Left la -> do
                h <- VR.hashLocalActor la
                return $ AudLocal [h] []
            Right (ObjURI h lu) ->
                pure $ AudRemote h [lu] []
    let audAuthor =
            AudLocal [] [LocalStagePersonFollowers senderHash]
-        audience = [audAuthor]
+        audience = [audAuthor, audFactory]
        detail = AP.ActorDetail
            { AP.actorType     = AP.ActorTypeTeam
--- a/src/Vervis/Data/Actor.hs
+++ b/src/Vervis/Data/Actor.hs
@ -22,6 +22,7 @@ module Vervis.Data.Actor
    , stampRoute
    , parseStampRoute
    , grabLocalActorID
    , grabLocalResourceID
    , localResourceID
    , WA.parseLocalURI
    , parseFedURIOld
@ -72,6 +73,15 @@ import Vervis.Recipient
 import qualified Vervis.Actor as VA
 parseOutboxItemRoute (PersonOutboxItemR p i) = Just (LocalActorPerson p, i)
 parseOutboxItemRoute (GroupOutboxItemR g i)  = Just (LocalActorGroup g, i)
 parseOutboxItemRoute (RepoOutboxItemR r i)   = Just (LocalActorRepo r, i)
 parseOutboxItemRoute (DeckOutboxItemR d i)   = Just (LocalActorDeck d, i)
 parseOutboxItemRoute (LoomOutboxItemR l i)   = Just (LocalActorLoom l, i)
 parseOutboxItemRoute (ProjectOutboxItemR r i)   = Just (LocalActorProject r, i)
 parseOutboxItemRoute (FactoryOutboxItemR r i)   = Just (LocalActorFactory r, i)
 parseOutboxItemRoute _                       = Nothing
 parseLocalActivityURI
    :: (MonadSite m, YesodHashids (SiteEnv m))
    => LocalURI
@ -85,14 +95,6 @@ parseLocalActivityURI luAct = do
    outboxItemID <- decodeKeyHashidE outboxItemHash "Invalid outbox item hash"
    actorKey <- unhashLocalActorE actorHash "Invalid actor hash"
    return (actorKey, actorHash, outboxItemID)
    where
    parseOutboxItemRoute (PersonOutboxItemR p i) = Just (LocalActorPerson p, i)
    parseOutboxItemRoute (GroupOutboxItemR g i)  = Just (LocalActorGroup g, i)
    parseOutboxItemRoute (RepoOutboxItemR r i)   = Just (LocalActorRepo r, i)
    parseOutboxItemRoute (DeckOutboxItemR d i)   = Just (LocalActorDeck d, i)
    parseOutboxItemRoute (LoomOutboxItemR l i)   = Just (LocalActorLoom l, i)
    parseOutboxItemRoute (ProjectOutboxItemR r i)   = Just (LocalActorProject r, i)
    parseOutboxItemRoute _                       = Nothing
 parseLocalActivityURI'
    :: LocalURI
@ -106,14 +108,6 @@ parseLocalActivityURI' luAct = do
    outboxItemID <- WAP.decodeKeyHashidE outboxItemHash "Invalid outbox item hash"
    actorKey <- VA.unhashLocalActorE actorHash "Invalid actor hash"
    return (actorKey, actorHash, outboxItemID)
    where
    parseOutboxItemRoute (PersonOutboxItemR p i) = Just (LocalActorPerson p, i)
    parseOutboxItemRoute (GroupOutboxItemR g i)  = Just (LocalActorGroup g, i)
    parseOutboxItemRoute (RepoOutboxItemR r i)   = Just (LocalActorRepo r, i)
    parseOutboxItemRoute (DeckOutboxItemR d i)   = Just (LocalActorDeck d, i)
    parseOutboxItemRoute (LoomOutboxItemR l i)   = Just (LocalActorLoom l, i)
    parseOutboxItemRoute (ProjectOutboxItemR r i)   = Just (LocalActorProject r, i)
    parseOutboxItemRoute _                       = Nothing
 -- | If the given URI is remote, return as is. If the URI is local, verify that
 -- it parses as an activity URI, i.e. an outbox item route, and return the
@ -194,6 +188,9 @@ localResourceID (LocalResourceLoom (Entity _ l))   = loomResource l
 localResourceID (LocalResourceProject (Entity _ r))   = projectResource r
 localResourceID (LocalResourceFactory (Entity _ f))   = factoryResource f
 grabLocalResourceID :: MonadIO m => LocalResourceBy Entity -> SqlPersistT m ResourceId
 grabLocalResourceID = pure . localResourceID
 parseFedURIOld
    :: ( MonadSite m
       , SiteEnv m ~ site
--- a/src/Vervis/Field/Person.hs
+++ b/src/Vervis/Field/Person.hs
@ -17,23 +17,30 @@ module Vervis.Field.Person
    ( passField
    , fedUriField
    , capField
    , factoryField
    )
 where
 import Control.Monad.Trans.Except
 import Data.Char (isDigit)
 import Data.Maybe
 import Data.Text (Text)
 import Database.Esqueleto
 import Yesod.Core
 import Yesod.Form.Fields
 import Yesod.Form.Functions
 import Yesod.Form.Types
 import Yesod.Persist.Core
 import qualified Data.Text as T
 import qualified Database.Esqueleto as E
 import Network.FedURI
 import Yesod.FedURI
 import Yesod.Hashids
 import qualified Web.ActivityPub as AP
 import Control.Monad.Trans.Except.Local
 import Data.Char.Local (isAsciiLetter)
@ -43,6 +50,7 @@ import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident (text2shr)
 import Vervis.Recipient
 import Vervis.Settings
 checkPassLength :: Field Handler Text -> Field Handler Text
@ -98,3 +106,56 @@ capField = checkMMap toCap fst fedUriField
    where
    toCap u =
        runExceptT $ (u,) <$> nameExceptT "Capability URI" (parseActivityURI u)
 factoryField personID = selectField $ do
    l <- runDB $ do
        local <-
            E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable `E.InnerJoin` factory `E.InnerJoin` resource `E.InnerJoin` actor) -> do
                E.on $ resource E.^. ResourceActor E.==. actor E.^. ActorId
                E.on $ factory E.^. FactoryResource E.==. resource E.^. ResourceId
                E.on $ topic E.^. PermitTopicLocalTopic E.==. factory E.^. FactoryResource
                E.on $ topic E.^. PermitTopicLocalId E.==. enable E.^. PermitTopicEnableLocalTopic
                E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicLocalPermit
                E.where_ $
                    permit E.^. PermitPerson E.==. E.val personID E.&&.
                    permit E.^. PermitRole `E.in_` E.valList [AP.RoleWrite, AP.RoleMaintain, AP.RoleAdmin]
                return (factory E.^. FactoryId, actor E.^. ActorName, enable E.^. PermitTopicEnableLocalGrant)
        remote <-
            E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable `E.InnerJoin` actor `E.InnerJoin` object `E.InnerJoin` i `E.InnerJoin` ract `E.InnerJoin` ro) -> do
                E.on $ ract E.^. RemoteActivityIdent E.==. ro E.^. RemoteObjectId
                E.on $ enable E.^. PermitTopicEnableRemoteGrant E.==. ract E.^. RemoteActivityId
                E.on $ object E.^. RemoteObjectInstance E.==. i E.^. InstanceId
                E.on $ actor E.^. RemoteActorIdent E.==. object E.^. RemoteObjectId
                E.on $ topic E.^. PermitTopicRemoteActor E.==. actor E.^. RemoteActorId
                E.on $ topic E.^. PermitTopicRemoteId E.==. enable E.^. PermitTopicEnableRemoteTopic
                E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicRemotePermit
                E.where_ $
                    permit E.^. PermitPerson E.==. E.val personID E.&&.
                    actor E.^. RemoteActorType E.==. E.val AP.ActorTypeFactory E.&&.
                    permit E.^. PermitRole `E.in_` E.valList [AP.RoleWrite, AP.RoleMaintain, AP.RoleAdmin]
                return (i E.^. InstanceHost, object E.^. RemoteObjectIdent, actor E.^. RemoteActorName, ro E.^. RemoteObjectIdent)
        return $ map Left local ++ map Right remote
    hashFactory <- getEncodeKeyHashid
    hashItem <- getEncodeKeyHashid
    encodeRouteHome <- getEncodeRouteHome
    optionsPairs $
        map (\case
                Left (E.Value factoryID, E.Value name, E.Value grantID) ->
                    ( T.concat
                        [ "*", keyHashidText $ hashFactory factoryID
                        , " ", name
                        ]
                    , ( encodeRouteHome $ FactoryR $ hashFactory factoryID
                      , encodeRouteHome $ FactoryOutboxItemR (hashFactory factoryID) (hashItem grantID)
                      )
                    )
                Right (E.Value h, E.Value lu, E.Value mname, E.Value luGrant) ->
                    ( T.concat
                        [ renderObjURI $ ObjURI h lu
                        , " "
                        , fromMaybe "(?)" mname
                        ]
                    , (ObjURI h lu, ObjURI h luGrant)
                    )
            )
        l
--- a/src/Vervis/Form/Tracker.hs
+++ b/src/Vervis/Form/Tracker.hs
@ -55,6 +55,7 @@ import Yesod.Hashids
 import qualified Web.ActivityPub as AP
 import Vervis.FedURI
 import Vervis.Field.Person
 import Vervis.Form.Ticket
 import Vervis.Foundation
 import Vervis.Model
@ -63,32 +64,38 @@ import Vervis.Model.Ident
 data NewDeck = NewDeck
    { ndName  :: Text
    , ndDesc  :: Text
    , ndFactory :: (FedURI, FedURI)
    }
-newDeckForm :: Form NewDeck
+newDeckForm :: PersonId -> Form NewDeck
-newDeckForm = renderDivs $ NewDeck
+newDeckForm p = renderDivs $ NewDeck
    <$> areq textField "Name*"       Nothing
-    <*> areq textField "Description" Nothing
+    <*> areq textField "Description*" Nothing
    <*> areq (factoryField p) "Factory*" Nothing
 data NewProject = NewProject
    { npName  :: Text
    , npDesc  :: Text
    , npFactory :: (FedURI, FedURI)
    }
-newProjectForm :: Form NewProject
+newProjectForm :: PersonId -> Form NewProject
-newProjectForm = renderDivs $ NewProject
+newProjectForm p = renderDivs $ NewProject
    <$> areq textField "Name*"       Nothing
-    <*> areq textField "Description" Nothing
+    <*> areq textField "Description*" Nothing
    <*> areq (factoryField p) "Factory*" Nothing
 data NewGroup = NewGroup
    { ngName  :: Text
    , ngDesc  :: Text
    , ngFactory :: (FedURI, FedURI)
    }
-newGroupForm :: Form NewGroup
+newGroupForm :: PersonId -> Form NewGroup
-newGroupForm = renderDivs $ NewGroup
+newGroupForm p = renderDivs $ NewGroup
    <$> areq textField "Name*"       Nothing
-    <*> areq textField "Description" Nothing
+    <*> areq textField "Description*" Nothing
    <*> areq (factoryField p) "Factory*" Nothing
 data NewLoom = NewLoom
    { nlName  :: Text
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@ -57,6 +57,8 @@ import Yesod.Static
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy as BL (ByteString)
 import qualified Data.HashSet as HS
 import qualified Data.HList as H
 import qualified Data.Time.Units as U
 import qualified Database.Esqueleto as E
 import qualified Yesod.Core.Unsafe as Unsafe
@ -680,7 +682,6 @@ instance AccountDB AccountPersistDB' where
                , actorInbox     = ibid
                , actorOutbox    = obid
                , actorFollowers = fsid
                , actorJustCreatedBy = Nothing
                , actorErrbox    = rbid
                }
        aid <- insert actor
@ -719,6 +720,21 @@ instance AccountDB AccountPersistDB' where
                takeMVar mvarResult
        unless success $
            error "Failed to spawn new Person, somehow ID already in Theater"
        AccountPersistDB' $ do
            theater <- asksSite appTheater
            there <- liftIO $ sendIO theater personID PersonMsgInit
            unless there $
                error "Failed to find new Person, somehow ID not in Theater"
            factoryIDs <- runDB $ selectKeysList [] []
            let package = (HS.fromList factoryIDs, FactoryMsgVerified personID)
            liftIO $ sendManyIO theater $
                Nothing `H.HCons`
                Nothing `H.HCons`
                Nothing `H.HCons`
                Nothing `H.HCons`
                Nothing `H.HCons`
                Nothing `H.HCons`
                Just package `H.HCons` H.HNil
    setVerifyKey           = (morphAPDB .) . setVerifyKey
    setNewPasswordKey      = (morphAPDB .) . setNewPasswordKey
    setNewPassword         = (morphAPDB .) . setNewPassword
--- a/src/Vervis/Handler/Deck.hs
+++ b/src/Vervis/Handler/Deck.hs
@ -353,34 +353,31 @@ getDeckMessageR _ _ = notFound
 getDeckNewR :: Handler Html
 getDeckNewR = do
-    ((_result, widget), enctype) <- runFormPost newDeckForm
+    p <- requireAuthId
    ((_result, widget), enctype) <- runFormPost $ newDeckForm p
    defaultLayout $(widgetFile "deck/new")
 postDeckNewR :: Handler Html
 postDeckNewR = do
    NewDeck name desc <- runFormPostRedirect DeckNewR newDeckForm
    personEntity@(Entity personID person) <- requireAuth
    NewDeck name desc (uFactory, uCap) <- runFormPostRedirect DeckNewR $ newDeckForm personID
    personHash <- encodeKeyHashid personID
-    (maybeSummary, audience, detail) <- C.createDeck personHash name desc
+    result <- runExceptT $ do
        (maybeSummary, audience, detail) <- C.createDeck personHash name desc uFactory
        (localRecips, remoteRecips, fwdHosts, action) <-
-        C.makeServerInput Nothing maybeSummary audience $ AP.CreateActivity $ AP.Create (AP.CreateTicketTracker detail Nothing) Nothing
+            lift $
-    result <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.CreateActivity $ AP.Create (AP.CreateTicketTracker detail Nothing) (Just uFactory)
-        runExceptT $
+        cap <- parseActivityURI uCap
-        handleViaActor personID Nothing localRecips remoteRecips fwdHosts action
+        handleViaActor personID (Just cap) localRecips remoteRecips fwdHosts action
    case result of
        Left e -> do
            setMessage $ toHtml e
            redirect DeckNewR
-        Right createID -> do
+        Right _createID -> do
-            maybeDeckID <- runDB $ getKeyBy $ UniqueDeckCreate createID
+            setMessage "Create activity sent"
-            case maybeDeckID of
+            redirect HomeR
                Nothing -> error "Can't find the newly created deck"
                Just deckID -> do
                    deckHash <- encodeKeyHashid deckID
                    setMessage "New ticket tracker created"
                    redirect $ DeckR deckHash
 postDeckDeleteR :: KeyHashid Deck -> Handler Html
 postDeckDeleteR _ = error "Temporarily disabled"
--- a/src/Vervis/Handler/Factory.hs
+++ b/src/Vervis/Handler/Factory.hs
@ -126,12 +126,17 @@ import qualified Vervis.Client as C
 getFactoryR :: KeyHashid Factory -> Handler TypedContent
 getFactoryR factoryHash = do
    factoryID <- decodeKeyHashid404 factoryHash
-    (factory, actor, sigKeyIDs) <- runDB $ do
+    mp <- maybeAuthId
    (factory, actorID, actor, sigKeyIDs, permits) <- runDB $ do
        f <- get404 factoryID
        Resource aid <- getJust $ factoryResource f
        a <- getJust aid
        sigKeys <- selectKeysList [SigKeyActor ==. aid] [Asc SigKeyId]
-        return (f, a, sigKeys)
+        permits <-
            case mp of
                Nothing -> pure []
                Just personID -> getPermitsForResource personID (Left $ factoryResource f)
        return (f, aid, a, sigKeys, permits)
    encodeRouteLocal <- getEncodeRouteLocal
    hashSigKey <- getEncodeKeyHashid
@ -166,7 +171,7 @@ getFactoryR factoryHash = do
                encodeRouteLocal $ FactoryTeamsR factoryHash
            }
-    provideHtmlAndAP factoryAP $ redirectToPrettyJSON $ FactoryR factoryHash
+    provideHtmlAndAP factoryAP $(widgetFile "factory/one")
 grabActorID = fmap resourceActor . getJust . factoryResource
@ -221,7 +226,11 @@ postFactoryNewR = do
            setMessage $ toHtml e
            redirect FactoryNewR
        Right createID -> do
-            maybeFactoryID <- runDB $ getKeyBy $ UniqueFactoryCreate createID
+            maybeFactoryID <- runDB $ runMaybeT $ do
                ActorCreateLocal actorID _ <-
                    MaybeT $ getValBy $ UniqueActorCreateLocalCreate createID
                resourceID <- MaybeT $ getKeyBy $ UniqueResource actorID
                MaybeT $ getKeyBy $ UniqueFactory resourceID
            case maybeFactoryID of
                Nothing -> error "Can't find the newly created factory"
                Just factoryID -> do
--- a/src/Vervis/Handler/Group.hs
+++ b/src/Vervis/Handler/Group.hs
@ -147,34 +147,31 @@ import qualified Vervis.Client as C
 getGroupNewR :: Handler Html
 getGroupNewR = do
-    ((_result, widget), enctype) <- runFormPost newGroupForm
+    p <- requireAuthId
    ((_result, widget), enctype) <- runFormPost $ newGroupForm p
    defaultLayout $(widgetFile "group/new")
 postGroupNewR :: Handler Html
 postGroupNewR = do
    NewGroup name desc <- runFormPostRedirect GroupNewR newGroupForm
    personEntity@(Entity personID person) <- requireAuth
    NewGroup name desc (uFactory, uCap) <- runFormPostRedirect GroupNewR $ newGroupForm personID
    personHash <- encodeKeyHashid personID
-    (maybeSummary, audience, detail) <- C.createGroup personHash name desc
+    result <- runExceptT $ do
        (maybeSummary, audience, detail) <- C.createGroup personHash name desc uFactory
        (localRecips, remoteRecips, fwdHosts, action) <-
-        C.makeServerInput Nothing maybeSummary audience $ AP.CreateActivity $ AP.Create (AP.CreateTeam detail Nothing) Nothing
+            lift $
-    result <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.CreateActivity $ AP.Create (AP.CreateTeam detail Nothing) (Just uFactory)
-        runExceptT $
+        cap <- parseActivityURI uCap
-        handleViaActor personID Nothing localRecips remoteRecips fwdHosts action
+        handleViaActor personID (Just cap) localRecips remoteRecips fwdHosts action
    case result of
        Left e -> do
            setMessage $ toHtml e
            redirect GroupNewR
-        Right createID -> do
+        Right _createID -> do
-            maybeGroupID <- runDB $ getKeyBy $ UniqueGroupCreate createID
+            setMessage "Create activity sent"
-            case maybeGroupID of
+            redirect HomeR
                Nothing -> error "Can't find the newly created group"
                Just groupID -> do
                    groupHash <- encodeKeyHashid groupID
                    setMessage "New group created"
                    redirect $ GroupR groupHash
 getGroupR :: KeyHashid Group -> Handler TypedContent
 getGroupR groupHash = do
--- a/src/Vervis/Handler/Loom.hs
+++ b/src/Vervis/Handler/Loom.hs
@ -362,14 +362,9 @@ postLoomNewR = do
        Left e -> do
            setMessage $ toHtml e
            redirect LoomNewR
-        Right createID -> do
+        Right _createID -> do
-            maybeLoomID <- runDB $ getKeyBy $ UniqueLoomCreate createID
+            setMessage "Create activity sent"
-            case maybeLoomID of
+            redirect HomeR
                Nothing -> error "Can't find the newly created loom"
                Just loomID -> do
                    loomHash <- encodeKeyHashid loomID
                    setMessage "New patch tracker created"
                    redirect $ LoomR loomHash
 getLoomStampR :: KeyHashid Loom -> KeyHashid SigKey -> Handler TypedContent
 getLoomStampR = servePerActorKey loomActor LocalActorLoom
--- a/src/Vervis/Handler/Project.hs
+++ b/src/Vervis/Handler/Project.hs
@ -225,34 +225,31 @@ getProjectMessageR _ _ = notFound
 getProjectNewR :: Handler Html
 getProjectNewR = do
-    ((_result, widget), enctype) <- runFormPost newProjectForm
+    p <- requireAuthId
    ((_result, widget), enctype) <- runFormPost $ newProjectForm p
    defaultLayout $(widgetFile "project/new")
 postProjectNewR :: Handler Html
 postProjectNewR = do
    NewProject name desc <- runFormPostRedirect ProjectNewR newProjectForm
    personEntity@(Entity personID person) <- requireAuth
    NewProject name desc (uFactory, uCap) <- runFormPostRedirect ProjectNewR $ newProjectForm personID
    personHash <- encodeKeyHashid personID
-    (maybeSummary, audience, detail) <- C.createProject personHash name desc
+    result <- runExceptT $ do
        (maybeSummary, audience, detail) <- C.createProject personHash name desc uFactory
        (localRecips, remoteRecips, fwdHosts, action) <-
-        C.makeServerInput Nothing maybeSummary audience $ AP.CreateActivity $ AP.Create (AP.CreateProject detail Nothing) Nothing
+            lift $
-    result <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.CreateActivity $ AP.Create (AP.CreateProject detail Nothing) (Just uFactory)
-        runExceptT $
+        cap <- parseActivityURI uCap
-        handleViaActor personID Nothing localRecips remoteRecips fwdHosts action
+        handleViaActor personID (Just cap) localRecips remoteRecips fwdHosts action
    case result of
        Left e -> do
            setMessage $ toHtml e
            redirect ProjectNewR
-        Right createID -> do
+        Right _createID -> do
-            maybeProjectID <- runDB $ getKeyBy $ UniqueProjectCreate createID
+            setMessage "Create activity sent"
-            case maybeProjectID of
+            redirect HomeR
                Nothing -> error "Can't find the newly created project"
                Just projectID -> do
                    projectHash <- encodeKeyHashid projectID
                    setMessage "New project created"
                    redirect $ ProjectR projectHash
 getProjectStampR :: KeyHashid Project -> KeyHashid SigKey -> Handler TypedContent
 getProjectStampR = servePerActorKey projectActor LocalActorProject
--- a/src/Vervis/Handler/Repo.hs
+++ b/src/Vervis/Handler/Repo.hs
@ -472,14 +472,9 @@ postRepoNewR = do
        Left e -> do
            setMessage $ toHtml e
            redirect RepoNewR
-        Right createID -> do
+        Right _createID -> do
-            maybeRepoID <- runDB $ getKeyBy $ UniqueRepoCreate createID
+            setMessage "Create activity sent"
-            case maybeRepoID of
+            redirect HomeR
                Nothing -> error "Can't find the newly created repo"
                Just repoID -> do
                    repoHash <- encodeKeyHashid repoID
                    setMessage "New repository created"
                    redirect $ RepoR repoHash
 postRepoDeleteR :: KeyHashid Repo -> Handler Html
 postRepoDeleteR repoHash = do
--- a/src/Vervis/Migration.hs
+++ b/src/Vervis/Migration.hs
@ -3850,6 +3850,69 @@ changes hLocal ctx =
    , addEntities model_648_report
      -- 649
    , addEntities model_649_factory
      -- 650
    , addEntities model_650_fulfills_resident
      -- 651
    , unchecked $ lift $ do
        ps <- selectList [Person651Verified ==. True] []
        let doc = persistJSONObjectFromDoc $ Doc hLocal emptyActivity
        for_ ps $ \ (Entity pid p) -> do
            let aid = person651Actor p
            obid <- actor651Outbox <$> getJust aid
            createID <- insert $ OutboxItem651 obid doc defaultTime
            insert_ $ ActorCreateLocal651 aid createID
        rs <- map entityVal <$> selectList [] []
        ds <- map entityVal <$> selectList [] []
        ls <- map entityVal <$> selectList [] []
        js <- map entityVal <$> selectList [] []
        gs <- map entityVal <$> selectList [] []
        let l = concat
                    [ map (\ r -> (repo651Actor r,    repo651Create r)) rs
                    , map (\ d -> (deck651Actor d,    deck651Create d)) ds
                    , map (\ l -> (loom651Actor l,    loom651Create l)) ls
                    , map (\ j -> (project651Actor j, project651Create j)) js
                    , map (\ g -> (group651Actor g,   group651Create g)) gs
                    ]
        insertMany_ $ map (uncurry ActorCreateLocal651) l
        {-
        inboxID <- insert Inbox651
        errboxID <- insert Inbox651
        outboxID <- insert Outbox651
        fsID <- insert FollowerSet651
        actorID <- insert $ Actor651 "Default factory" "" defaultTime inboxID outboxID fsID Nothing errboxID
        resourceID <- insert $ Resource651 actorID
        createID <- insert $ OutboxItem651 outboxID doc defaultTime
        insert_ $ Factory651 resourceID createID
        insert_ $ ActorCreateLocal651 actorID createID
        -}
      -- 652
    , removeField "Actor" "justCreatedBy"
      -- 653
    , removeUnique' "Deck" "Create"
      -- 654
    , removeUnique' "Loom" "Create"
      -- 655
    , removeUnique' "Repo" "Create"
      -- 656
    , removeUnique' "Project" "Create"
      -- 657
    , removeUnique' "Group" "Create"
      -- 658
    , removeUnique' "Factory" "Create"
      -- 659
    , removeField "Deck" "create"
      -- 660
    , removeField "Loom" "create"
      -- 661
    , removeField "Repo" "create"
      -- 662
    , removeField "Project" "create"
      -- 663
    , removeField "Group" "create"
      -- 664
    , removeField "Factory" "create"
    ]
 migrateDB
--- a/src/Vervis/Migration/Entities.hs
+++ b/src/Vervis/Migration/Entities.hs
@ -80,6 +80,7 @@ module Vervis.Migration.Entities
    , model_639_component_convey
    , model_648_report
    , model_649_factory
    , model_650_fulfills_resident
    )
 where
@ -315,3 +316,6 @@ model_648_report = $(schema "648_2024-07-06_report")
 model_649_factory :: [Entity SqlBackend]
 model_649_factory = $(schema "649_2024-07-29_factory")
 model_650_fulfills_resident :: [Entity SqlBackend]
 model_650_fulfills_resident = $(schema "650_2024-08-03_fulfills_resident")
--- a/src/Vervis/Migration/Model2024.hs
+++ b/src/Vervis/Migration/Model2024.hs
@ -80,3 +80,6 @@ makeEntitiesMigration "630"
 makeEntitiesMigration "634"
    $(modelFile "migrations/634_2024-04-29_stem_holder.model")
 makeEntitiesMigration "651"
    $(modelFile "migrations/651_2024-08-03_actor_create.model")
--- a/src/Vervis/Persist/Actor.hs
+++ b/src/Vervis/Persist/Actor.hs
@ -273,7 +273,7 @@ getRemoteActivityURI act = do
    object <- getJust $ remoteActivityIdent act
    getRemoteObjectURI object
-insertActor now name desc mby = do
+insertActor now name desc create = do
    ibid <- insert Inbox
    rbid <- insert Inbox
    obid <- insert Outbox
@ -285,10 +285,12 @@ insertActor now name desc mby = do
            , actorInbox     = ibid
            , actorOutbox    = obid
            , actorFollowers = fsid
            , actorJustCreatedBy = mby
            , actorErrbox    = rbid
            }
    actorID <- insert actor
    case create of
        Left (_, _, obiid) -> insert_ $ ActorCreateLocal actorID obiid
        Right (ra, _, act) -> insert_ $ ActorCreateRemote actorID act (VA.remoteAuthorId ra)
    return $ Entity actorID actor
 updateOutboxItem
--- a/src/Vervis/Settings.hs
+++ b/src/Vervis/Settings.hs
@ -158,6 +158,12 @@ data AppSettings = AppSettings
    , appMail                   :: Maybe MailSettings
      -- | People's usernames who are allowed to create Factory actors
    , appCanCreateFactories     :: [Text]
      -- | KeyHashids of local Factory actors who will auto-send a
      -- develop-Grant to every newly created account.
      --
      -- If empty, and there's exactly 1 local factory in DB, it will
      -- automatically become the resident.
    , appResidentFactories      :: [Text]
      -- | Whether to support federation. This includes:
      --
@ -257,6 +263,7 @@ instance FromJSON AppSettings where
        appEmailVerification      <- o .:? "email-verification" .!= not defaultDev
        appMail                   <- o .:? "mail"
        appCanCreateFactories     <- o .:? "can-create-factories" .!= []
        appResidentFactories      <- o .:? "resident-factories" .!= []
        appFederation               <- o .:? "federation" .!= False
        appCapabilitySigningKeyFile <- o .: "capability-signing-key"
--- a/src/Web/ActivityPub.hs
+++ b/src/Web/ActivityPub.hs
@ -2005,6 +2005,7 @@ data CreateObject u
    | CreateProject ActorDetail (Maybe (Authority u, ActorLocal u))
    | CreateTeam ActorDetail (Maybe (Authority u, ActorLocal u))
    | CreateFactory ActorDetail (Maybe (Authority u, ActorLocal u))
    | CreatePerson ActorDetail (Maybe (Authority u, ActorLocal u))
 parseCreateObject :: UriMode u => Object -> Parser (CreateObject u)
 parseCreateObject o
@ -2042,6 +2043,11 @@ parseCreateObject o
                fail "type isn't Factory"
            ml <- parseActorLocal o
            return $ CreateFactory f ml
    <|> do  f <- parseActorDetail o
            unless (actorType f == ActorTypePerson) $
                fail "type isn't Person"
            ml <- parseActorLocal o
            return $ CreatePerson f ml
 encodeCreateObject :: UriMode u => CreateObject u -> Series
 encodeCreateObject (CreateNote h note) = toSeries h note
@ -2062,10 +2068,12 @@ encodeCreateObject (CreateTeam d ml) =
    encodeActorDetail d <> maybe mempty (uncurry encodeActorLocal) ml
 encodeCreateObject (CreateFactory d ml) =
    encodeActorDetail d <> maybe mempty (uncurry encodeActorLocal) ml
 encodeCreateObject (CreatePerson d ml) =
    encodeActorDetail d <> maybe mempty (uncurry encodeActorLocal) ml
 data Create u = Create
    { createObject :: CreateObject u
-    , createTarget :: Maybe (ObjURI u)
+    , createOrigin :: Maybe (ObjURI u)
    }
 parseCreate :: UriMode u => Object -> Authority u -> LocalURI -> Parser (Create u)
@ -2084,12 +2092,13 @@ parseCreate o a luActor = do
        CreateProject _ _ -> return ()
        CreateTeam _ _ -> return ()
        CreateFactory _ _ -> return ()
-    Create obj <$> o .:? "target"
+        CreatePerson _ _ -> return ()
    Create obj <$> o .:? "origin"
 encodeCreate :: UriMode u => Create u -> Series
-encodeCreate (Create obj target)
+encodeCreate (Create obj origin)
    =  "object" `pair` pairs (encodeCreateObject obj)
-    <> "target" .=?    target
+    <> "origin" .=?    origin
 data Follow u = Follow
    { followObject  :: ObjURI u
--- a/src/Web/Actor/Deliver.hs
+++ b/src/Web/Actor/Deliver.hs
@ -236,4 +236,4 @@ sendHttp (DeliveryTheater manager headers micros logFunc root theater) method re
    for_ recips $ \ u ->
        let makeEnv = either throwIO pure (TE.decodeUtf8' $ urlEncode False $ TE.encodeUtf8 $ renderObjURI u) >>= encodeUtf . (root </>) . T.unpack >>= mkEnv (manager, headers, micros) logFunc
        in  void $ spawnIO theater u makeEnv
-    sendManyIO theater $ (HS.fromList recips, method) `H.HCons` H.HNil
+    sendManyIO theater $ Just (HS.fromList recips, method) `H.HCons` H.HNil
--- a/templates/default-layout.hamlet
+++ b/templates/default-layout.hamlet
@ -17,7 +17,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
    <div>
      $if verified
        <span>
-          [You are logged in as
+          [You are logged in as #
          $if can
            <span>👑
          <span .username>#{personLogin person}</span>]
--- a/templates/factory/one.hamlet
+++ b/templates/factory/one.hamlet
@ -0,0 +1,19 @@
 $# This file is part of Vervis.
 $#
 $# Written in 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/>.
 ^{factoryNavW (Entity factoryID factory) actor}
 ^{followW' $ Left actorID}
 ^{personPermitsForResourceW permits}
--- a/th/models
+++ b/th/models
@ -126,13 +126,27 @@ Actor
    inbox     InboxId
    outbox    OutboxId
    followers FollowerSetId
    justCreatedBy ActorId Maybe
    errbox    InboxId
    UniqueActorInbox     inbox
    UniqueActorOutbox    outbox
    UniqueActorFollowers followers
 ActorCreateLocal
    actor  ActorId
    create OutboxItemId
    UniqueActorCreateLocalActor  actor
    UniqueActorCreateLocalCreate create
 ActorCreateRemote
    actor  ActorId
    create RemoteActivityId
    sender RemoteActorId
    UniqueActorCreateRemoteActor  actor
    UniqueActorCreateRemoteCreate create
 SigKey
    actor    ActorId
    material ActorKey
@ -169,10 +183,8 @@ Komponent
 Factory
    resource ResourceId
    create   OutboxItemId
    UniqueFactory       resource
    UniqueFactoryCreate create
 -- ========================================================================= --
 -- Delivery
@ -297,10 +309,8 @@ SshKey
 Group
    actor    ActorId
    resource ResourceId
    create   OutboxItemId
    UniqueGroupActor  actor
    UniqueGroupCreate create
 GroupMember
    person PersonId
@ -317,10 +327,8 @@ GroupMember
 Project
    actor    ActorId
    resource ResourceId
    create   OutboxItemId
    UniqueProjectActor  actor
    UniqueProjectCreate create
 Deck
    actor      ActorId
@ -329,10 +337,8 @@ Deck
    workflow   WorkflowId
    nextTicket Int
    wiki       RepoId        Maybe
    create     OutboxItemId
    UniqueDeckActor  actor
    UniqueDeckCreate create
 Loom
    nextTicket Int
@ -340,11 +346,9 @@ Loom
    resource   ResourceId
    komponent  KomponentId
    repo       RepoId
    create     OutboxItemId
    UniqueLoomActor  actor
    UniqueLoomRepo   repo
    UniqueLoomCreate create
 Repo
    vcs        VersionControlSystem
@ -353,11 +357,9 @@ Repo
    actor      ActorId
    resource   ResourceId
    komponent  KomponentId
    create     OutboxItemId
    loom       LoomId               Maybe
    UniqueRepoActor  actor
    UniqueRepoCreate create
 -- I removed the 'sharer' field so Workflows don't specify who controls them
 -- For now there's no way to create new ones, and what's already in the DB can
@ -624,6 +626,11 @@ CollabFulfillsLocalTopicCreation
    UniqueCollabFulfillsLocalTopicCreation collab
 CollabFulfillsResidentFactory
    collab CollabId
    UniqueCollabFulfillsResidentFactory collab
 CollabFulfillsInvite
    collab CollabId
    accept OutboxItemId
@ -776,6 +783,11 @@ PermitFulfillsTopicCreation
    UniquePermitFulfillsTopicCreation permit
 PermitFulfillsResidentFactory
    permit PermitId
    UniquePermitFulfillsResidentFactory permit
 PermitFulfillsInvite
    permit PermitId
@ -792,6 +804,7 @@ PermitFulfillsJoin
 -- Invite: Witnesses their approval, seeing the topic's accept, and then
 --         sending their own accept
 -- Create: Records the Create activity that created the topic
 -- Factory: Records the self-Create the Person published
 PermitPersonGesture
    permit   PermitId
@ -852,6 +865,8 @@ PermitTopicAcceptRemote
 -- Invite: Seeing existing-collaborator's Invite and new-collaborator's Accept,
 --         the topic has made the link official and sent a direct-grant
 -- Create: Upon being created, topic has sent its creator an admin-Grant
 -- Factory: A factory that became active sent me a Grant (usually because I've
 --          just created a new account)
 PermitTopicEnableLocal
    permit PermitPersonGestureId