diff --git a/src/Vervis/Actor/Factory.hs b/src/Vervis/Actor/Factory.hs
index dda494f..f6a747f 100644
--- a/src/Vervis/Actor/Factory.hs
+++ b/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"
diff --git a/src/Vervis/Actor/Person/Client.hs b/src/Vervis/Actor/Person/Client.hs
index 7e1ff5a..e6cbd67 100644
--- a/src/Vervis/Actor/Person/Client.hs
+++ b/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
- , factoryAllowProject = True
- , factoryAllowTeam = True
+ , factoryAllowDeck = AP.ActorTypeTicketTracker `elem` types
+ , factoryAllowProject = AP.ActorTypeProject `elem` types
+ , 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
diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs
index 61559c0..0fcf80a 100644
--- a/src/Vervis/Client.hs
+++ b/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)
diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index c3cbcb7..46b7853 100644
--- a/src/Vervis/Foundation.hs
+++ b/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)
diff --git a/src/Vervis/Handler/Factory.hs b/src/Vervis/Handler/Factory.hs
index 9a340cf..bed2c32 100644
--- a/src/Vervis/Handler/Factory.hs
+++ b/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 $ (,)
- <$> areq textField "Name*" Nothing
- <*> areq textField "Description" Nothing
+typeField =
+ checkboxesFieldList
+ [ ("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
diff --git a/src/Vervis/Persist/Collab.hs b/src/Vervis/Persist/Collab.hs
index d720eac..0590dc6 100644
--- a/src/Vervis/Persist/Collab.hs
+++ b/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
diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs
index dde4da3..f2139c7 100644
--- a/src/Web/ActivityPub.hs
+++ b/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
- <> "teams" .= ObjURI h teams
+ <> "collaborators" .= ObjURI h collabs
+ <> "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) =
- encodeActorDetail d <> maybe mempty (uncurry encodeActorLocal) ml
+encodeCreateObject (CreateFactory d ml types) =
+ 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
diff --git a/templates/factory/one.hamlet b/templates/factory/one.hamlet
index 5b785b4..de4f9d2 100644
--- a/templates/factory/one.hamlet
+++ b/templates/factory/one.hamlet
@@ -17,3 +17,8 @@ $# .
^{followW' $ Left actorID}
^{personPermitsForResourceW permits}
+
+