UI, C2S, S2S: Factory: Make allowed types editable

I added a new activity type, Patch. There's already a ForgeFed type with
the same name, used for representing patches of course. Perhaps the
duplication will work, since these types are used in different
situations. I'd happily change to Edit, but Patch may become the
standard name in Fediverse software. So let's go with that.

src/Vervis/Actor/Factory.hs

@@ -1149,7 +1149,7 @@ factoryCreate now factoryID verse (AP.Create obj muOrigin) = do
                 throwE "This Create-Team isn't for me"
             factoryCreateNew NATeam now factoryID verse detail
 
-        AP.CreateFactory _ mlocal -> do
+        AP.CreateFactory _ mlocal _ -> do
             (h, local) <- fromMaybeE mlocal "No factory id provided"
             let luFactory = AP.actorId local
             unless (uMe == ObjURI h luFactory) $
@@ -1823,6 +1823,107 @@ factoryJoin
     -> ActE (Text, Act (), Next)
 factoryJoin = topicJoin factoryResource LocalResourceFactory
 
+-- Meaning: An actor is asking to update an object
+-- Behavior:
+--      * Verify I'm the object being patched
+--      * Verify sender is authorized
+--      * Insert the Patch to my inbox
+--      * Update my available types in DB
+--      * Forward the Patch to my followers
+--      * Send Accept to sender & to my followers
+factoryPatch
+    :: UTCTime
+    -> FactoryId
+    -> Verse
+    -> AP.Patch' URIMode
+    -> ActE (Text, Act (), Next)
+factoryPatch now factoryMeID (Verse authorIdMsig body) patch = do
+
+    -- Verify that a capability is provided
+    uCap <- do
+        let muCap = AP.activityCapability $ actbActivity body
+        fromMaybeE muCap "No capability provided"
+
+    -- Check patch activity
+    types <- do
+        routeOrRemote <- parseFedURI $ AP.patchObject patch
+        actorOrRemote <- bitraverse parseLocalActorE' pure routeOrRemote
+        case actorOrRemote of
+            Left (LocalActorFactory f) | f == factoryMeID ->
+                return $ AP.patchAvailableActorTypes patch
+            _ -> throwE "Patch.object isn't me"
+
+    -- Verify the specified capability gives relevant access
+    verifyCapability''
+        uCap authorIdMsig (LocalResourceFactory factoryMeID) AP.RoleAdmin
+
+    maybeNew <- withDBExcept $ do
+
+        -- Grab me from DB
+        resourceID <- lift $ factoryResource <$> getJust factoryMeID
+        Resource actorMeID <- lift $ getJust resourceID
+        actorMe <- lift $ getJust actorMeID
+
+        maybePatchDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorMe) False
+        lift $ for maybePatchDB $ \ (inboxItemID, _patchDB) -> do
+
+            -- Update my fields in DB
+            update factoryMeID
+                [ FactoryAllowDeck    =. (AP.ActorTypeTicketTracker `elem` types)
+                , FactoryAllowProject =. (AP.ActorTypeProject       `elem` types)
+                , FactoryAllowTeam    =. (AP.ActorTypeTeam          `elem` types)
+                ]
+
+            -- Prepare forwarding Invite to my followers
+            sieve <- do
+                factoryHash <- encodeKeyHashid factoryMeID
+                return $ makeRecipientSet [] [LocalStageFactoryFollowers factoryHash]
+
+            -- Prepare an Accept activity and insert to my outbox
+            accept@(actionAccept, _, _, _) <- prepareAccept
+            acceptID <- insertEmptyOutboxItem' (actorOutbox actorMe) now
+            _luAccept <- updateOutboxItem' (LocalActorFactory factoryMeID) acceptID actionAccept
+
+            return (actorMeID, sieve, acceptID, accept, inboxItemID)
+
+    case maybeNew of
+        Nothing -> done "I already have this activity in my inbox"
+        Just (actorMeID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
+            forwardActivity
+                authorIdMsig body (LocalActorFactory factoryMeID) actorMeID sieve
+            lift $ sendActivity
+                (LocalActorFactory factoryMeID) actorMeID localRecipsAccept
+                remoteRecipsAccept fwdHostsAccept acceptID actionAccept
+            doneDB inboxItemID "Recorded and forwarded the Patch, updated fields, sent an Accept"
+
+    where
+
+    prepareAccept = do
+        encodeRouteHome <- getEncodeRouteHome
+
+        audSender <- lift $ makeAudSenderOnly authorIdMsig
+        audMe <-
+            AudLocal [] . pure . LocalStageFactoryFollowers <$>
+                encodeKeyHashid factoryMeID
+        uPatch <- lift $ getActivityURI authorIdMsig
+
+        let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
+                collectAudience [audSender, audMe]
+
+            recips = map encodeRouteHome audLocal ++ audRemote
+            action = AP.Action
+                { AP.actionCapability = Nothing
+                , AP.actionSummary    = Nothing
+                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
+                , AP.actionFulfills   = [uPatch]
+                , AP.actionSpecific   = AP.AcceptActivity AP.Accept
+                    { AP.acceptObject   = uPatch
+                    , AP.acceptResult   = Nothing
+                    }
+                }
+
+        return (action, recipientSet, remoteActors, fwdHosts)
+
 -- Meaning: An actor A is removing actor B from collection C
 -- Behavior:
 --      * If C is my collaborators collection:
@@ -2542,6 +2643,7 @@ factoryBehavior now factoryID (FactoryMsgVerse verse@(Verse _authorIdMsig body))
         AP.GrantActivity grant -> factoryGrant now factoryID verse grant
         AP.InviteActivity invite -> factoryInvite now factoryID verse invite
         AP.JoinActivity join -> factoryJoin now factoryID verse join
+        AP.PatchActivity patch -> factoryPatch now factoryID verse patch
         AP.RemoveActivity remove -> factoryRemove now factoryID verse remove
         AP.RevokeActivity revoke -> factoryRevoke now factoryID verse revoke
         _ -> throwE "Unsupported activity type for Factory"

src/Vervis/Actor/Person/Client.hs

@@ -436,8 +436,9 @@ clientCreateFactory
     -> PersonId
     -> ClientMsg
     -> AP.ActorDetail
+    -> [AP.ActorType]
     -> ActE OutboxItemId
-clientCreateFactory now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) detail = do
+clientCreateFactory now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) detail types = do
 
     -- Check input
     verifyNothingE maybeCap "Capability not needed"
