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.
This commit is contained in:
Pere Lev
parent
b74d0d46c4
commit
94762ca76c
9 changed files with 306 additions and 24 deletions
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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">
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue