Switch Invite/Join/Remove to use resource collabs URI
Until now, the resource object itself would be specified. This no longer works, because it's unclear whether we're adding/removing a collaborator or a component. From now on, adding a collaborator is done by pointing to the resource's 'collaborators' URI, not to the resource itself
This commit is contained in:
Pere Lev
parent
034194f2aa
commit
b2657589dd
11 changed files with 98 additions and 34 deletions
|
|
@ -707,7 +707,7 @@ topicInvite grabActor topicResource topicField topicCollabField collabTopicCtor
|
|||
let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
|
||||
(role, resource, recipient) <- parseInvite author invite
|
||||
unless (Left (topicResource topicKey) == resource) $
|
||||
throwE "Invite topic isn't me"
|
||||
throwE "Invite topic isn't my collabs URI"
|
||||
return (role, recipient)
|
||||
|
||||
-- If target is local, find it in our DB
|
||||
|
|
@ -839,7 +839,7 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve
|
|||
-- Verify the capability URI is one of:
|
||||
-- * Outbox item URI of a local actor, i.e. a local activity
|
||||
-- * A remote URI
|
||||
cap <- nameExceptT "Invite capability" $ parseActivityURI' uCap
|
||||
cap <- nameExceptT "Remove.capability" $ parseActivityURI' uCap
|
||||
|
||||
-- Verify the capability is local
|
||||
case cap of
|
||||
|
|
@ -852,7 +852,7 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve
|
|||
let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
|
||||
(resource, member) <- parseRemove author remove
|
||||
unless (Left (topicResource topicKey) == resource) $
|
||||
throwE "Remove topic isn't me"
|
||||
throwE "Remove topic isn't my collabs URI"
|
||||
return member
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
|
@ -1056,7 +1056,7 @@ topicJoin grabActor topicResource topicField topicCollabField collabTopicCtor no
|
|||
-- Check input
|
||||
(role, resource) <- parseJoin join
|
||||
unless (resource == Left (topicResource topicKey)) $
|
||||
throwE "Join's object isn't me, don't need this Join"
|
||||
throwE "Join's object isn't my collabs URI, don't need this Join"
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
|
|
|
|||
|
|
@ -481,12 +481,17 @@ clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost
|
|||
(_role, resource, recipient) <- parseInvite (Left $ LocalActorPerson personMeID) invite
|
||||
_capID <- fromMaybeE maybeCap "No capability provided"
|
||||
|
||||
-- If resource is remote, HTTP GET it and its managing actor, and insert to
|
||||
-- our DB. If resource is local, find it in our DB.
|
||||
-- If resource collabs URI is remote, HTTP GET it and its resource and its
|
||||
-- managing actor, and insert to our DB. If resource is local, find it in
|
||||
-- our DB.
|
||||
resourceDB <-
|
||||
bitraverse
|
||||
(withDBExcept . flip getGrantResource "Grant context not found in DB")
|
||||
(\ u@(ObjURI h lu) -> do
|
||||
(\ u@(ObjURI h luColl) -> do
|
||||
manager <- asksEnv envHttpManager
|
||||
coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl
|
||||
lu <- fromMaybeE (AP.collectionContext (coll :: AP.Collection FedURI URIMode)) "Remote topic collabs has no 'context'"
|
||||
|
||||
instanceID <-
|
||||
lift $ withDB $ either entityKey id <$> insertBy' (Instance h)
|
||||
result <-
|
||||
|
|
@ -605,11 +610,23 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost
|
|||
(resource, member) <- parseRemove (Left $ LocalActorPerson personMeID) remove
|
||||
_capID <- fromMaybeE maybeCap "No capability provided"
|
||||
|
||||
-- If resource collabs is remote, HTTP GET it to determine resource
|
||||
resource' <-
|
||||
bitraverse
|
||||
pure
|
||||
(\ (ObjURI h luColl) -> do
|
||||
manager <- asksEnv envHttpManager
|
||||
coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl
|
||||
lu <- fromMaybeE (AP.collectionContext (coll :: AP.Collection FedURI URIMode)) "Remote topic collabs has no 'context'"
|
||||
return $ ObjURI h lu
|
||||
)
|
||||
resource
|
||||
|
||||
-- Verify that resource is addressed by the Remove
|
||||
bitraverse_
|
||||
(verifyResourceAddressed localRecips)
|
||||
(verifyRemoteAddressed remoteRecips)
|
||||
resource
|
||||
resource'
|
||||
|
||||
-- Verify that member is addressed by the Remove
|
||||
bitraverse_
|
||||
|
|
@ -624,7 +641,7 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost
|
|||
bitraverse
|
||||
(flip getGrantResource "Resource not found in DB")
|
||||
pure
|
||||
resource
|
||||
resource'
|
||||
|
||||
-- If member is local, find it in our DB
|
||||
_memberDB <-
|
||||
|
|
@ -644,7 +661,7 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost
|
|||
|
||||
-- Prepare local recipients for Remove delivery
|
||||
sieve <- lift $ do
|
||||
resourceHash <- bitraverse hashGrantResource' pure resource
|
||||
resourceHash <- bitraverse hashGrantResource' pure resource'
|
||||
recipientHash <- bitraverse hashGrantRecip pure member
|
||||
senderHash <- encodeKeyHashid personMeID
|
||||
let sieveActors = catMaybes
|
||||
|
|
|
|||
|
|
@ -977,17 +977,27 @@ invite
|
|||
-> FedURI
|
||||
-> AP.Role
|
||||
-> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Invite URIMode)
|
||||
invite personID uRecipient uResource role = do
|
||||
invite personID uRecipient uResourceCollabs role = do
|
||||
|
||||
theater <- asksSite appTheater
|
||||
env <- asksSite appEnv
|
||||
|
||||
let activity = AP.Invite role uRecipient uResource
|
||||
let activity = AP.Invite role uRecipient uResourceCollabs
|
||||
(_role, resource, recipient) <-
|
||||
runActE $ parseInvite (Left $ LocalActorPerson personID) activity
|
||||
|
||||
-- If resource is remote, we need to get it from DB/HTTP to determine its
|
||||
-- managing actor & followers collection
|
||||
-- If resource collabs is remote, we need to get it from DB/HTTP to
|
||||
-- determine the resourc & its managing actor & followers collection
|
||||
resource' <-
|
||||
bitraverse
|
||||
pure
|
||||
(\ (ObjURI h luColl) -> do
|
||||
manager <- asksSite appHttpManager
|
||||
coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl
|
||||
lu <- fromMaybeE (AP.collectionContext (coll :: AP.Collection FedURI URIMode)) "Remote topic collabs has no 'context'"
|
||||
return $ ObjURI h lu
|
||||
)
|
||||
resource
|
||||
resourceDB <-
|
||||
bitraverse
|
||||
hashGrantResource
|
||||
|
|
@ -1003,7 +1013,7 @@ invite personID uRecipient uResource role = do
|
|||
Right (_objectID, luManager, (Entity _ actor)) ->
|
||||
return (actor, ObjURI h luManager)
|
||||
)
|
||||
resource
|
||||
resource'
|
||||
|
||||
-- If target is remote, get it via HTTP/DB to determine its followers
|
||||
-- collection
|
||||
|
|
@ -1060,15 +1070,28 @@ remove
|
|||
-> FedURI
|
||||
-> FedURI
|
||||
-> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Remove URIMode)
|
||||
remove personID uRecipient uResource = do
|
||||
remove personID uRecipient uResourceCollabs = do
|
||||
|
||||
theater <- asksSite appTheater
|
||||
env <- asksSite appEnv
|
||||
|
||||
let activity = AP.Remove uRecipient uResource
|
||||
let activity = AP.Remove uRecipient uResourceCollabs
|
||||
(resource, recipient) <-
|
||||
runActE $ parseRemove (Left $ LocalActorPerson personID) activity
|
||||
|
||||
-- If resource collabs is remote, we need to HTTP GET it to determine the
|
||||
-- resource via collection 'context'
|
||||
resource' <-
|
||||
bitraverse
|
||||
pure
|
||||
(\ (ObjURI h luColl) -> do
|
||||
manager <- asksSite appHttpManager
|
||||
coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl
|
||||
lu <- fromMaybeE (AP.collectionContext (coll :: AP.Collection FedURI URIMode)) "Remote topic collabs has no 'context'"
|
||||
return $ ObjURI h lu
|
||||
)
|
||||
resource
|
||||
|
||||
-- If resource is remote, we need to get it from DB/HTTP to determine its
|
||||
-- managing actor & followers collection
|
||||
resourceDB <-
|
||||
|
|
@ -1086,7 +1109,7 @@ remove personID uRecipient uResource = do
|
|||
Right (_objectID, luManager, (Entity _ actor)) ->
|
||||
return (actor, ObjURI h luManager)
|
||||
)
|
||||
resource
|
||||
resource'
|
||||
|
||||
-- If target is remote, get it via HTTP/DB to determine its followers
|
||||
-- collection
|
||||
|
|
|
|||
|
|
@ -92,6 +92,12 @@ parseGrantResource (LoomR l) = Just $ GrantResourceLoom l
|
|||
parseGrantResource (ProjectR l) = Just $ GrantResourceProject l
|
||||
parseGrantResource _ = Nothing
|
||||
|
||||
parseGrantResourceCollabs (RepoCollabsR r) = Just $ GrantResourceRepo r
|
||||
parseGrantResourceCollabs (DeckCollabsR d) = Just $ GrantResourceDeck d
|
||||
parseGrantResourceCollabs (LoomCollabsR l) = Just $ GrantResourceLoom l
|
||||
parseGrantResourceCollabs (ProjectCollabsR l) = Just $ GrantResourceProject l
|
||||
parseGrantResourceCollabs _ = Nothing
|
||||
|
||||
data GrantRecipBy f = GrantRecipPerson (f Person)
|
||||
deriving (Generic, FunctorB, TraversableB, ConstraintsB)
|
||||
|
||||
|
|
@ -133,8 +139,8 @@ parseTopic u = do
|
|||
(\ route -> do
|
||||
resourceHash <-
|
||||
fromMaybeE
|
||||
(parseGrantResource route)
|
||||
"Not a shared resource route"
|
||||
(parseGrantResourceCollabs route)
|
||||
"Not a shared resource collabs route"
|
||||
unhashGrantResourceE'
|
||||
resourceHash
|
||||
"Contains invalid hashid"
|
||||
|
|
|
|||
|
|
@ -911,6 +911,8 @@ instance YesodBreadcrumbs App where
|
|||
|
||||
RepoStampR r k -> ("Stamp #" <> keyHashidText k, Just $ RepoR r)
|
||||
|
||||
RepoCollabsR r -> ("Collaborators", Just $ RepoR r)
|
||||
|
||||
DeckR d -> ("Ticket Tracker =" <> keyHashidText d, Just HomeR)
|
||||
DeckInboxR d -> ("Inbox", Just $ DeckR d)
|
||||
DeckOutboxR d -> ("Outbox", Just $ DeckR d)
|
||||
|
|
@ -965,6 +967,8 @@ instance YesodBreadcrumbs App where
|
|||
|
||||
LoomStampR l k -> ("Stamp #" <> keyHashidText k, Just $ LoomR l)
|
||||
|
||||
LoomCollabsR l -> ("Collaborators", Just $ LoomR l)
|
||||
|
||||
ClothR l c -> ("#" <> keyHashidText c, Just $ LoomClothsR l)
|
||||
ClothDiscussionR l c -> ("Discussion", Just $ ClothR l c)
|
||||
ClothEventsR l c -> ("Events", Just $ ClothR l c)
|
||||
|
|
|
|||
|
|
@ -1185,7 +1185,7 @@ postPublishMergeR = do
|
|||
|
||||
inviteForm = renderDivs $ (,,,)
|
||||
<$> areq fedUriField "(URI) Whom to invite" Nothing
|
||||
<*> areq fedUriField "(URI) Resource" Nothing
|
||||
<*> areq fedUriField "(URI) Resource's collaborators collection" Nothing
|
||||
<*> areq roleField "Role" Nothing
|
||||
<*> areq capField "(URI) Grant activity to use for authorization" Nothing
|
||||
where
|
||||
|
|
@ -1207,14 +1207,14 @@ postPublishInviteR = do
|
|||
federation <- getsYesod $ appFederation . appSettings
|
||||
unless federation badMethod
|
||||
|
||||
(uRecipient, uResource, role, (uCap, cap)) <-
|
||||
(uRecipient, uResourceCollabs, role, (uCap, cap)) <-
|
||||
runFormPostRedirect PublishInviteR inviteForm
|
||||
|
||||
(ep@(Entity pid _), a) <- getSender
|
||||
senderHash <- encodeKeyHashid pid
|
||||
|
||||
result <- runExceptT $ do
|
||||
(maybeSummary, audience, inv) <- invite pid uRecipient uResource role
|
||||
(maybeSummary, audience, inv) <- invite pid uRecipient uResourceCollabs role
|
||||
(localRecips, remoteRecips, fwdHosts, action) <-
|
||||
makeServerInput (Just uCap) maybeSummary audience (AP.InviteActivity inv)
|
||||
handleViaActor pid (Just cap) localRecips remoteRecips fwdHosts action
|
||||
|
|
@ -1229,7 +1229,7 @@ postPublishInviteR = do
|
|||
|
||||
removeForm = renderDivs $ (,,)
|
||||
<$> areq fedUriField "(URI) Whom to remove" Nothing
|
||||
<*> areq fedUriField "(URI) From which resource" Nothing
|
||||
<*> areq fedUriField "(URI) From which resource collaborators collection" Nothing
|
||||
<*> areq capField "(URI) Grant activity to use for authorization" Nothing
|
||||
|
||||
getPublishRemoveR :: Handler Html
|
||||
|
|
@ -1248,14 +1248,14 @@ postPublishRemoveR = do
|
|||
federation <- getsYesod $ appFederation . appSettings
|
||||
unless federation badMethod
|
||||
|
||||
(uRecipient, uResource, (uCap, cap)) <-
|
||||
(uRecipient, uResourceCollabs, (uCap, cap)) <-
|
||||
runFormPostRedirect PublishRemoveR removeForm
|
||||
|
||||
(ep@(Entity pid _), a) <- getSender
|
||||
senderHash <- encodeKeyHashid pid
|
||||
|
||||
result <- runExceptT $ do
|
||||
(maybeSummary, audience, rmv) <- remove pid uRecipient uResource
|
||||
(maybeSummary, audience, rmv) <- remove pid uRecipient uResourceCollabs
|
||||
(localRecips, remoteRecips, fwdHosts, action) <-
|
||||
makeServerInput (Just uCap) maybeSummary audience (AP.RemoveActivity rmv)
|
||||
handleViaActor pid (Just cap) localRecips remoteRecips fwdHosts action
|
||||
|
|
|
|||
|
|
@ -457,8 +457,8 @@ postDeckInviteR deckHash = do
|
|||
result <- runExceptT $ do
|
||||
(maybeSummary, audience, invite) <- do
|
||||
let uRecipient = encodeRouteHome $ PersonR recipPersonHash
|
||||
uResource = encodeRouteHome $ DeckR deckHash
|
||||
C.invite personID uRecipient uResource role
|
||||
uResourceCollabs = encodeRouteHome $ DeckCollabsR deckHash
|
||||
C.invite personID uRecipient uResourceCollabs role
|
||||
grantID <- do
|
||||
maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID
|
||||
fromMaybeE maybeItem "You need to be a collaborator in the Deck to invite people"
|
||||
|
|
@ -506,8 +506,8 @@ postDeckRemoveR deckHash ctID = do
|
|||
case pidOrU of
|
||||
Left pid -> encodeRouteHome . PersonR <$> encodeKeyHashid pid
|
||||
Right u -> pure u
|
||||
let uResource = encodeRouteHome $ DeckR deckHash
|
||||
C.remove personID uRecipient uResource
|
||||
let uResourceCollabs = encodeRouteHome $ DeckCollabsR deckHash
|
||||
C.remove personID uRecipient uResourceCollabs
|
||||
grantID <- do
|
||||
maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID
|
||||
fromMaybeE maybeItem "You need to be a collaborator in the Deck to remove people"
|
||||
|
|
|
|||
|
|
@ -30,6 +30,8 @@ module Vervis.Handler.Loom
|
|||
, postLoomUnfollowR
|
||||
|
||||
, getLoomStampR
|
||||
|
||||
, getLoomCollabsR
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -339,3 +341,6 @@ postLoomUnfollowR _ = error "Temporarily disabled"
|
|||
|
||||
getLoomStampR :: KeyHashid Loom -> KeyHashid SigKey -> Handler TypedContent
|
||||
getLoomStampR = servePerActorKey loomActor LocalActorLoom
|
||||
|
||||
getLoomCollabsR :: KeyHashid Loom -> Handler TypedContent
|
||||
getLoomCollabsR loomHash = error "TODO getLoomCollabsR"
|
||||
|
|
|
|||
|
|
@ -268,8 +268,8 @@ postProjectInviteR projectHash = do
|
|||
result <- runExceptT $ do
|
||||
(maybeSummary, audience, invite) <- do
|
||||
let uRecipient = encodeRouteHome $ PersonR recipPersonHash
|
||||
uResource = encodeRouteHome $ ProjectR projectHash
|
||||
C.invite personID uRecipient uResource role
|
||||
uResourceCollabs = encodeRouteHome $ ProjectCollabsR projectHash
|
||||
C.invite personID uRecipient uResourceCollabs role
|
||||
grantID <- do
|
||||
maybeItem <- lift $ runDB $ getGrant CollabTopicProjectCollab CollabTopicProjectProject projectID personID
|
||||
fromMaybeE maybeItem "You need to be a collaborator in the Project to invite people"
|
||||
|
|
@ -317,8 +317,8 @@ postProjectRemoveR projectHash ctID = do
|
|||
case pidOrU of
|
||||
Left pid -> encodeRouteHome . PersonR <$> encodeKeyHashid pid
|
||||
Right u -> pure u
|
||||
let uResource = encodeRouteHome $ ProjectR projectHash
|
||||
C.remove personID uRecipient uResource
|
||||
let uResourceCollabs = encodeRouteHome $ ProjectCollabsR projectHash
|
||||
C.remove personID uRecipient uResourceCollabs
|
||||
grantID <- do
|
||||
maybeItem <- lift $ runDB $ getGrant CollabTopicProjectCollab CollabTopicProjectProject projectID personID
|
||||
fromMaybeE maybeItem "You need to be a collaborator in the Project to remove people"
|
||||
|
|
|
|||
|
|
@ -48,6 +48,8 @@ module Vervis.Handler.Repo
|
|||
|
||||
, getRepoStampR
|
||||
|
||||
, getRepoCollabsR
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -772,6 +774,9 @@ postRepoLinkR repoHash loomHash = do
|
|||
getRepoStampR :: KeyHashid Repo -> KeyHashid SigKey -> Handler TypedContent
|
||||
getRepoStampR = servePerActorKey repoActor LocalActorRepo
|
||||
|
||||
getRepoCollabsR :: KeyHashid Repo -> Handler TypedContent
|
||||
getRepoCollabsR repoHash = error "TODO getRepoCollabsR"
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -197,6 +197,8 @@
|
|||
|
||||
/repos/#RepoKeyHashid/stamps/#SigKeyKeyHashid RepoStampR GET
|
||||
|
||||
/repos/#RepoKeyHashid/collabs RepoCollabsR GET
|
||||
|
||||
---- Deck --------------------------------------------------------------------
|
||||
|
||||
/decks/#DeckKeyHashid DeckR GET
|
||||
|
|
@ -271,6 +273,8 @@
|
|||
|
||||
/looms/#LoomKeyHashid/stamps/#SigKeyKeyHashid LoomStampR GET
|
||||
|
||||
/looms/#LoomKeyHashid/collabs LoomCollabsR GET
|
||||
|
||||
---- Cloth -------------------------------------------------------------------
|
||||
|
||||
/looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid ClothR GET
|
||||
|
|
|
|||
Loading…
Reference in a new issue