@@ -532,9 +533,9 @@ clientCreateFactory now personMeID (ClientMsg maybeCap localRecips remoteRecips
         rid <- insert $ Resource aid
         fid <- insert Factory
             { factoryResource     = rid
-            , factoryAllowDeck    = True
+            , factoryAllowDeck    = AP.ActorTypeTicketTracker `elem` types
-            , factoryAllowProject = True
+            , factoryAllowProject = AP.ActorTypeProject `elem` types
-            , factoryAllowTeam    = True
+            , factoryAllowTeam    = AP.ActorTypeTeam `elem` types
             }
         return (fid, rid, actorFollowers a)
 
@@ -556,8 +557,19 @@ clientCreateFactory now personMeID (ClientMsg maybeCap localRecips remoteRecips
                 , AP.actorPublicKeys = []
                 , AP.actorSshKeys    = []
                 }
+            types' =
+                mapMaybe
+                (\ typ ->
+                    if typ `elem` types
+                        then Just typ
+                        else Nothing
+                )
+                [ AP.ActorTypeTicketTracker
+                , AP.ActorTypeProject
+                , AP.ActorTypeTeam
+                ]
             specific = AP.CreateActivity AP.Create
-                { AP.createObject = AP.CreateFactory ttdetail (Just (hLocal, ttlocal))
+                { AP.createObject = AP.CreateFactory ttdetail (Just (hLocal, ttlocal)) types'
                 , AP.createOrigin = Nothing
                 }
         return action { AP.actionSpecific = specific }
@@ -609,10 +621,10 @@ clientCreate now personMeID msg (AP.Create object muOrigin) =
             uOrigin <- fromMaybeE muOrigin "'origin' required for Create TicketTracker"
             clientCreateActor now personMeID msg detail uOrigin
 
-        AP.CreateFactory detail mlocal -> do
+        AP.CreateFactory detail mlocal types -> do
             verifyNothingE mlocal "Factory id must not be provided"
             verifyNothingE muOrigin "'target' not supported in Create Factory"
-            clientCreateFactory now personMeID msg detail
+            clientCreateFactory now personMeID msg detail types
 
         _ -> throwE "Unsupported Create object for C2S"
 
@@ -975,6 +987,52 @@ clientOffer now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts
         fwdHosts offerID action
     return offerID
 
+-- Meaning: The human is asking to edit a factory
+-- Behavior:
+--      * Make sure factory is addressed
+--      * Insert to my inbox
+--      * Deliver without filtering
+clientPatch
+    :: UTCTime
+    -> PersonId
+    -> ClientMsg
+    -> AP.Patch' URIMode
+    -> ActE OutboxItemId
+clientPatch now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) patch = do
+
+    -- Parse input
+    object <- do
+        routeOrRemote <- parseFedURI $ AP.patchObject patch
+        bitraverse parseLocalActorE' pure routeOrRemote
+
+    -- Verify object is addressed
+    bitraverse_
+        (verifyActorAddressed localRecips)
+        (verifyRemoteAddressed remoteRecips)
+        object
+
+    (actorMeID, localRecipsFinal, patchID) <- withDBExcept $ do
+
+        -- Grab me from DB
+        (personMe, actorMe) <- lift $ do
+            p <- getJust personMeID
+            (p,) <$> getJust (personActor p)
+
+        -- Insert the Patch activity to my outbox
+        patchID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now
+        _luPatch <- lift $ updateOutboxItem' (LocalActorPerson personMeID) patchID action
+
+        return
+            ( personActor personMe
+            , localRecips
+            , patchID
+            )
+
+    lift $ sendActivity
+        (LocalActorPerson personMeID) actorMeID localRecipsFinal remoteRecips
+        fwdHosts patchID action
+    return patchID
+
 -- Meaning: The human wants to remove someone A from a resource R
 -- Behavior:
 --      * Some basic sanity checks
@@ -1162,6 +1220,7 @@ clientBehavior now personID msg =
         AP.InviteActivity invite -> clientInvite now personID msg invite
         AP.JoinActivity join     -> clientJoin now personID msg join
         AP.OfferActivity offer   -> clientOffer now personID msg offer
+        AP.PatchActivity patch   -> clientPatch now personID msg patch
         AP.RemoveActivity remove -> clientRemove now personID msg remove
         AP.ResolveActivity resolve -> clientResolve now personID msg resolve
         AP.UndoActivity undo     -> clientUndo now personID msg undo

src/Vervis/Client.hs

@@ -48,6 +48,7 @@ module Vervis.Client
     , acceptProjectInvite
     , acceptPersonalInvite
     , acceptParentChild
+    , editFactory
     )
 where
 
@@ -75,7 +76,7 @@ import qualified Data.Text.Lazy as TL
 
 import Development.PatchMediaType
 import Network.FedURI
-import Web.ActivityPub hiding (Follow, Ticket, Project (..), Repo, ActorLocal (..))
+import Web.ActivityPub hiding (Follow, Ticket, Project (..), Repo, ActorLocal (..), Factory)
 import Web.Text
 import Yesod.ActivityPub
 import Yesod.FedURI
@@ -1624,3 +1625,23 @@ acceptParentChild personID uAdd uParent uChild = do
         audience = [audParent, audChild, audAuthor]
 
     return (Nothing, audience, activity)
+
+editFactory
+    :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
+    => KeyHashid Person
+    -> KeyHashid Factory
+    -> [AP.ActorType]
+    -> m (Maybe HTML, [Aud URIMode], AP.Patch' URIMode)
+editFactory senderHash factoryHash types = do
+    encodeRouteHome <- getEncodeRouteHome
+    let audAuthor =
+            AudLocal [] [LocalStagePersonFollowers senderHash]
+        audFactory =
+            AudLocal [LocalActorFactory factoryHash] [LocalStageFactoryFollowers factoryHash]
+
+        audience = [audAuthor, audFactory]
+
+        uFactory = encodeRouteHome $ FactoryR factoryHash
+        patch = AP.Patch' uFactory types
+
+    return (Nothing, audience, patch)

src/Vervis/Foundation.hs

@@ -1148,6 +1148,7 @@ instance YesodBreadcrumbs App where
         FactoryMessageR f m -> ("Message #" <> keyHashidText m, Just $ FactoryR f)
 
         FactoryNewR        -> ("New Factory", Just HomeR)
+        FactoryEditR f     -> ("Edit", Just $ FactoryR f)
 
         FactoryStampR f k -> ("Stamp #" <> keyHashidText k, Just $ FactoryR f)
 

src/Vervis/Handler/Factory.hs

@@ -27,6 +27,7 @@ module Vervis.Handler.Factory
 
     , getFactoryNewR
     , postFactoryNewR
+    , postFactoryEditR
 
     , getFactoryStampR
 
@@ -54,7 +55,7 @@ import Data.Bitraversable
 import Data.ByteString (ByteString)
 import Data.Default.Class
 import Data.Foldable
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe
 import Data.Text (Text)
 import Data.Time.Clock
 import Data.Traversable
@@ -138,6 +139,20 @@ getFactoryR factoryHash = do
                 Just personID -> getPermitsForResource personID (Left $ factoryResource f)
         return (f, aid, a, sigKeys, permits)
 
+    let defTypes =
+            mapMaybe
+            (\ (allow, typ) ->
+                if allow factory
+                    then Just typ
+                    else Nothing
+            )
+            [ (factoryAllowDeck   , AP.ActorTypeTicketTracker)
+            , (factoryAllowProject, AP.ActorTypeProject)
+            , (factoryAllowTeam   , AP.ActorTypeTeam)
+            ]
+    ((_result, widget), enctype) <-
+        runFormPost $ renderDivs $ areq typeField "Allowed types" (Just defTypes)
+
     encodeRouteLocal <- getEncodeRouteLocal
     hashSigKey <- getEncodeKeyHashid
     perActor <- asksSite $ appPerActorKeys . appSettings
@@ -169,6 +184,17 @@ getFactoryR factoryHash = do
                 encodeRouteLocal $ FactoryCollabsR factoryHash
             , AP.factoryTeams =
                 encodeRouteLocal $ FactoryTeamsR factoryHash
+            , AP.factoryTypes =
+                mapMaybe
+                (\ (allow, typ) ->
+                    if allow factory
+                        then Just typ
+                        else Nothing
+                )
+                [ (factoryAllowDeck   , AP.ActorTypeTicketTracker)
+                , (factoryAllowProject, AP.ActorTypeProject)
+                , (factoryAllowTeam   , AP.ActorTypeTeam)
+                ]
             }
 
     provideHtmlAndAP factoryAP $(widgetFile "factory/one")
@@ -199,9 +225,20 @@ getFactoryFollowersR = getActorFollowersCollection' FactoryFollowersR grabActorI
 getFactoryMessageR :: KeyHashid Factory -> KeyHashid LocalMessage -> Handler Html
 getFactoryMessageR _ _ = notFound
 
-newFactoryForm = renderDivs $ (,)
+typeField =
-    <$> areq textField "Name*"       Nothing
+    checkboxesFieldList
-    <*> areq textField "Description" Nothing
+        [ ("Ticket Tracker", AP.ActorTypeTicketTracker)
+            :: (Text, AP.ActorType)
+        , ("Project", AP.ActorTypeProject)
+        , ("Team", AP.ActorTypeTeam)
+        ]
+
+allTypes = [AP.ActorTypeTicketTracker, AP.ActorTypeProject, AP.ActorTypeTeam]
+
+newFactoryForm = renderDivs $ (,,)
+    <$> areq textField "Name*"        Nothing
+    <*> areq textField "Description*" Nothing
+    <*> areq typeField "Allowed types*" (Just allTypes)
 
 getFactoryNewR :: Handler Html
 getFactoryNewR = do
@@ -210,13 +247,13 @@ getFactoryNewR = do
 
 postFactoryNewR :: Handler Html
 postFactoryNewR = do
-    (name, desc) <- runFormPostRedirect FactoryNewR newFactoryForm
+    (name, desc, types) <- runFormPostRedirect FactoryNewR newFactoryForm
 
     personEntity@(Entity personID person) <- requireAuth
     personHash <- encodeKeyHashid personID
     (maybeSummary, audience, detail) <- C.createFactory personHash name desc
     (localRecips, remoteRecips, fwdHosts, action) <-
-        C.makeServerInput Nothing maybeSummary audience $ AP.CreateActivity $ AP.Create (AP.CreateFactory detail Nothing) Nothing
+        C.makeServerInput Nothing maybeSummary audience $ AP.CreateActivity $ AP.Create (AP.CreateFactory detail Nothing types) Nothing
     result <-
         runExceptT $
         handleViaActor personID Nothing localRecips remoteRecips fwdHosts action
@@ -238,6 +275,37 @@ postFactoryNewR = do
                     setMessage "New factory created"
                     redirect $ FactoryR factoryHash
 
+postFactoryEditR :: KeyHashid Factory -> Handler Html
+postFactoryEditR factoryHash = do
+    factoryID <- decodeKeyHashid404 factoryHash
+    types <-
+        runFormPostRedirect (FactoryR factoryHash) $
+            renderDivs $ areq typeField "Allowed types" (Just allTypes)
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    (maybeSummary, audience, patch) <- C.editFactory personHash factoryHash types
+    result <- runExceptT $ do
+        cap <- do
+            maybeItem <- lift $ runDB $ do
+                resourceID <- factoryResource <$> get404 factoryID
+                getCapability personID (Left resourceID) AP.RoleAdmin
+            fromMaybeE maybeItem "You need to be have Admin access to the Factory to edit settings"
+        uCap <- lift $ renderActivityURI cap
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            lift $
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.PatchActivity patch
+        let cap' = first (\ (la, i) -> (la, error "lah", i)) cap
+        handleViaActor
+            personID (Just cap') localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> do
+            setMessage $ toHtml e
+            redirect $ FactoryR factoryHash
+        Right _itemID -> do
+            setMessage "Patch activity sent"
+            redirect $ FactoryR factoryHash
+
 getFactoryStampR :: KeyHashid Factory -> KeyHashid SigKey -> Handler TypedContent
 getFactoryStampR = servePerActorKey'' grabActorID LocalActorFactory
 

src/Vervis/Persist/Collab.hs

@@ -1340,7 +1340,7 @@ getCapability personID actor role = do
                     E.where_ $
                         permit E.^. PermitPerson E.==. E.val personID E.&&.
                         topic E.^. PermitTopicLocalTopic E.==. E.val resourceID E.&&.
-                        permit E.^. PermitRole E.>=. E.val role
+                        permit E.^. PermitRole `E.in_` E.valList [role .. maxBound]
                     E.orderBy [E.desc $ enable E.^. PermitTopicEnableLocalId]
                     E.limit 1
                     return $ enable E.^. PermitTopicEnableLocalGrant

src/Web/ActivityPub.hs

@@ -93,6 +93,7 @@ module Web.ActivityPub
     , Join (..)
     , OfferObject (..)
     , Offer (..)
+    , Patch' (..)
     , Push (..)
     , Reject (..)
     , Remove (..)
@@ -1102,6 +1103,7 @@ data Factory u = Factory
     { factoryActor   :: Actor u
     , factoryCollabs :: LocalURI
     , factoryTeams   :: LocalURI
+    , factoryTypes   :: [ActorType]
     }
 
 instance ActivityPub Factory where
@@ -1114,10 +1116,12 @@ instance ActivityPub Factory where
             Factory a
                 <$> withAuthorityO h (o .: "collaborators")
                 <*> withAuthorityO h (o .: "teams")
-    toSeries h (Factory actor collabs teams)
+                <*> (o .: "availableActorTypes")
+    toSeries h (Factory actor collabs teams types)
         =  toSeries h actor
-        <> "collaborators" .= ObjURI h collabs
+        <> "collaborators"       .= ObjURI h collabs
-        <> "teams"         .= ObjURI h teams
+        <> "teams"               .= ObjURI h teams
+        <> "availableActorTypes" .= types
 
 data Audience u = Audience
     { audienceTo        :: [ObjURI u]
@@ -2004,7 +2008,7 @@ data CreateObject u
     | CreatePatchTracker ActorDetail (NonEmpty (ObjURI u)) (Maybe (Authority u, ActorLocal u))
     | CreateProject ActorDetail (Maybe (Authority u, ActorLocal u))
     | CreateTeam ActorDetail (Maybe (Authority u, ActorLocal u))
-    | CreateFactory ActorDetail (Maybe (Authority u, ActorLocal u))
+    | CreateFactory ActorDetail (Maybe (Authority u, ActorLocal u)) [ActorType]
     | CreatePerson ActorDetail (Maybe (Authority u, ActorLocal u))
 
 parseCreateObject :: UriMode u => Object -> Parser (CreateObject u)
@@ -2042,7 +2046,8 @@ parseCreateObject o
             unless (actorType f == ActorTypeFactory) $
                 fail "type isn't Factory"
             ml <- parseActorLocal o
-            return $ CreateFactory f ml
+            types <- o .: "availableActorTypes"
+            return $ CreateFactory f ml types
     <|> do  f <- parseActorDetail o
             unless (actorType f == ActorTypePerson) $
                 fail "type isn't Person"
@@ -2066,8 +2071,9 @@ encodeCreateObject (CreateProject d ml) =
     encodeActorDetail d <> maybe mempty (uncurry encodeActorLocal) ml
 encodeCreateObject (CreateTeam d ml) =
     encodeActorDetail d <> maybe mempty (uncurry encodeActorLocal) ml
-encodeCreateObject (CreateFactory d ml) =
+encodeCreateObject (CreateFactory d ml types) =
-    encodeActorDetail d <> maybe mempty (uncurry encodeActorLocal) ml
+    encodeActorDetail d <> maybe mempty (uncurry encodeActorLocal) ml <>
+    "availableActorTypes" .= types
 encodeCreateObject (CreatePerson d ml) =
     encodeActorDetail d <> maybe mempty (uncurry encodeActorLocal) ml
 
@@ -2091,7 +2097,7 @@ parseCreate o a luActor = do
         CreatePatchTracker _ _ _ -> return ()
         CreateProject _ _ -> return ()
         CreateTeam _ _ -> return ()
-        CreateFactory _ _ -> return ()
+        CreateFactory _ _ _ -> return ()
         CreatePerson _ _ -> return ()
     Create obj <$> o .:? "origin"
 
@@ -2238,6 +2244,21 @@ encodeOffer authority actor (Offer obj target)
     =  "object" `pair` pairs (toSeries authority obj)
     <> "target" .= target
 
+data Patch' u = Patch'
+    { patchObject :: ObjURI u
+    , patchAvailableActorTypes :: [ActorType]
+    }
+
+parsePatch' :: UriMode u => Object-> Parser (Patch' u)
+parsePatch' o = Patch'
+    <$> o .: "object"
+    <*> o .: "availableActorTypes"
+
+encodePatch' :: UriMode u => Patch' u -> Series
+encodePatch' (Patch' obj types)
+    =  "object"              .= obj
+    <> "availableActorTypes" .= types
+
 data Push u = Push
     { pushCommitsLast  :: NonEmpty (Commit u)
     , pushCommitsFirst :: Maybe (NonEmpty (Commit u))
@@ -2401,6 +2422,7 @@ data SpecificActivity u
     | InviteActivity  (Invite u)
     | JoinActivity    (Join u)
     | OfferActivity   (Offer u)
+    | PatchActivity   (Patch' u)
     | PushActivity    (Push u)
     | RejectActivity  (Reject u)
     | RemoveActivity  (Remove u)
@@ -2418,6 +2440,7 @@ activityType (GrantActivity _)   = "Grant"
 activityType (InviteActivity _)  = "Invite"
 activityType (JoinActivity _)    = "Join"
 activityType (OfferActivity _)   = "Offer"
+activityType (PatchActivity _)   = "Patch"
 activityType (PushActivity _)    = "Push"
 activityType (RejectActivity _)  = "Reject"
 activityType (RemoveActivity _)  = "Remove"
@@ -2483,6 +2506,7 @@ instance ActivityPub Activity where
                         "Invite"  -> InviteActivity  <$> parseInvite o
                         "Join"    -> JoinActivity    <$> parseJoin o
                         "Offer"   -> OfferActivity   <$> parseOffer o a actor
+                        "Patch"   -> PatchActivity   <$> parsePatch' o
                         "Push"    -> PushActivity    <$> parsePush a o
                         "Reject"  -> RejectActivity  <$> parseReject o
                         "Remove"  -> RemoveActivity  <$> parseRemove o
@@ -2512,6 +2536,7 @@ instance ActivityPub Activity where
         encodeSpecific _ _ (InviteActivity a)  = encodeInvite a
         encodeSpecific _ _ (JoinActivity a)    = encodeJoin a
         encodeSpecific h u (OfferActivity a)   = encodeOffer h u a
+        encodeSpecific _ _ (PatchActivity a)   = encodePatch' a
         encodeSpecific h _ (PushActivity a)    = encodePush h a
         encodeSpecific _ _ (RejectActivity a)  = encodeReject a
         encodeSpecific _ _ (RemoveActivity a)  = encodeRemove a

templates/factory/one.hamlet

@@ -17,3 +17,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 ^{followW' $ Left actorID}
 
 ^{personPermitsForResourceW permits}
+
+<form method=POST action=@{FactoryEditR factoryHash} enctype=#{enctype}>
+  ^{widget}
+  <div class="submit">
+    <input type="submit">

th/routes

@@ -449,6 +449,7 @@
 /factories/#FactoryKeyHashid/messages/#LocalMessageKeyHashid   FactoryMessageR     GET
 
 /new-factory                                                   FactoryNewR         GET POST
+/factories/#FactoryKeyHashid/edit                              FactoryEditR        POST
 
 /factories/#FactoryKeyHashid/stamps/#SigKeyKeyHashid           FactoryStampR       GET