From 888a30e989d0e2bba8ba2201b9f682b417d75a1a Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Fri, 26 Apr 2024 02:00:41 +0300 Subject: [PATCH] DB: Switch Collab and Permit to use Resource Since collaborator live URIs were using CollabTopic*, this change breaks existing live URIs, which means all existing delegation chains are now broken. FYI if you're playing with your own Vervis deployment. --- .../611_2024-04-20_permit_resource.model | 147 ++++++++++ src/Vervis/API.hs | 30 +- src/Vervis/Access.hs | 40 +-- src/Vervis/Actor.hs | 10 +- src/Vervis/Actor/Common.hs | 277 ++++++++---------- src/Vervis/Actor/Deck.hs | 34 +-- src/Vervis/Actor/Group.hs | 65 ++-- src/Vervis/Actor/Loom.hs | 4 +- src/Vervis/Actor/Person.hs | 32 +- src/Vervis/Actor/Person/Client.hs | 63 ++-- src/Vervis/Actor/Project.hs | 183 ++++++------ src/Vervis/Client.hs | 25 +- src/Vervis/Data/Collab.hs | 79 +++-- src/Vervis/Form/Tracker.hs | 30 +- src/Vervis/Handler/Client.hs | 18 +- src/Vervis/Handler/Cloth.hs | 12 +- src/Vervis/Handler/Deck.hs | 35 ++- src/Vervis/Handler/Group.hs | 32 +- src/Vervis/Handler/Loom.hs | 8 +- src/Vervis/Handler/Project.hs | 45 +-- src/Vervis/Handler/Repo.hs | 12 +- src/Vervis/Handler/Ticket.hs | 8 +- src/Vervis/Migration.hs | 113 +++++++ src/Vervis/Migration/Model2024.hs | 3 + src/Vervis/Persist/Collab.hs | 209 ++++--------- src/Vervis/Persist/Ticket.hs | 2 +- src/Vervis/Web/Collab.hs | 24 +- th/models | 66 +---- th/routes | 6 +- 29 files changed, 805 insertions(+), 807 deletions(-) create mode 100644 migrations/611_2024-04-20_permit_resource.model diff --git a/migrations/611_2024-04-20_permit_resource.model b/migrations/611_2024-04-20_permit_resource.model new file mode 100644 index 0000000..713d1c3 --- /dev/null +++ b/migrations/611_2024-04-20_permit_resource.model @@ -0,0 +1,147 @@ +OutboxItem +Workflow +Permit + +Inbox + +Outbox + +FollowerSet + +Actor + name Text + desc Text + createdAt UTCTime + inbox InboxId + outbox OutboxId + followers FollowerSetId + justCreatedBy ActorId Maybe + + UniqueActorInbox inbox + UniqueActorOutbox outbox + UniqueActorFollowers followers + +Resource + actor ActorId + + UniqueResource actor + +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 + workflow WorkflowId + nextTicket Int + wiki RepoId Maybe + create OutboxItemId + + UniqueDeckActor actor + UniqueDeckCreate create + +Loom + nextTicket Int + actor ActorId + resource ResourceId + repo RepoId + create OutboxItemId + + UniqueLoomActor actor + UniqueLoomRepo repo + UniqueLoomCreate create + +Repo + vcs VersionControlSystem + project DeckId Maybe + mainBranch Text + actor ActorId + resource ResourceId + create OutboxItemId + loom LoomId Maybe + + UniqueRepoActor actor + UniqueRepoCreate create + +PermitTopicLocal + permit PermitId + topic ResourceId + + UniquePermitTopicLocal permit + +PermitTopicRepo + permit PermitTopicLocalId + repo RepoId + + UniquePermitTopicRepo permit + +PermitTopicDeck + permit PermitTopicLocalId + deck DeckId + + UniquePermitTopicDeck permit + +PermitTopicLoom + permit PermitTopicLocalId + loom LoomId + + UniquePermitTopicLoom permit + +PermitTopicProject + permit PermitTopicLocalId + project ProjectId + + UniquePermitTopicProject permit + +PermitTopicGroup + permit PermitTopicLocalId + group GroupId + + UniquePermitTopicGroup permit + +Collab + role Role + topic ResourceId + +CollabTopicRepo + collab CollabId + repo RepoId + + UniqueCollabTopicRepo collab + +CollabTopicDeck + collab CollabId + deck DeckId + + UniqueCollabTopicDeck collab + +CollabTopicLoom + collab CollabId + loom LoomId + + UniqueCollabTopicLoom collab + +CollabTopicProject + collab CollabId + project ProjectId + + UniqueCollabTopicProject collab + +CollabTopicGroup + collab CollabId + group GroupId + + UniqueCollabTopicGroup collab diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 1e26066..532c1b0 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -1009,15 +1009,15 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips (loomID, obiid, deliverHttpCreate, deliverHttpGrant) <- runDBExcept $ do -- Find the specified repo in DB - _ <- getE repoID "No such repo in DB" + repo <- getE repoID "No such repo in DB" -- Make sure the repo has a single, full-access collab, granted to the -- sender of this Create maybeApproved <- lift $ runMaybeT $ do - collabs <- lift $ selectList [CollabTopicRepoRepo ==. repoID] [] - collabID <- + collabs <- lift $ selectKeysList [CollabTopic ==. repoResource repo] [] + collabID <- case collabs of - [Entity _ c] -> return $ collabTopicRepoCollab c + [c] -> return c _ -> mzero CollabRecipLocal _ recipID <- MaybeT $ getValBy $ UniqueCollabRecipLocal collabID @@ -1030,7 +1030,7 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips -- Insert new loom to DB obiidCreate <- lift $ insertEmptyOutboxItem (actorOutbox senderActor) now - (loomID, Entity loomActorID loomActor) <- + (loomID, resourceID, Entity loomActorID loomActor) <- lift $ insertLoom now name msummary obiidCreate repoID -- Insert the Create activity to author's outbox @@ -1056,7 +1056,7 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips -- Insert collaboration access for loom's creator let loomOutboxID = actorOutbox loomActor obiidGrant <- lift $ insertEmptyOutboxItem loomOutboxID now - lift $ insertCollab loomID obiidGrant + lift $ insertCollab resourceID obiidGrant -- Insert a Grant activity to loom's outbox let grantRecipActors = [LocalActorPerson senderHash] @@ -1139,7 +1139,7 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips , loomRepo = repoID , loomCreate = obiidCreate } - return (loomID, actor) + return (loomID, resourceID, actor) prepareCreate name msummary loomHash repoHash = do encodeRouteLocal <- getEncodeRouteLocal @@ -1167,9 +1167,8 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips } return action { actionSpecific = specific } - insertCollab loomID obiidGrant = do - cid <- insert $ Collab RoleAdmin - insert_ $ CollabTopicLoom cid loomID + insertCollab resourceID obiidGrant = do + cid <- insert $ Collab RoleAdmin resourceID insert_ $ CollabEnable cid obiidGrant insert_ $ CollabRecipLocal cid pidUser insert_ $ CollabFulfillsLocalTopicCreation cid @@ -1280,7 +1279,7 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r -- Insert new repo to DB obiidCreate <- lift $ insertEmptyOutboxItem (actorOutbox senderActor) now - (repoID, Entity repoActorID repoActor) <- + (repoID, resourceID, Entity repoActorID repoActor) <- lift $ insertRepo now name msummary obiidCreate -- Insert the Create activity to author's outbox @@ -1301,7 +1300,7 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r -- Insert collaboration access for repo's creator let repoOutboxID = actorOutbox repoActor grantID <- lift $ insertEmptyOutboxItem repoOutboxID now - lift $ insertCollab repoID grantID + lift $ insertCollab resourceID grantID -- Insert a Grant activity to repo's outbox let grantRecipActors = [LocalActorPerson senderHash] @@ -1379,7 +1378,7 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r , repoCreate = createID , repoLoom = Nothing } - return (repoID, actor) + return (repoID, resourceID, actor) prepareCreate now name msummary repoHash = do encodeRouteLocal <- getEncodeRouteLocal @@ -1405,9 +1404,8 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r } return action { actionSpecific = specific } - insertCollab repoID grantID = do - collabID <- insert $ Collab RoleAdmin - insert_ $ CollabTopicRepo collabID repoID + insertCollab resourceID grantID = do + collabID <- insert $ Collab RoleAdmin resourceID insert_ $ CollabEnable collabID grantID insert_ $ CollabRecipLocal collabID pidUser insert_ $ CollabFulfillsLocalTopicCreation collabID diff --git a/src/Vervis/Access.hs b/src/Vervis/Access.hs index ed6751f..9533ad8 100644 --- a/src/Vervis/Access.hs +++ b/src/Vervis/Access.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2019, 2022, 2023 by fr33domlover . + - Written in 2019, 2022, 2023, 2024 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -157,20 +157,20 @@ checkRepoAccess' mpid op repoID = do Just (Entity rid repo) -> do role <- do case mpid of - Just pid -> fromMaybe User <$> asCollab rid pid + Just pid -> fromMaybe User <$> asCollab (repoResource repo) pid Nothing -> pure Guest status <$> roleHasAccess role op where asCollab rid pid = do fmap (const Developer) . listToMaybe <$> do - E.select $ E.from $ \ (topic `E.InnerJoin` recip `E.InnerJoin` enable) -> do - E.on $ topic E.^. CollabTopicRepoCollab E.==. enable E.^. CollabEnableCollab - E.on $ topic E.^. CollabTopicRepoCollab E.==. recip E.^. CollabRecipLocalCollab + E.select $ E.from $ \ (collab `E.InnerJoin` recip `E.InnerJoin` enable) -> do + E.on $ collab E.^. CollabId E.==. enable E.^. CollabEnableCollab + E.on $ collab E.^. CollabId E.==. recip E.^. CollabRecipLocalCollab E.where_ $ - topic E.^. CollabTopicRepoRepo E.==. E.val rid E.&&. + collab E.^. CollabTopic E.==. E.val rid E.&&. recip E.^. CollabRecipLocalPerson E.==. E.val pid E.limit 1 - return $ topic E.^. CollabTopicRepoCollab + return $ collab E.^. CollabId checkRepoAccess :: (MonadIO m, MonadSite m, YesodHashids (SiteEnv m)) @@ -188,20 +188,20 @@ checkRepoAccess mpid op repoHash = do Just (Entity rid repo) -> do role <- do case mpid of - Just pid -> fromMaybe User <$> asCollab rid pid + Just pid -> fromMaybe User <$> asCollab (repoResource repo) pid Nothing -> pure Guest status <$> roleHasAccess role op where asCollab rid pid = do fmap (const Developer) . listToMaybe <$> do - E.select $ E.from $ \ (topic `E.InnerJoin` recip `E.InnerJoin` enable) -> do - E.on $ topic E.^. CollabTopicRepoCollab E.==. enable E.^. CollabEnableCollab - E.on $ topic E.^. CollabTopicRepoCollab E.==. recip E.^. CollabRecipLocalCollab + E.select $ E.from $ \ (collab `E.InnerJoin` recip `E.InnerJoin` enable) -> do + E.on $ collab E.^. CollabId E.==. enable E.^. CollabEnableCollab + E.on $ collab E.^. CollabId E.==. recip E.^. CollabRecipLocalCollab E.where_ $ - topic E.^. CollabTopicRepoRepo E.==. E.val rid E.&&. + collab E.^. CollabTopic E.==. E.val rid E.&&. recip E.^. CollabRecipLocalPerson E.==. E.val pid E.limit 1 - return $ topic E.^. CollabTopicRepoCollab + return $ collab E.^. CollabId checkProjectAccess :: (MonadIO m, MonadSite m, YesodHashids (SiteEnv m)) @@ -219,17 +219,17 @@ checkProjectAccess mpid op deckHash = do Just (Entity jid project) -> do role <- do case mpid of - Just pid -> fromMaybe User <$> asCollab jid pid + Just pid -> fromMaybe User <$> asCollab (deckResource project) pid Nothing -> pure Guest status <$> roleHasAccess role op where - asCollab jid pid = do + asCollab rid pid = do fmap (const Developer) . listToMaybe <$> do - E.select $ E.from $ \ (topic `E.InnerJoin` recip `E.InnerJoin` enable) -> do - E.on $ topic E.^. CollabTopicDeckCollab E.==. enable E.^. CollabEnableCollab - E.on $ topic E.^. CollabTopicDeckCollab E.==. recip E.^. CollabRecipLocalCollab + E.select $ E.from $ \ (collab `E.InnerJoin` recip `E.InnerJoin` enable) -> do + E.on $ collab E.^. CollabId E.==. enable E.^. CollabEnableCollab + E.on $ collab E.^. CollabId E.==. recip E.^. CollabRecipLocalCollab E.where_ $ - topic E.^. CollabTopicDeckDeck E.==. E.val jid E.&&. + collab E.^. CollabTopic E.==. E.val rid E.&&. recip E.^. CollabRecipLocalPerson E.==. E.val pid E.limit 1 - return $ topic E.^. CollabTopicDeckCollab + return $ collab E.^. CollabId diff --git a/src/Vervis/Actor.hs b/src/Vervis/Actor.hs index 423f95d..d6d6894 100644 --- a/src/Vervis/Actor.hs +++ b/src/Vervis/Actor.hs @@ -162,6 +162,11 @@ data LocalActorBy f | LocalActorProject (f Project) deriving (Generic, FunctorB, ConstraintsB) +deriving instance AllBF Eq f LocalActorBy => Eq (LocalActorBy f) +deriving instance AllBF Ord f LocalActorBy => Ord (LocalActorBy f) +deriving instance AllBF Hashable f LocalActorBy => Hashable (LocalActorBy f) +deriving instance AllBF Show f LocalActorBy => Show (LocalActorBy f) + data LocalResourceBy f = LocalResourceGroup (f Group) | LocalResourceRepo (f Repo) @@ -170,10 +175,7 @@ data LocalResourceBy f | LocalResourceProject (f Project) deriving (Generic, FunctorB, ConstraintsB) -deriving instance AllBF Eq f LocalActorBy => Eq (LocalActorBy f) -deriving instance AllBF Ord f LocalActorBy => Ord (LocalActorBy f) -deriving instance AllBF Hashable f LocalActorBy => Hashable (LocalActorBy f) -deriving instance AllBF Show f LocalActorBy => Show (LocalActorBy f) +deriving instance AllBF Eq f LocalResourceBy => Eq (LocalResourceBy f) type LocalActor = LocalActorBy KeyHashid diff --git a/src/Vervis/Actor/Common.hs b/src/Vervis/Actor/Common.hs index bf1fca8..9da1354 100644 --- a/src/Vervis/Actor/Common.hs +++ b/src/Vervis/Actor/Common.hs @@ -231,14 +231,14 @@ actorFollow parseFollowee grabActor unread getFollowee getSieve makeLocalActor m topicAccept :: forall topic. (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic) - => (topic -> ActorId) + => (topic -> ResourceId) -> (forall f. f topic -> ComponentBy f) -> UTCTime -> Key topic -> Verse -> AP.Accept URIMode -> ActE (Text, Act (), Next) -topicAccept topicActor topicComponent now recipKey (Verse authorIdMsig body) accept = do +topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) accept = do -- Check input acceptee <- parseAccept accept @@ -252,10 +252,11 @@ topicAccept topicActor topicComponent now recipKey (Verse authorIdMsig body) acc (AP.activityCapability $ actbActivity body) -- Grab me from DB - (recipActorID, recipActor) <- lift $ withDB $ do - recip <- getJust recipKey - let actorID = topicActor recip - (actorID,) <$> getJust actorID + (resourceID, recipActorID, recipActor) <- lift $ withDB $ do + resourceID <- grabResource <$> getJust recipKey + Resource recipActorID <- getJust resourceID + recipActor <- getJust recipActorID + return (resourceID, recipActorID, recipActor) collabOrStem <- withDBExcept $ do @@ -284,8 +285,8 @@ topicAccept topicActor topicComponent now recipKey (Verse authorIdMsig body) acc where - topicResource :: forall f. f topic -> LocalActorBy f - topicResource = componentActor . topicComponent + topicResource :: forall f. f topic -> LocalResourceBy f + topicResource = componentResource . topicComponent tryInviteCollab (Left (actorByKey, _actorEntity, itemID)) = (,Left actorByKey) . collabInviterLocalCollab <$> @@ -346,7 +347,7 @@ topicAccept topicActor topicComponent now recipKey (Verse authorIdMsig body) acc audAccepter <- makeAudSenderWithFollowers authorIdMsig audApprover <- lift $ makeAudSenderOnly authorIdMsig recipHash <- encodeKeyHashid recipKey - let topicByHash = topicResource recipHash + let topicByHash = resourceToActor $ topicResource recipHash senderHash <- bitraverse hashLocalActor pure sender @@ -480,7 +481,7 @@ topicAccept topicActor topicComponent now recipKey (Verse authorIdMsig body) acc _ -> error "topicAccept impossible" -- Prepare forwarding of Accept to my followers - let recipByID = topicResource recipKey + let recipByID = resourceToActor $ topicResource recipKey recipByHash <- hashLocalActor recipByID let sieve = makeRecipientSet [] [localActorFollowers recipByHash] @@ -494,9 +495,9 @@ topicAccept topicActor topicComponent now recipKey (Verse authorIdMsig body) acc let inviterOrJoiner = either snd snd collab isInvite = isLeft collab grant@(actionGrant, _, _, _) <- do - Collab role <- lift $ getJust collabID + Collab role _ <- lift $ getJust collabID lift $ prepareGrant isInvite inviterOrJoiner role - let recipByKey = topicResource recipKey + let recipByKey = resourceToActor $ topicResource recipKey _luGrant <- lift $ updateOutboxItem' recipByKey grantID actionGrant return (grantID, grant) @@ -505,7 +506,7 @@ topicAccept topicActor topicComponent now recipKey (Verse authorIdMsig body) acc case maybeNew of Nothing -> done "I already have this activity in my inbox" Just (recipActorID, sieve, (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant))) -> do - let recipByID = topicResource recipKey + let recipByID = resourceToActor $ topicResource recipKey forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ sendActivity recipByID recipActorID localRecipsGrant @@ -544,7 +545,7 @@ topicAccept topicActor topicComponent now recipKey (Verse authorIdMsig body) acc audAccepter <- lift $ makeAudSenderOnly authorIdMsig audMe <- AudLocal [] . pure . localActorFollowers . - topicResource <$> + resourceToActor . topicResource <$> encodeKeyHashid recipKey let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = @@ -660,7 +661,7 @@ topicAccept topicActor topicComponent now recipKey (Verse authorIdMsig body) acc insert_ $ StemComponentGestureRemote stemID (remoteAuthorId author) acceptID -- Prepare forwarding of Accept to my followers - let recipByID = topicResource recipKey + let recipByID = resourceToActor $ topicResource recipKey recipByHash <- hashLocalActor recipByID let sieve = makeRecipientSet [] [localActorFollowers recipByHash] @@ -672,7 +673,7 @@ topicAccept topicActor topicComponent now recipKey (Verse authorIdMsig body) acc -- Prepare an Accept activity and insert to my outbox react@(actionReact, _, _, _) <- lift $ prepareReact project inviter - let recipByKey = topicResource recipKey + let recipByKey = resourceToActor $ topicResource recipKey _luReact <- lift $ updateOutboxItem' recipByKey reactID actionReact return (reactID, react) @@ -684,7 +685,7 @@ topicAccept topicActor topicComponent now recipKey (Verse authorIdMsig body) acc Nothing -> done "I already have this activity in my inbox" Just Nothing -> done "Done" Just (Just (sieve, (reactID, (actionReact, localRecipsReact, remoteRecipsReact, fwdHostsReact)))) -> do - let recipByID = topicResource recipKey + let recipByID = resourceToActor $ topicResource recipKey forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ sendActivity recipByID recipActorID localRecipsReact @@ -693,14 +694,14 @@ topicAccept topicActor topicComponent now recipKey (Verse authorIdMsig body) acc topicReject :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic) - => (topic -> ActorId) - -> (forall f. f topic -> LocalActorBy f) + => (topic -> ResourceId) + -> (forall f. f topic -> LocalResourceBy f) -> UTCTime -> Key topic -> Verse -> AP.Reject URIMode -> ActE (Text, Act (), Next) -topicReject topicActor topicResource now recipKey (Verse authorIdMsig body) reject = do +topicReject grabResource topicResource now recipKey (Verse authorIdMsig body) reject = do -- Check input rejectee <- parseReject reject @@ -716,10 +717,9 @@ topicReject topicActor topicResource now recipKey (Verse authorIdMsig body) reje maybeNew <- withDBExcept $ do -- Grab me from DB - (recipActorID, recipActor) <- lift $ do - recip <- getJust recipKey - let actorID = topicActor recip - (actorID,) <$> getJust actorID + resourceID <- lift $ grabResource <$> getJust recipKey + Resource recipActorID <- lift $ getJust resourceID + recipActor <- lift $ getJust recipActorID -- Find the rejected activity in our DB rejecteeDB <- do @@ -742,7 +742,7 @@ topicReject topicActor topicResource now recipKey (Verse authorIdMsig body) reje collabFulfillsInviteCollab <$> getJust fulfillsID Right (fulfillsID, _, _, _) -> collabFulfillsJoinCollab <$> getJust fulfillsID - (deleteTopic, topic) <- lift $ getCollabTopic' collabID + topic <- lift $ getCollabTopic collabID unless (topicResource recipKey == topic) $ throwE "Accept object is an Invite/Join for some other resource" @@ -809,18 +809,16 @@ topicReject topicActor topicResource now recipKey (Verse authorIdMsig body) reje case idsForReject of Left (fulfillsID, recipID, deleteInviter) -> lift $ do bitraverse_ delete delete recipID - deleteTopic deleteInviter delete fulfillsID Right (fulfillsID, deleteRecipJoin, deleteRecip) -> lift $ do deleteRecipJoin deleteRecip - deleteTopic delete fulfillsID lift $ delete collabID -- Prepare forwarding of Reject to my followers - let recipByID = topicResource recipKey + let recipByID = resourceToActor $ topicResource recipKey recipByHash <- hashLocalActor recipByID let sieve = makeRecipientSet [] [localActorFollowers recipByHash] @@ -832,7 +830,7 @@ topicReject topicActor topicResource now recipKey (Verse authorIdMsig body) reje isInvite = isLeft collab newReject@(actionReject, _, _, _) <- lift $ prepareReject isInvite inviterOrJoiner - let recipByKey = topicResource recipKey + let recipByKey = resourceToActor $ topicResource recipKey _luNewReject <- lift $ updateOutboxItem' recipByKey newRejectID actionReject return (newRejectID, newReject) @@ -841,7 +839,7 @@ topicReject topicActor topicResource now recipKey (Verse authorIdMsig body) reje case maybeNew of Nothing -> done "I already have this activity in my inbox" Just (recipActorID, sieve, (newRejectID, (action, localRecips, remoteRecips, fwdHosts))) -> do - let recipByID = topicResource recipKey + let recipByID = resourceToActor $ topicResource recipKey forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ sendActivity recipByID recipActorID localRecips @@ -884,7 +882,7 @@ topicReject topicActor topicResource now recipKey (Verse authorIdMsig body) reje audRejecter <- makeAudSenderWithFollowers authorIdMsig audForbidder <- lift $ makeAudSenderOnly authorIdMsig recipHash <- encodeKeyHashid recipKey - let topicByHash = topicResource recipHash + let topicByHash = resourceToActor $ topicResource recipHash senderHash <- bitraverse hashLocalActor pure sender @@ -949,21 +947,17 @@ topicReject topicActor topicResource now recipKey (Verse authorIdMsig body) reje topicInvite :: forall topic ct si. ( PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic - , PersistRecordBackend ct SqlBackend , PersistRecordBackend si SqlBackend ) - => (topic -> ActorId) + => (topic -> ResourceId) -> (forall f. f topic -> ComponentBy f) - -> EntityField ct (Key topic) - -> EntityField ct CollabId - -> (CollabId -> Key topic -> ct) -> (StemId -> Key topic -> si) -> UTCTime -> Key topic -> Verse -> AP.Invite URIMode -> ActE (Text, Act (), Next) -topicInvite grabActor topicComponent topicField topicCollabField collabTopicCtor stemIdentCtor now topicKey (Verse authorIdMsig body) invite = do +topicInvite grabResource topicComponent stemIdentCtor now topicKey (Verse authorIdMsig body) invite = do -- Check invite recipOrProject <- do @@ -1094,10 +1088,9 @@ topicInvite grabActor topicComponent topicField topicCollabField collabTopicCtor maybeNew <- withDBExcept $ do -- Grab me from DB - (topicActorID, topicActor) <- lift $ do - recip <- getJust topicKey - let actorID = grabActor recip - (actorID,) <$> getJust actorID + resourceID <- lift $ grabResource <$> getJust topicKey + Resource topicActorID <- lift $ getJust resourceID + topicActor <- lift $ getJust topicActorID case recipOrProjectDB of Left (role, capability, _targetByKey, targetDB) -> do @@ -1110,21 +1103,21 @@ topicInvite grabActor topicComponent topicField topicCollabField collabTopicCtor existingCollabIDs <- lift $ case targetDB of Left (GrantRecipPerson (Entity personID _)) -> - E.select $ E.from $ \ (topic `E.InnerJoin` recipl) -> do + E.select $ E.from $ \ (collab `E.InnerJoin` recipl) -> do E.on $ - topic E.^. topicCollabField E.==. + collab E.^. CollabId E.==. recipl E.^. CollabRecipLocalCollab E.where_ $ - topic E.^. topicField E.==. E.val topicKey E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipl E.^. CollabRecipLocalPerson E.==. E.val personID return $ recipl E.^. CollabRecipLocalCollab Right remoteActorID -> - E.select $ E.from $ \ (topic `E.InnerJoin` recipr) -> do + E.select $ E.from $ \ (collab `E.InnerJoin` recipr) -> do E.on $ - topic E.^. topicCollabField E.==. + collab E.^. CollabId E.==. recipr E.^. CollabRecipRemoteCollab E.where_ $ - topic E.^. topicField E.==. E.val topicKey E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipr E.^. CollabRecipRemoteActor E.==. E.val remoteActorID return $ recipr E.^. CollabRecipRemoteCollab case existingCollabIDs of @@ -1146,7 +1139,7 @@ topicInvite grabActor topicComponent topicField topicCollabField collabTopicCtor sieve <- do topicHash <- encodeKeyHashid topicKey let topicByHash = - topicResource topicHash + resourceToActor $ topicResource topicHash return $ makeRecipientSet [] [localActorFollowers topicByHash] -- Insert Collab or Stem record to DB @@ -1155,9 +1148,9 @@ topicInvite grabActor topicComponent topicField topicCollabField collabTopicCtor maybeAccept <- case recipOrProjectDB of Left (role, _capability, targetByKey, targetDB) -> Just <$> do acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now - insertCollab role targetDB inviteDB acceptID + insertCollab resourceID role targetDB inviteDB acceptID accept@(actionAccept, _, _, _) <- lift $ prepareAccept targetByKey - let topicByKey = topicResource topicKey + let topicByKey = resourceToActor $ topicResource topicKey _luAccept <- updateOutboxItem' topicByKey acceptID actionAccept return (acceptID, accept) Right projectDB -> do @@ -1169,7 +1162,7 @@ topicInvite grabActor topicComponent topicField topicCollabField collabTopicCtor case maybeNew of Nothing -> done "I already have this activity in my inbox" Just (topicActorID, sieve, maybeAccept) -> do - let topicByID = topicResource topicKey + let topicByID = resourceToActor $ topicResource topicKey forwardActivity authorIdMsig body topicByID topicActorID sieve lift $ for_ maybeAccept $ \ (acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> sendActivity @@ -1179,13 +1172,12 @@ topicInvite grabActor topicComponent topicField topicCollabField collabTopicCtor where - topicResource :: forall f. f topic -> LocalActorBy f - topicResource = componentActor . topicComponent + topicResource :: forall f. f topic -> LocalResourceBy f + topicResource = componentResource . topicComponent - insertCollab role recipient inviteDB acceptID = do - collabID <- insert $ Collab role + insertCollab resourceID role recipient inviteDB acceptID = do + collabID <- insert $ Collab role resourceID fulfillsID <- insert $ CollabFulfillsInvite collabID acceptID - insert_ $ collabTopicCtor collabID topicKey case inviteDB of Left (_, _, inviteID) -> insert_ $ CollabInviterLocal fulfillsID inviteID @@ -1225,8 +1217,7 @@ topicInvite grabActor topicComponent topicField topicCollabField collabTopicCtor Right (ObjURI h lu) -> return $ AudRemote h [lu] [] audTopic <- AudLocal [] . pure . localActorFollowers . - topicResource <$> - encodeKeyHashid topicKey + resourceToActor . topicResource <$> encodeKeyHashid topicKey uInvite <- getActivityURI authorIdMsig let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = @@ -1247,19 +1238,15 @@ topicInvite grabActor topicComponent topicField topicCollabField collabTopicCtor return (action, recipientSet, remoteActors, fwdHosts) topicRemove - :: ( PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic - , PersistRecordBackend ct SqlBackend - ) - => (topic -> ActorId) - -> (forall f. f topic -> LocalActorBy f) - -> EntityField ct (Key topic) - -> EntityField ct CollabId + :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic) + => (topic -> ResourceId) + -> (forall f. f topic -> LocalResourceBy f) -> UTCTime -> Key topic -> Verse -> AP.Remove URIMode -> ActE (Text, Act (), Next) -topicRemove grabActor topicResource topicField topicCollabField now topicKey (Verse authorIdMsig body) remove = do +topicRemove grabResource topicResource now topicKey (Verse authorIdMsig body) remove = do -- Check capability capability <- do @@ -1310,10 +1297,9 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve memberByKey -- Grab me from DB - (topicActorID, topicActor) <- lift $ do - recip <- getJust topicKey - let actorID = grabActor recip - (actorID,) <$> getJust actorID + resourceID <- lift $ grabResource <$> getJust topicKey + Resource topicActorID <- lift $ getJust resourceID + topicActor <- lift $ getJust topicActorID -- Verify the specified capability gives relevant access verifyCapability' @@ -1323,34 +1309,32 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve existingCollabIDs <- lift $ case memberDB of Left (Entity personID _) -> - fmap (map $ over _2 Left) $ - E.select $ E.from $ \ (topic `E.InnerJoin` recipl) -> do + fmap (map $ over _1 Left) $ + E.select $ E.from $ \ (collab `E.InnerJoin` recipl) -> do E.on $ - topic E.^. topicCollabField E.==. + collab E.^. CollabId E.==. recipl E.^. CollabRecipLocalCollab E.where_ $ - topic E.^. topicField E.==. E.val topicKey E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipl E.^. CollabRecipLocalPerson E.==. E.val personID return - ( topic E.^. persistIdField - , recipl E.^. persistIdField + ( recipl E.^. persistIdField , recipl E.^. CollabRecipLocalCollab ) Right (Entity remoteActorID _, _) -> - fmap (map $ over _2 Right) $ - E.select $ E.from $ \ (topic `E.InnerJoin` recipr) -> do + fmap (map $ over _1 Right) $ + E.select $ E.from $ \ (collab `E.InnerJoin` recipr) -> do E.on $ - topic E.^. topicCollabField E.==. + collab E.^. CollabId E.==. recipr E.^. CollabRecipRemoteCollab E.where_ $ - topic E.^. topicField E.==. E.val topicKey E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipr E.^. CollabRecipRemoteActor E.==. E.val remoteActorID return - ( topic E.^. persistIdField - , recipr E.^. persistIdField + ( recipr E.^. persistIdField , recipr E.^. CollabRecipRemoteCollab ) - (E.Value topicID, recipID, E.Value collabID) <- + (recipID, E.Value collabID) <- case existingCollabIDs of [] -> throwE "Remove object isn't a member of me" [collab] -> return collab @@ -1363,14 +1347,14 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve -- Verify that at least 1 more enabled Admin collab for me exists otherCollabIDs <- - lift $ E.select $ E.from $ \ (topic `E.InnerJoin` enable) -> do + lift $ E.select $ E.from $ \ (collab `E.InnerJoin` enable) -> do E.on $ - topic E.^. topicCollabField E.==. + collab E.^. CollabId E.==. enable E.^. CollabEnableCollab E.where_ $ - topic E.^. topicField E.==. E.val topicKey E.&&. - topic E.^. topicCollabField E.!=. E.val collabID - return $ topic E.^. topicCollabField + collab E.^. CollabTopic E.==. E.val resourceID E.&&. + collab E.^. CollabId E.!=. E.val collabID + return $ collab E.^. CollabId when (null otherCollabIDs) $ throwE "No other admins exist, can't remove" @@ -1390,7 +1374,6 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve deleteBy $ UniqueCollabRecipRemoteJoinCollab r deleteBy $ UniqueCollabRecipRemoteAcceptCollab r delete r - delete topicID fulfills <- do mf <- runMaybeT $ asum [ Left <$> MaybeT (getKeyBy $ UniqueCollabFulfillsLocalTopicCreation collabID) @@ -1413,14 +1396,13 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve -- Prepare forwarding Remove to my followers sieve <- lift $ do topicHash <- encodeKeyHashid topicKey - let topicByHash = - topicResource topicHash + let topicByHash = resourceToActor $ topicResource topicHash return $ makeRecipientSet [] [localActorFollowers topicByHash] -- Prepare a Revoke activity and insert to my outbox revoke@(actionRevoke, _, _, _) <- lift $ prepareRevoke memberDB grantID - let recipByKey = topicResource topicKey + let recipByKey = resourceToActor $ topicResource topicKey revokeID <- insertEmptyOutboxItem' (actorOutbox topicActor) now _luRevoke <- updateOutboxItem' recipByKey revokeID actionRevoke @@ -1429,7 +1411,7 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve case maybeNew of Nothing -> done "I already have this activity in my inbox" Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke)) -> do - let topicByID = topicResource topicKey + let topicByID = resourceToActor $ topicResource topicKey forwardActivity authorIdMsig body topicByID topicActorID sieve lift $ sendActivity topicByID topicActorID localRecipsRevoke @@ -1443,7 +1425,7 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve encodeRouteLocal <- getEncodeRouteLocal recipHash <- encodeKeyHashid topicKey - let topicByHash = topicResource recipHash + let topicByHash = resourceToActor $ topicResource recipHash memberHash <- bitraverse (encodeKeyHashid . entityKey) pure member @@ -1479,20 +1461,15 @@ topicRemove grabActor topicResource topicField topicCollabField now topicKey (Ve return (action, recipientSet, remoteActors, fwdHosts) topicJoin - :: ( PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic - , PersistRecordBackend ct SqlBackend - ) - => (topic -> ActorId) - -> (forall f. f topic -> LocalActorBy f) - -> EntityField ct (Key topic) - -> EntityField ct CollabId - -> (CollabId -> Key topic -> ct) + :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic) + => (topic -> ResourceId) + -> (forall f. f topic -> LocalResourceBy f) -> UTCTime -> Key topic -> Verse -> AP.Join URIMode -> ActE (Text, Act (), Next) -topicJoin grabActor topicResource topicField topicCollabField collabTopicCtor now topicKey (Verse authorIdMsig body) join = do +topicJoin grabResource topicResource now topicKey (Verse authorIdMsig body) join = do -- Check input (role, resource) <- parseJoin join @@ -1502,32 +1479,31 @@ topicJoin grabActor topicResource topicField topicCollabField collabTopicCtor no maybeNew <- withDBExcept $ do -- Grab me from DB - (topicActorID, topicActor) <- lift $ do - recip <- getJust topicKey - let actorID = grabActor recip - (actorID,) <$> getJust actorID + resourceID <- lift $ grabResource <$> getJust topicKey + Resource topicActorID <- lift $ getJust resourceID + topicActor <- lift $ getJust topicActorID -- Verify that target doesn't already have a Collab for me existingCollabIDs <- lift $ case authorIdMsig of Left (LocalActorPerson personID, _, _) -> - E.select $ E.from $ \ (topic `E.InnerJoin` recipl) -> do + E.select $ E.from $ \ (collab `E.InnerJoin` recipl) -> do E.on $ - topic E.^. topicCollabField E.==. + collab E.^. CollabId E.==. recipl E.^. CollabRecipLocalCollab E.where_ $ - topic E.^. topicField E.==. E.val topicKey E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipl E.^. CollabRecipLocalPerson E.==. E.val personID return $ recipl E.^. CollabRecipLocalCollab Left (_, _, _) -> pure [] Right (author, _, _) -> do let targetID = remoteAuthorId author - E.select $ E.from $ \ (topic `E.InnerJoin` recipr) -> do + E.select $ E.from $ \ (collab `E.InnerJoin` recipr) -> do E.on $ - topic E.^. topicCollabField E.==. + collab E.^. CollabId E.==. recipr E.^. CollabRecipRemoteCollab E.where_ $ - topic E.^. topicField E.==. E.val topicKey E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipr E.^. CollabRecipRemoteActor E.==. E.val targetID return $ recipr E.^. CollabRecipRemoteCollab case existingCollabIDs of @@ -1548,29 +1524,27 @@ topicJoin grabActor topicResource topicField topicCollabField collabTopicCtor no ) pure joinDB - lift $ insertCollab role joinDB' + lift $ insertCollab resourceID role joinDB' -- Prepare forwarding Join to my followers sieve <- lift $ do topicHash <- encodeKeyHashid topicKey - let topicByHash = - topicResource topicHash + let topicByHash = resourceToActor $ topicResource topicHash return $ makeRecipientSet [] [localActorFollowers topicByHash] return (topicActorID, sieve) case maybeNew of Nothing -> done "I already have this activity in my inbox" Just (topicActorID, sieve) -> do - let topicByID = topicResource topicKey + let topicByID = resourceToActor $ topicResource topicKey forwardActivity authorIdMsig body topicByID topicActorID sieve done "Recorded and forwarded the Join" where - insertCollab role joinDB = do - collabID <- insert $ Collab role + insertCollab resourceID role joinDB = do + collabID <- insert $ Collab role resourceID fulfillsID <- insert $ CollabFulfillsJoin collabID - insert_ $ collabTopicCtor collabID topicKey case joinDB of Left (personID, joinID) -> do recipID <- insert $ CollabRecipLocal collabID personID @@ -1581,26 +1555,21 @@ topicJoin grabActor topicResource topicField topicCollabField collabTopicCtor no insert_ $ CollabRecipRemoteJoin recipID fulfillsID joinID topicCreateMe - :: ( PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic - , PersistRecordBackend ct SqlBackend - ) - => (topic -> ActorId) - -> (forall f. f topic -> LocalActorBy f) - -> EntityField ct (Key topic) - -> (CollabId -> Key topic -> ct) + :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic) + => (topic -> ResourceId) + -> (forall f. f topic -> LocalResourceBy f) -> UTCTime -> Key topic -> Verse -> ActE (Text, Act (), Next) -topicCreateMe topicActor topicResource collabTopicFieldTopic collabTopicCtor now recipKey (Verse authorIdMsig body) = do +topicCreateMe grabResource topicResource now recipKey (Verse authorIdMsig body) = do maybeNew <- withDBExcept $ do -- Grab me from DB - (recipActorID, recipActor) <- lift $ do - recip <- getJust recipKey - let actorID = topicActor recip - (actorID,) <$> getJust actorID + resourceID <- lift $ grabResource <$> getJust recipKey + Resource recipActorID <- lift $ getJust resourceID + recipActor <- lift $ getJust recipActorID -- Verify I'm in the initial just-been-created state creatorActorID <- @@ -1611,7 +1580,7 @@ topicCreateMe topicActor topicResource collabTopicFieldTopic collabTopicCtor now mp <- lift $ getKeyBy $ UniquePersonActor creatorActorID fromMaybeE mp "Granting access to local non-Person actors isn't suppported currently" existingCollabIDs <- - lift $ selectList [collabTopicFieldTopic ==. recipKey] [] + lift $ selectList [CollabTopic ==. resourceID] [] unless (null existingCollabIDs) $ error "Just-been-created but I somehow already have Collabs" @@ -1625,12 +1594,12 @@ topicCreateMe topicActor topicResource collabTopicFieldTopic collabTopicCtor now -- Create a Collab record and exit just-been-created state grantID <- insertEmptyOutboxItem' (actorOutbox recipActor) now - insertCollab creatorPersonID grantID + insertCollab resourceID creatorPersonID grantID update creatorActorID [ActorJustCreatedBy =. Nothing] -- Prepare a Grant activity and insert to my outbox grant@(actionGrant, _, _, _) <- lift prepareGrant - let recipByKey = topicResource recipKey + let recipByKey = resourceToActor $ topicResource recipKey _luGrant <- updateOutboxItem' recipByKey grantID actionGrant return (recipActorID, grantID, grant) @@ -1638,7 +1607,7 @@ topicCreateMe topicActor topicResource collabTopicFieldTopic collabTopicCtor now case maybeNew of Nothing -> done "I already have this activity in my inbox" Just (recipActorID, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) -> do - let recipByID = topicResource recipKey + let recipByID = resourceToActor $ topicResource recipKey lift $ sendActivity recipByID recipActorID localRecipsGrant remoteRecipsGrant fwdHostsGrant grantID actionGrant @@ -1646,9 +1615,8 @@ topicCreateMe topicActor topicResource collabTopicFieldTopic collabTopicCtor now where - insertCollab personID grantID = do - collabID <- insert $ Collab AP.RoleAdmin - insert_ $ collabTopicCtor collabID recipKey + insertCollab resourceID personID grantID = do + collabID <- insert $ Collab AP.RoleAdmin resourceID insert_ $ CollabEnable collabID grantID insert_ $ CollabRecipLocal collabID personID insert_ $ CollabFulfillsLocalTopicCreation collabID @@ -1661,7 +1629,7 @@ topicCreateMe topicActor topicResource collabTopicFieldTopic collabTopicCtor now recipHash <- encodeKeyHashid recipKey uCreator <- getActorURI authorIdMsig uCreate <- getActivityURI authorIdMsig - let topicByHash = topicResource recipHash + let topicByHash = resourceToActor $ topicResource recipHash audience = let audTopic = AudLocal [] [localActorFollowers topicByHash] in [audCreator, audTopic] @@ -1717,14 +1685,14 @@ topicCreateMe topicActor topicResource collabTopicFieldTopic collabTopicCtor now componentGrant :: forall topic. (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic) - => (topic -> ActorId) + => (topic -> ResourceId) -> (forall f. f topic -> ComponentBy f) -> UTCTime -> Key topic -> Verse -> AP.Grant URIMode -> ActE (Text, Act (), Next) -componentGrant grabActor topicComponent now recipKey (Verse authorIdMsig body) grant = do +componentGrant grabResource topicComponent now recipKey (Verse authorIdMsig body) grant = do -- Check grant project <- checkDelegatorGrant grant @@ -1740,10 +1708,9 @@ componentGrant grabActor topicComponent now recipKey (Verse authorIdMsig body) g maybeNew <- withDBExcept $ do -- Grab me from DB - (recipActorID, recipActor) <- lift $ do - recip <- getJust recipKey - let actorID = grabActor recip - (actorID,) <$> getJust actorID + resourceID <- lift $ grabResource <$> getJust recipKey + Resource recipActorID <- lift $ getJust resourceID + recipActor <- lift $ getJust recipActorID -- Find the fulfilled activity in our DB fulfillsDB <- do @@ -1798,8 +1765,7 @@ componentGrant grabActor topicComponent now recipKey (Verse authorIdMsig body) g -- Prepare forwarding to my followers sieve <- do recipHash <- encodeKeyHashid recipKey - let recipByHash = - topicResource recipHash + let recipByHash = resourceToActor $ topicResource recipHash return $ makeRecipientSet [] [localActorFollowers recipByHash] -- Update the Stem record in DB @@ -1814,7 +1780,7 @@ componentGrant grabActor topicComponent now recipKey (Verse authorIdMsig body) g chain <- do Stem role <- getJust stemID chain@(actionChain, _, _, _) <- prepareChain role - let recipByKey = topicResource recipKey + let recipByKey = resourceToActor $ topicResource recipKey _luChain <- updateOutboxItem' recipByKey chainID actionChain return chain @@ -1823,7 +1789,7 @@ componentGrant grabActor topicComponent now recipKey (Verse authorIdMsig body) g case maybeNew of Nothing -> done "I already have this activity in my inbox" Just (recipActorID, sieve, chainID, (actionChain, localRecipsChain, remoteRecipsChain, fwdHostsChain)) -> do - let recipByID = topicResource recipKey + let recipByID = resourceToActor $ topicResource recipKey forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ sendActivity recipByID recipActorID localRecipsChain remoteRecipsChain @@ -1832,8 +1798,8 @@ componentGrant grabActor topicComponent now recipKey (Verse authorIdMsig body) g where - topicResource :: forall f. f topic -> LocalActorBy f - topicResource = componentActor . topicComponent + topicResource :: forall f. f topic -> LocalResourceBy f + topicResource = componentResource . topicComponent checkDelegatorGrant g = do (role, resource, recipient, _mresult, mstart, mend, usage, mdeleg) <- @@ -1854,7 +1820,7 @@ componentGrant grabActor topicComponent now recipKey (Verse authorIdMsig body) g (Right u, Right (ra, _, _)) | remoteAuthorURI ra == u -> pure () _ -> throwE "Author and resource aren't the same project actor" case recipient of - Left la | topicResource recipKey == la -> pure () + Left la | resourceToActor (topicResource recipKey) == la -> pure () _ -> throwE "Grant recipient isn't me" for_ mstart $ \ start -> unless (start < now) $ throwE "Start time is in the future" @@ -1895,12 +1861,11 @@ componentGrant grabActor topicComponent now recipKey (Verse authorIdMsig body) g audProject <- makeAudSenderWithFollowers authorIdMsig audMe <- AudLocal [] . pure . localActorFollowers . - topicResource <$> - encodeKeyHashid recipKey + resourceToActor . topicResource <$> encodeKeyHashid recipKey uProject <- lift $ getActorURI authorIdMsig uGrant <- lift $ getActivityURI authorIdMsig recipHash <- encodeKeyHashid recipKey - let topicByHash = topicResource recipHash + let topicByHash = resourceToActor $ topicResource recipHash (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = collectAudience [audProject, audMe] diff --git a/src/Vervis/Actor/Deck.hs b/src/Vervis/Actor/Deck.hs index 8b8a9d5..7293747 100644 --- a/src/Vervis/Actor/Deck.hs +++ b/src/Vervis/Actor/Deck.hs @@ -195,7 +195,7 @@ deckAdd now deckID (Verse authorIdMsig body) add = do -- Verify the specified capability gives relevant access verifyCapability' - capability authorIdMsig (LocalActorDeck deckID) AP.RoleAdmin + capability authorIdMsig (LocalResourceDeck deckID) AP.RoleAdmin -- Insert the Add to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actor) False @@ -294,9 +294,7 @@ deckCreateMe -> DeckId -> Verse -> ActE (Text, Act (), Next) -deckCreateMe = - topicCreateMe - deckActor LocalActorDeck CollabTopicDeckDeck CollabTopicDeck +deckCreateMe = topicCreateMe deckResource LocalResourceDeck deckCreate :: UTCTime @@ -395,7 +393,7 @@ deckOffer now deckID (Verse authorIdMsig body) (AP.Offer object uTarget) = do verifyCapability' lcap authorIdMsig - (LocalActorDeck deckID) + (LocalResourceDeck deckID) AP.RoleReport -- Prepare forwarding the Offer to my followers @@ -532,7 +530,7 @@ deckResolve now deckID (Verse authorIdMsig body) (AP.Resolve uObject) = do verifyCapability'' uCap authorIdMsig - (LocalActorDeck deckID) + (LocalResourceDeck deckID) AP.RoleTriage {- @@ -748,7 +746,7 @@ deckAccept -> Verse -> AP.Accept URIMode -> ActE (Text, Act (), Next) -deckAccept = topicAccept deckActor ComponentDeck +deckAccept = topicAccept deckResource ComponentDeck -- Meaning: An actor rejected something -- Behavior: @@ -773,7 +771,7 @@ deckReject -> Verse -> AP.Reject URIMode -> ActE (Text, Act (), Next) -deckReject = topicReject deckActor LocalActorDeck +deckReject = topicReject deckResource LocalResourceDeck -- Meaning: An actor A invited actor B to a resource -- Behavior: @@ -802,11 +800,7 @@ deckInvite -> Verse -> AP.Invite URIMode -> ActE (Text, Act (), Next) -deckInvite = - topicInvite - deckActor ComponentDeck - CollabTopicDeckDeck CollabTopicDeckCollab - CollabTopicDeck StemIdentDeck +deckInvite = topicInvite deckResource ComponentDeck StemIdentDeck -- Meaning: An actor A is removing actor B from a resource -- Behavior: @@ -825,10 +819,7 @@ deckRemove -> Verse -> AP.Remove URIMode -> ActE (Text, Act (), Next) -deckRemove = - topicRemove - deckActor LocalActorDeck - CollabTopicDeckDeck CollabTopicDeckCollab +deckRemove = topicRemove deckResource LocalResourceDeck -- Meaning: An actor A asked to join a resource -- Behavior: @@ -842,10 +833,7 @@ deckJoin -> Verse -> AP.Join URIMode -> ActE (Text, Act (), Next) -deckJoin = - topicJoin - deckActor LocalActorDeck - CollabTopicDeckDeck CollabTopicDeckCollab CollabTopicDeck +deckJoin = topicJoin deckResource LocalResourceDeck -- Meaning: An actor is granting access-to-some-resource to another actor -- Behavior: @@ -877,7 +865,7 @@ deckGrant -> Verse -> AP.Grant URIMode -> ActE (Text, Act (), Next) -deckGrant = componentGrant deckActor ComponentDeck +deckGrant = componentGrant deckResource ComponentDeck ------------------------------------------------------------------------------ -- Ambiguous: Following/Resolving @@ -1018,7 +1006,7 @@ deckUndo now recipDeckID (Verse authorIdMsig body) (AP.Undo uObject) = do verifyCapability' capability authorIdMsig - (LocalActorDeck recipDeckID) + (LocalResourceDeck recipDeckID) AP.RoleTriage lift $ lift deleteFromDB diff --git a/src/Vervis/Actor/Group.hs b/src/Vervis/Actor/Group.hs index 4d6c414..c47453e 100644 --- a/src/Vervis/Actor/Group.hs +++ b/src/Vervis/Actor/Group.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2023 by fr33domlover . + - Written in 2023, 2024 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -180,7 +180,7 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do verifyCapability' capability authorIdMsig - (LocalActorGroup groupID) + (LocalResourceGroup groupID) AP.RoleAdmin return fulfillsID ) @@ -229,7 +229,7 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do -- In collab mode, prepare a regular Grant let isInvite = isLeft collab grant@(actionGrant, _, _, _) <- do - Collab role <- getJust collabID + Collab role _ <- getJust collabID prepareCollabGrant isInvite inviterOrJoiner role let recipByKey = LocalActorGroup groupID _luGrant <- updateOutboxItem' recipByKey grantID actionGrant @@ -252,7 +252,7 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do verifyCollabTopic collabID = do topic <- lift $ getCollabTopic collabID - unless (LocalActorGroup groupID == topic) $ + unless (LocalResourceGroup groupID == topic) $ throwE "Accept object is an Invite/Join for some other resource" verifyInviteCollabTopic fulfillsID = do @@ -376,10 +376,7 @@ groupCreateMe -> GroupId -> Verse -> ActE (Text, Act (), Next) -groupCreateMe = - topicCreateMe - groupActor LocalActorGroup - CollabTopicGroupGroup CollabTopicGroup +groupCreateMe = topicCreateMe groupResource LocalResourceGroup groupCreate :: UTCTime @@ -526,9 +523,9 @@ groupGrant now groupID (Verse authorIdMsig body) grant = do throwE "Capability isn't mine" m <- lift $ getBy $ UniqueCollabEnableGrant $ snd capability fromMaybeE m "I don't have a Collab with this capability" - Collab role <- lift $ getJust collabID + Collab role _ <- lift $ getJust collabID topic <- lift $ getCollabTopic collabID - unless (topic == LocalActorGroup groupID) $ + unless (topic == LocalResourceGroup groupID) $ throwE "Found a Collab for this direct-Grant but it's not mine" recip <- lift $ getCollabRecip collabID recipForCheck <- @@ -628,7 +625,7 @@ groupInvite now groupID (Verse authorIdMsig body) invite = do (role, resourceOrComps, recipientOrComp) <- parseInvite author invite mode <- case resourceOrComps of - Left (Left (LocalActorGroup j)) | j == groupID -> + Left (Left (LocalResourceGroup j)) | j == groupID -> bitraverse (\case Left r -> pure r @@ -657,17 +654,16 @@ groupInvite now groupID (Verse authorIdMsig body) invite = do maybeNew <- withDBExcept $ do -- Grab me from DB - (topicActorID, topicActor) <- lift $ do - recip <- getJust groupID - let actorID = groupActor recip - (actorID,) <$> getJust actorID + resourceID <- lift $ groupResource <$> getJust groupID + Resource topicActorID <- lift $ getJust resourceID + topicActor <- lift $ getJust topicActorID -- Verify the specified capability gives relevant access verifyCapability' - capability authorIdMsig (LocalActorGroup groupID) AP.RoleAdmin + capability authorIdMsig (LocalResourceGroup groupID) AP.RoleAdmin -- Verify that target doesn't already have a Collab for me - existingCollabIDs <- lift $ getExistingCollabs invitedDB + existingCollabIDs <- lift $ getExistingCollabs resourceID invitedDB case existingCollabIDs of [] -> pure () [_] -> throwE "I already have a Collab for the target" @@ -678,7 +674,7 @@ groupInvite now groupID (Verse authorIdMsig body) invite = do -- Insert Collab or Component record to DB acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now - insertCollab role invitedDB inviteDB acceptID + insertCollab resourceID role invitedDB inviteDB acceptID -- Prepare forwarding Invite to my followers sieve <- do @@ -715,29 +711,28 @@ groupInvite now groupID (Verse authorIdMsig body) invite = do Right Nothing -> throwE "Target isn't an actor" Right (Just actor) -> return $ entityKey actor - getExistingCollabs (Left (GrantRecipPerson (Entity personID _))) = - E.select $ E.from $ \ (topic `E.InnerJoin` recipl) -> do + getExistingCollabs resourceID (Left (GrantRecipPerson (Entity personID _))) = + E.select $ E.from $ \ (collab `E.InnerJoin` recipl) -> do E.on $ - topic E.^. CollabTopicGroupCollab E.==. + collab E.^. CollabId E.==. recipl E.^. CollabRecipLocalCollab E.where_ $ - topic E.^. CollabTopicGroupGroup E.==. E.val groupID E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipl E.^. CollabRecipLocalPerson E.==. E.val personID return $ recipl E.^. CollabRecipLocalCollab - getExistingCollabs (Right remoteActorID) = - E.select $ E.from $ \ (topic `E.InnerJoin` recipr) -> do + getExistingCollabs resourceID (Right remoteActorID) = + E.select $ E.from $ \ (collab `E.InnerJoin` recipr) -> do E.on $ - topic E.^. CollabTopicGroupCollab E.==. + collab E.^. CollabId E.==. recipr E.^. CollabRecipRemoteCollab E.where_ $ - topic E.^. CollabTopicGroupGroup E.==. E.val groupID E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipr E.^. CollabRecipRemoteActor E.==. E.val remoteActorID return $ recipr E.^. CollabRecipRemoteCollab - insertCollab role recipient inviteDB acceptID = do - collabID <- insert $ Collab role + insertCollab resourceID role recipient inviteDB acceptID = do + collabID <- insert $ Collab role resourceID fulfillsID <- insert $ CollabFulfillsInvite collabID acceptID - insert_ $ CollabTopicGroup collabID groupID case inviteDB of Left (_, _, inviteID) -> insert_ $ CollabInviterLocal fulfillsID inviteID @@ -797,10 +792,7 @@ groupJoin -> Verse -> AP.Join URIMode -> ActE (Text, Act (), Next) -groupJoin = - topicJoin - groupActor LocalActorGroup - CollabTopicGroupGroup CollabTopicGroupCollab CollabTopicGroup +groupJoin = topicJoin groupResource LocalResourceGroup -- Meaning: An actor rejected something -- Behavior: @@ -825,7 +817,7 @@ groupReject -> Verse -> AP.Reject URIMode -> ActE (Text, Act (), Next) -groupReject = topicReject groupActor LocalActorGroup +groupReject = topicReject groupResource LocalResourceGroup -- Meaning: An actor A is removing actor B from a resource -- Behavior: @@ -844,10 +836,7 @@ groupRemove -> Verse -> AP.Remove URIMode -> ActE (Text, Act (), Next) -groupRemove = - topicRemove - groupActor LocalActorGroup - CollabTopicGroupGroup CollabTopicGroupCollab +groupRemove = topicRemove groupResource LocalResourceGroup -- Meaning: An actor is undoing some previous action -- Behavior: diff --git a/src/Vervis/Actor/Loom.hs b/src/Vervis/Actor/Loom.hs index ace96f4..fce0af8 100644 --- a/src/Vervis/Actor/Loom.hs +++ b/src/Vervis/Actor/Loom.hs @@ -279,7 +279,7 @@ loomOffer now loomID (Verse authorIdMsig body) (AP.Offer object uTarget) = do verifyCapability' lcap authorIdMsig - (LocalActorLoom loomID) + (LocalResourceLoom loomID) AP.RoleReport -- Prepare forwarding the Offer to my followers @@ -485,7 +485,7 @@ loomResolve now loomID (Verse authorIdMsig body) (AP.Resolve uObject) = do verifyCapability' capability authorIdMsig - (LocalActorLoom loomID) + (LocalResourceLoom loomID) AP.RoleTriage -- Prepare forwarding the Resolve to my followers & ticket diff --git a/src/Vervis/Actor/Person.hs b/src/Vervis/Actor/Person.hs index 2fa3338..dce8843 100644 --- a/src/Vervis/Actor/Person.hs +++ b/src/Vervis/Actor/Person.hs @@ -413,7 +413,7 @@ personAccept now recipPersonID (Verse authorIdMsig body) accept = do -- Verify topic is the Accept sender case (bimap snd snd topic, bimap (view _1) (view _1) acceptDB) of - (Left la, Left la') | la == la' -> pure () + (Left la, Left la') | resourceToActor la == la' -> pure () (Right raID, Right ra) | raID == remoteAuthorId ra -> pure () _ -> throwE "Accept sender isn't the Invite topic" @@ -641,7 +641,7 @@ personInvite now recipPersonID (Verse authorIdMsig body) invite = do case resource of Left r -> case r of - Left la -> withDBExcept $ Just . (role,) . Left <$> getLocalActorEntityE la "Invite resource not found in DB" + Left lr -> withDBExcept $ Just . (role,) . Left <$> getLocalResourceEntityE lr "Invite resource not found in DB" Right _j -> pure Nothing Right u@(ObjURI h luColl) -> do manager <- asksEnv envHttpManager @@ -679,7 +679,7 @@ personInvite now recipPersonID (Verse authorIdMsig body) invite = do -- mode checkExistingPermits recipPersonID - (bimap (bmap entityKey) (view _2) resourceDB) + (bimap localResourceID (view _2) resourceDB) -- Prepare forwarding Invite to my followers recipPersonHash <- encodeKeyHashid recipPersonID @@ -710,15 +710,7 @@ personInvite now recipPersonID (Verse authorIdMsig body) invite = do insertPermit resourceDB inviteDB role = do permitID <- lift $ insert $ Permit recipPersonID role case resourceDB of - Left la -> do - localID <- lift $ insert $ PermitTopicLocal permitID - case bmap entityKey la of - LocalActorPerson _ -> throwE "insertPermit: Person not supported as a PermitTopicLocal type (you can't become a \"collaborator in a person\"" - LocalActorRepo r -> lift $ insert_ $ PermitTopicRepo localID r - LocalActorDeck d -> lift $ insert_ $ PermitTopicDeck localID d - LocalActorLoom l -> lift $ insert_ $ PermitTopicLoom localID l - LocalActorProject j -> lift $ insert_ $ PermitTopicProject localID j - LocalActorGroup g -> lift $ insert_ $ PermitTopicGroup localID g + Left lr -> lift $ insert_ $ PermitTopicLocal permitID (localResourceID lr) Right (_, actorID, _) -> lift $ insert_ $ PermitTopicRemote permitID actorID lift $ do fulfillsID <- insert $ PermitFulfillsInvite permitID @@ -965,7 +957,7 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do -- Verify the Grant sender is the Permit topic case (bimap snd snd topic, bimap (view _1) (view _1) authorIdMsig) of - (Left la, Left la') | la == la' -> pure () + (Left la, Left la') | resourceToActor la == la' -> pure () (Right raID, Right ra) | raID == remoteAuthorId ra -> pure () _ -> throwE "Grant sender isn't the Permit topic" @@ -980,7 +972,7 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do -- Verify the Grant sender is the Permit topic topic <- lift $ getPermitTopic permitID case (bimap snd snd topic, bimap (view _1) (view _1) authorIdMsig) of - (Left la, Left la') | la == la' -> pure () + (Left la, Left la') | resourceToActor la == la' -> pure () (Right raID, Right ra) | raID == remoteAuthorId ra -> pure () _ -> throwE "Grant sender isn't the Permit topic" @@ -1198,7 +1190,7 @@ personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke lus) = do lift $ do topic <- lift $ getPermitTopic permitID case (bimap snd snd topic, bimap (view _1) (view _1) authorIdMsig) of - (Left la, Left la') | la == la' -> pure () + (Left la, Left la') | resourceToActor la == la' -> pure () (Right raID, Right ra) | raID == remoteAuthorId ra -> pure () _ -> throwE "Revoke sender isn't the Permit topic" @@ -1222,7 +1214,7 @@ personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke lus) = do lift $ do topic <- lift $ getPermitTopic permitID case (bimap snd snd topic, bimap (view _1) (view _1) authorIdMsig) of - (Left la, Left la') | la == la' -> pure () + (Left la, Left la') | resourceToActor la == la' -> pure () (Right raID, Right ra) | raID == remoteAuthorId ra -> pure () _ -> throwE "Revoke sender isn't the Permit topic" @@ -1267,13 +1259,7 @@ personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke lus) = do deleteBy $ UniquePermitFulfillsInvite permitID deleteBy $ UniquePermitFulfillsJoin permitID case topicAndEnable of - Left (topicID, _) -> do - deleteBy $ UniquePermitTopicRepo topicID - deleteBy $ UniquePermitTopicDeck topicID - deleteBy $ UniquePermitTopicLoom topicID - deleteBy $ UniquePermitTopicProject topicID - deleteBy $ UniquePermitTopicGroup topicID - delete topicID + Left (topicID, _) -> delete topicID Right (topicID, _) -> delete topicID delete permitID ) diff --git a/src/Vervis/Actor/Person/Client.hs b/src/Vervis/Actor/Person/Client.hs index e109892..d46a8c0 100644 --- a/src/Vervis/Actor/Person/Client.hs +++ b/src/Vervis/Actor/Person/Client.hs @@ -261,7 +261,7 @@ clientAdd now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts a -- our DB. targetDB <- bitraverse - (withDBExcept . flip getLocalActorEntityE "Local target not found in DB" . addTargetActor) + (withDBExcept . flip getLocalResourceEntityE "Local target not found in DB" . addTargetResource) (\ u@(ObjURI h luComps) -> do manager <- asksEnv envHttpManager coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luComps @@ -302,7 +302,7 @@ clientAdd now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts a -- Verify that target and object are addressed by the Add bitraverse_ - (verifyActorAddressed localRecips . bmap entityKey) + (verifyActorAddressed localRecips . bmap entityKey . resourceToActor) (\ (_, _, u) -> verifyRemoteAddressed remoteRecips u) targetDB bitraverse_ @@ -323,7 +323,7 @@ clientAdd now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts a -- Prepare local recipients for Add delivery sieve <- lift $ do - targetHash <- bitraverse (hashLocalActor . addTargetActor) pure target + targetHash <- bitraverse (hashLocalActor . resourceToActor . addTargetResource) pure target objectHash <- bitraverse hashLocalActor pure object senderHash <- encodeKeyHashid personMeID let sieveActors = catMaybes @@ -385,14 +385,13 @@ clientCreateDeck now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd -- Insert new deck to DB createID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now wid <- findWorkflow - (deckID, deckFollowerSetID) <- + (deckID, resourceID, deckFollowerSetID) <- lift $ insertDeck now name msummary createID wid actorMeID -- Insert a Permit record lift $ do permitID <- insert $ Permit personMeID AP.RoleAdmin - topicID <- insert $ PermitTopicLocal permitID - insert_ $ PermitTopicDeck topicID deckID + topicID <- insert $ PermitTopicLocal permitID resourceID insert_ $ PermitFulfillsTopicCreation permitID insert_ $ PermitPersonGesture permitID createID @@ -482,7 +481,7 @@ clientCreateDeck now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd , deckWiki = Nothing , deckCreate = obiidCreate } - return (did, fsid) + return (did, rid, fsid) prepareCreate name msummary deckHash = do encodeRouteLocal <- getEncodeRouteLocal @@ -560,13 +559,12 @@ clientCreateProject now personMeID (ClientMsg maybeCap localRecips remoteRecips -- Insert new project to DB createID <- insertEmptyOutboxItem' (actorOutbox actorMe) now - (projectID, projectFollowerSetID) <- + (projectID, resourceID, projectFollowerSetID) <- insertProject now name msummary createID actorMeID -- Insert a Permit record permitID <- insert $ Permit personMeID AP.RoleAdmin - topicID <- insert $ PermitTopicLocal permitID - insert_ $ PermitTopicProject topicID projectID + topicID <- insert $ PermitTopicLocal permitID resourceID insert_ $ PermitFulfillsTopicCreation permitID insert_ $ PermitPersonGesture permitID createID @@ -649,7 +647,7 @@ clientCreateProject now personMeID (ClientMsg maybeCap localRecips remoteRecips , projectResource = rid , projectCreate = obiidCreate } - return (did, fsid) + return (did, rid, fsid) prepareCreate name msummary projectHash = do encodeRouteLocal <- getEncodeRouteLocal @@ -727,13 +725,12 @@ clientCreateTeam now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd -- Insert new team to DB createID <- insertEmptyOutboxItem' (actorOutbox actorMe) now - (groupID, projectFollowerSetID) <- + (groupID, resourceID, projectFollowerSetID) <- insertTeam now name msummary createID actorMeID -- Insert a Permit record permitID <- insert $ Permit personMeID AP.RoleAdmin - topicID <- insert $ PermitTopicLocal permitID - insert_ $ PermitTopicGroup topicID groupID + topicID <- insert $ PermitTopicLocal permitID resourceID insert_ $ PermitFulfillsTopicCreation permitID insert_ $ PermitPersonGesture permitID createID @@ -816,7 +813,7 @@ clientCreateTeam now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd , groupResource = rid , groupCreate = obiidCreate } - return (gid, fsid) + return (gid, rid, fsid) prepareCreate name msummary groupHash = do encodeRouteLocal <- getEncodeRouteLocal @@ -922,7 +919,7 @@ clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost resourceDB <- bitraverse (bitraverse - (withDBExcept . flip getLocalActorEntityE "Grant resource not found in DB") + (withDBExcept . flip getLocalResourceEntityE "Grant resource not found in DB") (withDBExcept . flip getEntityE "Grant context project not found in DB") ) (\ u@(ObjURI h luColl) -> do @@ -971,7 +968,7 @@ clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost -- Verify that resource and recipient are addressed by the Invite bitraverse_ (bitraverse_ - (verifyActorAddressed localRecips . bmap entityKey) + (verifyActorAddressed localRecips . bmap entityKey . resourceToActor) (verifyProjectAddressed localRecips . entityKey) ) (\ (_, _, u) -> verifyRemoteAddressed remoteRecips u) @@ -997,7 +994,7 @@ clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost -- Prepare local recipients for Invite delivery sieve <- lift $ do - resourceHash <- bitraverse (bitraverse hashLocalActor encodeKeyHashid) pure resource + resourceHash <- bitraverse (bitraverse (hashLocalActor . resourceToActor) encodeKeyHashid) pure resource recipientHash <- bitraverse (bitraverse hashGrantRecip hashComponent) pure recipient senderHash <- encodeKeyHashid personMeID let sieveActors = catMaybes @@ -1007,7 +1004,7 @@ clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost Right _ -> Nothing , case recipientHash of Left (Left (GrantRecipPerson p)) -> Just $ LocalActorPerson p - Left (Right c) -> Just $ componentActor c + Left (Right c) -> Just $ resourceToActor $ componentResource c Right _ -> Nothing ] sieveStages = catMaybes @@ -1018,7 +1015,7 @@ clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost Right _ -> Nothing , case recipientHash of Left (Left (GrantRecipPerson p)) -> Just $ LocalStagePersonFollowers p - Left (Right c) -> Just $ localActorFollowers $ componentActor c + Left (Right c) -> Just $ localActorFollowers $ resourceToActor $ componentResource c Right _ -> Nothing ] return $ makeRecipientSet sieveActors sieveStages @@ -1073,7 +1070,7 @@ clientJoin now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts -- our DB. resourceDB <- bitraverse - (withDBExcept . flip getLocalActorEntityE "Join resource not found in DB") + (withDBExcept . flip getLocalResourceEntityE "Join resource not found in DB") (\ u@(ObjURI h luColl) -> do manager <- asksEnv envHttpManager coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl @@ -1098,7 +1095,7 @@ clientJoin now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts -- Verify that resource is addressed by the Join bitraverse_ - (verifyActorAddressed localRecips . bmap entityKey) + (verifyActorAddressed localRecips . bmap entityKey . resourceToActor) (\ (_, _, u, _) -> verifyRemoteAddressed remoteRecips u) resourceDB @@ -1126,14 +1123,14 @@ clientJoin now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts -- mode checkExistingPermits personMeID - (bimap (bmap entityKey) (view _2) topicDB) + (bimap localResourceID (view _2) topicDB) -- Insert Permit record to DB insertPermit topicDB joinID role -- Prepare local recipients for Join delivery sieve <- lift $ do - resourceHash <- bitraverse hashLocalActor pure resource + resourceHash <- bitraverse (hashLocalActor . resourceToActor) pure resource senderHash <- encodeKeyHashid personMeID let sieveActors = catMaybes [ case resourceHash of @@ -1163,15 +1160,7 @@ clientJoin now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts insertPermit resourceDB joinID role = do permitID <- lift $ insert $ Permit personMeID role case resourceDB of - Left la -> do - localID <- lift $ insert $ PermitTopicLocal permitID - case bmap entityKey la of - LocalActorPerson _ -> throwE "insertPermit: Person not supported as a PermitTopicLocal type (you can't become a \"collaborator in a person\"" - LocalActorRepo r -> lift $ insert_ $ PermitTopicRepo localID r - LocalActorDeck d -> lift $ insert_ $ PermitTopicDeck localID d - LocalActorLoom l -> lift $ insert_ $ PermitTopicLoom localID l - LocalActorProject j -> lift $ insert_ $ PermitTopicProject localID j - LocalActorGroup g -> lift $ insert_ $ PermitTopicGroup localID g + Left lr -> lift $ insert_ $ PermitTopicLocal permitID (localResourceID lr) Right (_, actorID, _) -> lift $ insert_ $ PermitTopicRemote permitID actorID lift $ do insert_ $ PermitFulfillsJoin permitID @@ -1286,7 +1275,7 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost -- If resource collabs is remote, HTTP GET it to determine resource resource' <- bitraverse - (pure . either id addTargetActor) + (pure . either id addTargetResource) (\ (ObjURI h luColl) -> do manager <- asksEnv envHttpManager coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl @@ -1300,7 +1289,7 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost -- Verify that resource is addressed by the Remove bitraverse_ - (verifyActorAddressed localRecips) + (verifyActorAddressed localRecips . resourceToActor) (verifyRemoteAddressed remoteRecips) resource' @@ -1315,7 +1304,7 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost -- If resource is local, find it in our DB _resourceDB <- bitraverse - (flip getLocalActorEntityE "Resource not found in DB") + (flip getLocalResourceEntityE "Resource not found in DB") pure resource' @@ -1337,7 +1326,7 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost -- Prepare local recipients for Remove delivery sieve <- lift $ do - resourceHash <- bitraverse hashLocalActor pure resource' + resourceHash <- bitraverse (hashLocalActor . resourceToActor) pure resource' recipientHash <- bitraverse hashLocalActor pure member senderHash <- encodeKeyHashid personMeID let sieveActors = catMaybes diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs index 1e0d2f5..3b23f48 100644 --- a/src/Vervis/Actor/Project.hs +++ b/src/Vervis/Actor/Project.hs @@ -262,7 +262,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do verifyCollabTopic collabID = do topic <- lift $ getCollabTopic collabID - unless (LocalActorProject projectID == topic) $ + unless (LocalResourceProject projectID == topic) $ throwE "Accept object is an Invite/Join for some other resource" verifyInviteCollabTopic fulfillsID = do @@ -485,7 +485,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do componentIsAuthor ident = let author = bimap (view _1) (remoteAuthorId . view _1) authorIdMsig - in author == bimap (componentActor . snd) snd ident + in author == bimap (resourceToActor . componentResource . snd) snd ident theyIsAuthor :: Either (a, ProjectId) (b, RemoteActorId) -> Bool theyIsAuthor ident = @@ -524,7 +524,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do verifyCapability'' uCap authorIdMsig - (LocalActorProject projectID) + (LocalResourceProject projectID) AP.RoleAdmin return fulfillsID ) @@ -578,7 +578,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do -- Prepare a regular Grant let isInvite = isLeft collab grant@(actionGrant, _, _, _) <- lift $ do - Collab role <- getJust collabID + Collab role _ <- getJust collabID prepareCollabGrant isInvite inviterOrJoiner role let recipByKey = LocalActorProject projectID _luGrant <- lift $ updateOutboxItem' recipByKey grantID actionGrant @@ -632,7 +632,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do verifyCapability'' uCap authorIdMsig - (LocalActorProject projectID) + (LocalResourceProject projectID) AP.RoleAdmin ) @@ -770,7 +770,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do verifyCapability'' uCap authorIdMsig - (LocalActorProject projectID) + (LocalResourceProject projectID) AP.RoleAdmin return $ Right () (True, True) -> throwE "Child already enabled, not needing any further Accept" @@ -819,7 +819,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do verifyCapability'' uCap authorIdMsig - (LocalActorProject projectID) + (LocalResourceProject projectID) AP.RoleAdmin return $ Right () (True, True) -> throwE "Just waiting for Grant from parent, or already have it, anyway not needing any further Accept" @@ -1036,7 +1036,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do (uComponent, audComponent) <- case ident of Left c -> do - a <- componentActor <$> hashComponent c + a <- resourceToActor . componentResource <$> hashComponent c return ( encodeRouteHome $ renderLocalActor a , AudLocal [a] [localActorFollowers a] @@ -1546,7 +1546,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do (Left (ATProjectComponents j), _)| j == projectID -> do comp <- bitraverse - (\ la -> fromMaybeE (actorToComponent la) "Not a component") + (\ la -> fromMaybeE (resourceToComponent =<< actorToResource la) "Not a component") pure object addComponent comp @@ -1746,7 +1746,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do verifyCapability'' uCap authorIdMsig - (LocalActorProject projectID) + (LocalResourceProject projectID) AP.RoleAdmin maybeNew <- withDBExcept $ do @@ -1856,7 +1856,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do verifyCapability'' uCap authorIdMsig - (LocalActorProject projectID) + (LocalResourceProject projectID) AP.RoleTriage maybeNew <- withDBExcept $ do @@ -2104,10 +2104,7 @@ projectCreateMe -> ProjectId -> Verse -> ActE (Text, Act (), Next) -projectCreateMe = - topicCreateMe - projectActor LocalActorProject - CollabTopicProjectProject CollabTopicProject +projectCreateMe = topicCreateMe projectResource LocalResourceProject projectCreate :: UTCTime @@ -2339,7 +2336,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do (pure . snd) (\ (_, raID) -> getRemoteActorURI =<< getJust raID) ident - unless (first componentActor identForCheck == bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig) $ + unless (first (resourceToActor . componentResource) identForCheck == bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig) $ throwE "Capability's component and Grant author aren't the same actor" return (role, enableID, ident, identForCheck) @@ -2348,10 +2345,9 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do maybeNew <- withDBExcept $ do -- Grab me from DB - (recipActorID, recipActor) <- lift $ do - recip <- getJust projectID - let actorID = projectActor recip - (actorID,) <$> getJust actorID + resourceID <- lift $ projectResource <$> getJust projectID + Resource recipActorID <- lift $ getJust resourceID + recipActor <- lift $ getJust recipActorID -- Verify I don't yet have a delegation from the component maybeDeleg <- @@ -2376,12 +2372,11 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do -- For each Collab in me, prepare a delegation-extension Grant localCollabs <- lift $ - E.select $ E.from $ \ (topic `E.InnerJoin` collab `E.InnerJoin` enable `E.InnerJoin` recipL `E.InnerJoin` deleg) -> do + E.select $ E.from $ \ (collab `E.InnerJoin` enable `E.InnerJoin` recipL `E.InnerJoin` deleg) -> do E.on $ enable E.^. CollabEnableId E.==. deleg E.^. CollabDelegLocalEnable E.on $ enable E.^. CollabEnableCollab E.==. recipL E.^. CollabRecipLocalCollab - E.on $ topic E.^. CollabTopicProjectCollab E.==. enable E.^. CollabEnableCollab - E.on $ topic E.^. CollabTopicProjectCollab E.==. collab E.^. CollabId - E.where_ $ topic E.^. CollabTopicProjectProject E.==. E.val projectID + E.on $ collab E.^. CollabId E.==. enable E.^. CollabEnableCollab + E.where_ $ collab E.^. CollabTopic E.==. E.val resourceID return ( collab E.^. CollabRole , recipL E.^. CollabRecipLocalPerson @@ -2398,12 +2393,11 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do remoteCollabs <- lift $ - E.select $ E.from $ \ (topic `E.InnerJoin` collab `E.InnerJoin` enable `E.InnerJoin` recipR `E.InnerJoin` deleg) -> do + E.select $ E.from $ \ (collab `E.InnerJoin` enable `E.InnerJoin` recipR `E.InnerJoin` deleg) -> do E.on $ enable E.^. CollabEnableId E.==. deleg E.^. CollabDelegRemoteEnable E.on $ enable E.^. CollabEnableCollab E.==. recipR E.^. CollabRecipRemoteCollab - E.on $ topic E.^. CollabTopicProjectCollab E.==. enable E.^. CollabEnableCollab - E.on $ topic E.^. CollabTopicProjectCollab E.==. collab E.^. CollabId - E.where_ $ topic E.^. CollabTopicProjectProject E.==. E.val projectID + E.on $ collab E.^. CollabId E.==. enable E.^. CollabEnableCollab + E.where_ $ collab E.^. CollabTopic E.==. E.val resourceID return ( collab E.^. CollabRole , recipR E.^. CollabRecipRemoteActor @@ -2519,7 +2513,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do uComponent <- case component of Left c -> do - a <- componentActor <$> hashComponent c + a <- resourceToActor . componentResource <$> hashComponent c return $ encodeRouteHome $ renderLocalActor a Right u -> pure u @@ -2584,7 +2578,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do uComponent <- case component of Left c -> do - a <- componentActor <$> hashComponent c + a <- resourceToActor . componentResource <$> hashComponent c return $ encodeRouteHome $ renderLocalActor a Right u -> pure u @@ -2628,10 +2622,10 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do guard $ fst capability == LocalActorProject projectID -- I don't have a Collab with this capability MaybeT $ getBy $ UniqueCollabEnableGrant $ snd capability - Collab role <- lift $ lift $ getJust collabID + Collab role _ <- lift $ lift $ getJust collabID topic <- lift $ lift $ getCollabTopic collabID -- Found a Collab for this direct-Grant but it's not mine - lift $ guard $ topic == LocalActorProject projectID + lift $ guard $ topic == LocalResourceProject projectID recip <- lift $ lift $ getCollabRecip collabID recipForCheck <- lift $ lift $ @@ -2746,7 +2740,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do Left ci -> hashComponent ci Right _ -> error "Delegation-start Grant URI is local, but component found to be remote, impossible" s <- encodeKeyHashid startID - return $ encodeRouteHome $ activityRoute (componentActor c) s + return $ encodeRouteHome $ activityRoute (resourceToActor $ componentResource c) s Right (E.Value remoteActivityID) -> do ra <- getJust remoteActivityID getRemoteActivityURI ra @@ -2829,7 +2823,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do uComponent <- case component of Left c -> do - a <- componentActor <$> hashComponent c + a <- resourceToActor . componentResource <$> hashComponent c return $ encodeRouteHome $ renderLocalActor a Right u -> pure u @@ -2950,10 +2944,9 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do maybeNew <- withDBExcept $ do -- Grab me from DB - (recipActorID, recipActor) <- lift $ do - recip <- getJust projectID - let actorID = projectActor recip - (actorID,) <$> getJust actorID + resourceID <- lift $ projectResource <$> getJust projectID + Resource recipActorID <- lift $ getJust resourceID + recipActor <- lift $ getJust recipActorID topicWithAccept <- lift $ @@ -2984,12 +2977,11 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do -- For each Collab in me, prepare a delegation-extension Grant localCollabs <- lift $ - E.select $ E.from $ \ (topic `E.InnerJoin` collab `E.InnerJoin` enable `E.InnerJoin` recipL `E.InnerJoin` deleg) -> do + E.select $ E.from $ \ (collab `E.InnerJoin` enable `E.InnerJoin` recipL `E.InnerJoin` deleg) -> do E.on $ enable E.^. CollabEnableId E.==. deleg E.^. CollabDelegLocalEnable E.on $ enable E.^. CollabEnableCollab E.==. recipL E.^. CollabRecipLocalCollab - E.on $ topic E.^. CollabTopicProjectCollab E.==. enable E.^. CollabEnableCollab - E.on $ topic E.^. CollabTopicProjectCollab E.==. collab E.^. CollabId - E.where_ $ topic E.^. CollabTopicProjectProject E.==. E.val projectID + E.on $ collab E.^. CollabId E.==. enable E.^. CollabEnableCollab + E.where_ $ collab E.^. CollabTopic E.==. E.val resourceID return ( collab E.^. CollabRole , recipL E.^. CollabRecipLocalPerson @@ -3010,12 +3002,11 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do remoteCollabs <- lift $ - E.select $ E.from $ \ (topic `E.InnerJoin` collab `E.InnerJoin` enable `E.InnerJoin` recipR `E.InnerJoin` deleg) -> do + E.select $ E.from $ \ (collab `E.InnerJoin` enable `E.InnerJoin` recipR `E.InnerJoin` deleg) -> do E.on $ enable E.^. CollabEnableId E.==. deleg E.^. CollabDelegRemoteEnable E.on $ enable E.^. CollabEnableCollab E.==. recipR E.^. CollabRecipRemoteCollab - E.on $ topic E.^. CollabTopicProjectCollab E.==. enable E.^. CollabEnableCollab - E.on $ topic E.^. CollabTopicProjectCollab E.==. collab E.^. CollabId - E.where_ $ topic E.^. CollabTopicProjectProject E.==. E.val projectID + E.on $ collab E.^. CollabId E.==. enable E.^. CollabEnableCollab + E.where_ $ collab E.^. CollabTopic E.==. E.val resourceID return ( collab E.^. CollabRole , recipR E.^. CollabRecipRemoteActor @@ -3359,7 +3350,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do Left ci -> hashComponent ci Right _ -> error "Delegation-start Grant URI is local, but component found to be remote, impossible" s <- encodeKeyHashid startID - return $ encodeRouteHome $ activityRoute (componentActor c) s + return $ encodeRouteHome $ activityRoute (resourceToActor $ componentResource c) s ext@(actionExt, _, _, _) <- prepareExtensionGrant componentIdent uStart (min role (componentRole component)) enableID destStartID let recipByKey = LocalActorProject projectID @@ -3471,7 +3462,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do uComponent <- case component of Left c -> do - a <- componentActor <$> hashComponent c + a <- resourceToActor . componentResource <$> hashComponent c return $ encodeRouteHome $ renderLocalActor a Right u -> pure u @@ -3655,7 +3646,7 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do (role, resourceOrComps, recipientOrComp) <- parseInvite author invite mode <- case resourceOrComps of - Left (Left (LocalActorProject j)) | j == projectID -> + Left (Left (LocalResourceProject j)) | j == projectID -> Left <$> bitraverse (\case @@ -3700,20 +3691,19 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do maybeNew <- withDBExcept $ do -- Grab me from DB - (topicActorID, topicActor) <- lift $ do - recip <- getJust projectID - let actorID = projectActor recip - (actorID,) <$> getJust actorID + resourceID <- lift $ projectResource <$> getJust projectID + Resource topicActorID <- lift $ getJust resourceID + topicActor <- lift $ getJust topicActorID -- Verify the specified capability gives relevant access verifyCapability' - capability authorIdMsig (LocalActorProject projectID) AP.RoleAdmin + capability authorIdMsig (LocalResourceProject projectID) AP.RoleAdmin case invitedDB of -- Verify that target doesn't already have a Collab for me Left collab -> do - existingCollabIDs <- lift $ getExistingCollabs collab + existingCollabIDs <- lift $ getExistingCollabs resourceID collab case existingCollabIDs of [] -> pure () [_] -> throwE "I already have a Collab for the target" @@ -3730,7 +3720,7 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do -- Insert Collab or Component record to DB acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now case invitedDB of - Left collab -> insertCollab role collab inviteDB acceptID + Left collab -> insertCollab resourceID role collab inviteDB acceptID Right component -> insertComponent component inviteDB acceptID -- Prepare forwarding Invite to my followers @@ -3768,29 +3758,28 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do Right Nothing -> throwE "Target isn't an actor" Right (Just actor) -> return $ entityKey actor - getExistingCollabs (Left (GrantRecipPerson (Entity personID _))) = - E.select $ E.from $ \ (topic `E.InnerJoin` recipl) -> do + getExistingCollabs resourceID (Left (GrantRecipPerson (Entity personID _))) = + E.select $ E.from $ \ (collab `E.InnerJoin` recipl) -> do E.on $ - topic E.^. CollabTopicProjectCollab E.==. + collab E.^. CollabId E.==. recipl E.^. CollabRecipLocalCollab E.where_ $ - topic E.^. CollabTopicProjectProject E.==. E.val projectID E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipl E.^. CollabRecipLocalPerson E.==. E.val personID return $ recipl E.^. CollabRecipLocalCollab - getExistingCollabs (Right remoteActorID) = - E.select $ E.from $ \ (topic `E.InnerJoin` recipr) -> do + getExistingCollabs resourceID (Right remoteActorID) = + E.select $ E.from $ \ (collab `E.InnerJoin` recipr) -> do E.on $ - topic E.^. CollabTopicProjectCollab E.==. + collab E.^. CollabId E.==. recipr E.^. CollabRecipRemoteCollab E.where_ $ - topic E.^. CollabTopicProjectProject E.==. E.val projectID E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipr E.^. CollabRecipRemoteActor E.==. E.val remoteActorID return $ recipr E.^. CollabRecipRemoteCollab - insertCollab role recipient inviteDB acceptID = do - collabID <- insert $ Collab role + insertCollab resourceID role recipient inviteDB acceptID = do + collabID <- insert $ Collab role resourceID fulfillsID <- insert $ CollabFulfillsInvite collabID acceptID - insert_ $ CollabTopicProject collabID projectID case inviteDB of Left (_, _, inviteID) -> insert_ $ CollabInviterLocal fulfillsID inviteID @@ -3840,7 +3829,7 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do return $ AudRemote h [lu] [] Right (Left componentByEnt) -> do componentByHash <- hashComponent $ bmap entityKey componentByEnt - let actor = componentActor componentByHash + let actor = resourceToActor $ componentResource componentByHash return $ AudLocal [actor] [localActorFollowers actor] Right (Right remoteActorID) -> do ra <- getJust remoteActorID @@ -3880,10 +3869,7 @@ projectJoin -> Verse -> AP.Join URIMode -> ActE (Text, Act (), Next) -projectJoin = - topicJoin - projectActor LocalActorProject - CollabTopicProjectProject CollabTopicProjectCollab CollabTopicProject +projectJoin = topicJoin projectResource LocalResourceProject -- Meaning: An actor rejected something -- Behavior: @@ -3908,7 +3894,7 @@ projectReject -> Verse -> AP.Reject URIMode -> ActE (Text, Act (), Next) -projectReject = topicReject projectActor LocalActorProject +projectReject = topicReject projectResource LocalResourceProject -- Meaning: An actor A is removing actor B from collection C -- Behavior: @@ -3960,7 +3946,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig (collection, item) <- parseRemove author remove case (collection, item) of - (Left (Left (LocalActorProject j)), _) | j == projectID -> + (Left (Left (LocalResourceProject j)), _) | j == projectID -> removeCollab item (Left (Right (ATProjectChildren j)), _) | j == projectID -> removeChildActive item @@ -4009,7 +3995,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do verifyCapability'' uCap authorIdMsig - (LocalActorProject projectID) + (LocalResourceProject projectID) AP.RoleAdmin maybeNew <- withDBExcept $ do @@ -4028,43 +4014,40 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do memberByKey -- Grab me from DB - (topicActorID, topicActor) <- lift $ do - recip <- getJust projectID - let actorID = projectActor recip - (actorID,) <$> getJust actorID + resourceID <- lift $ projectResource <$> getJust projectID + Resource topicActorID <- lift $ getJust resourceID + topicActor <- lift $ getJust topicActorID -- Find the collab that the member already has for me existingCollabIDs <- lift $ case memberDB of Left (Entity personID _) -> - fmap (map $ over _2 Left) $ - E.select $ E.from $ \ (topic `E.InnerJoin` recipl) -> do + fmap (map $ over _1 Left) $ + E.select $ E.from $ \ (collab `E.InnerJoin` recipl) -> do E.on $ - topic E.^. CollabTopicProjectCollab E.==. + collab E.^. CollabId E.==. recipl E.^. CollabRecipLocalCollab E.where_ $ - topic E.^. CollabTopicProjectProject E.==. E.val projectID E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipl E.^. CollabRecipLocalPerson E.==. E.val personID return - ( topic E.^. persistIdField - , recipl E.^. persistIdField + ( recipl E.^. persistIdField , recipl E.^. CollabRecipLocalCollab ) Right (Entity remoteActorID _, _) -> - fmap (map $ over _2 Right) $ - E.select $ E.from $ \ (topic `E.InnerJoin` recipr) -> do + fmap (map $ over _1 Right) $ + E.select $ E.from $ \ (collab `E.InnerJoin` recipr) -> do E.on $ - topic E.^. CollabTopicProjectCollab E.==. + collab E.^. CollabId E.==. recipr E.^. CollabRecipRemoteCollab E.where_ $ - topic E.^. CollabTopicProjectProject E.==. E.val projectID E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipr E.^. CollabRecipRemoteActor E.==. E.val remoteActorID return - ( topic E.^. persistIdField - , recipr E.^. persistIdField + ( recipr E.^. persistIdField , recipr E.^. CollabRecipRemoteCollab ) - (E.Value topicID, recipID, E.Value collabID) <- + (recipID, E.Value collabID) <- case existingCollabIDs of [] -> throwE "Remove object isn't a member of me" [collab] -> return collab @@ -4077,14 +4060,15 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do -- Verify that at least 1 more enabled Admin collab for me exists otherCollabIDs <- - lift $ E.select $ E.from $ \ (topic `E.InnerJoin` enable) -> do + lift $ E.select $ E.from $ \ (collab `E.InnerJoin` enable) -> do E.on $ - topic E.^. CollabTopicProjectCollab E.==. + collab E.^. CollabId E.==. enable E.^. CollabEnableCollab E.where_ $ - topic E.^. CollabTopicProjectProject E.==. E.val projectID E.&&. - topic E.^. CollabTopicProjectCollab E.!=. E.val collabID - return $ topic E.^. CollabTopicProjectCollab + collab E.^. CollabTopic E.==. E.val resourceID E.&&. + collab E.^. CollabId E.!=. E.val collabID E.&&. + collab E.^. CollabRole E.==. E.val AP.RoleAdmin + return $ collab E.^. CollabId when (null otherCollabIDs) $ throwE "No other admins exist, can't remove" @@ -4104,7 +4088,6 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do deleteBy $ UniqueCollabRecipRemoteJoinCollab r deleteBy $ UniqueCollabRecipRemoteAcceptCollab r delete r - delete topicID fulfills <- do mf <- runMaybeT $ asum [ Left <$> MaybeT (getKeyBy $ UniqueCollabFulfillsLocalTopicCreation collabID) @@ -4235,7 +4218,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do verifyCapability'' uCap authorIdMsig - (LocalActorProject projectID) + (LocalResourceProject projectID) AP.RoleAdmin maybeNew <- withDBExcept $ do @@ -4518,7 +4501,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do verifyCapability'' uCap authorIdMsig - (LocalActorProject projectID) + (LocalResourceProject projectID) AP.RoleAdmin maybeNew <- withDBExcept $ do diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index 2cc86ff..a929cdc 100644 --- a/src/Vervis/Client.hs +++ b/src/Vervis/Client.hs @@ -1124,7 +1124,7 @@ invite personID uRecipient uResourceCollabs role = do resource resourceDB <- bitraverse - VR.hashLocalActor + VR.hashLocalResource (\ u@(ObjURI h lu) -> do instanceID <- lift $ runDB $ either entityKey id <$> insertBy' (Instance h) @@ -1162,7 +1162,9 @@ invite personID uRecipient uResourceCollabs role = do let audResource = case resourceDB of - Left la -> AudLocal [la] [localActorFollowers la] + Left lr -> + let la = resourceToActor lr + in AudLocal [la] [localActorFollowers la] Right (remoteActor, ObjURI h lu) -> AudRemote h [lu] @@ -1200,7 +1202,7 @@ add personID uRecipient uCollection role = do -- determine the resourc & its managing actor & followers collection target' <- bitraverse - (pure . addTargetActor) + (pure . resourceToActor . addTargetResource) (\ (ObjURI h luColl) -> do manager <- asksSite appHttpManager coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl @@ -1286,7 +1288,7 @@ remove personID uRecipient uCollection = do -- resource via collection 'context' resource' <- bitraverse - (pure . either id addTargetActor) + (pure . either id addTargetResource) (\ (ObjURI h luColl) -> do manager <- asksSite appHttpManager coll <- ExceptT $ liftIO $ first T.pack <$> AP.fetchAPID manager AP.collectionId h luColl @@ -1300,7 +1302,7 @@ remove personID uRecipient uCollection = do -- managing actor & followers collection resourceDB <- bitraverse - VR.hashLocalActor + VR.hashLocalResource (\ u@(ObjURI h lu) -> do instanceID <- lift $ runDB $ either entityKey id <$> insertBy' (Instance h) @@ -1338,7 +1340,9 @@ remove personID uRecipient uCollection = do let audResource = case resourceDB of - Left la -> AudLocal [la] [localActorFollowers la] + Left lr -> + let la = resourceToActor lr + in AudLocal [la] [localActorFollowers la] Right (remoteActor, ObjURI h lu) -> AudRemote h [lu] @@ -1484,13 +1488,13 @@ acceptProjectInvite personID component project uInvite = do acceptPersonalInvite :: PersonId - -> Either (LocalActorBy Key) RemoteActorId + -> Either (LocalResourceBy Key) RemoteActorId -> FedURI -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Accept URIMode) acceptPersonalInvite personID resource uInvite = do encodeRouteHome <- getEncodeRouteHome - resource' <- bitraverse VR.hashLocalActor pure resource + resource' <- bitraverse VR.hashLocalResource pure resource let activity = AP.Accept uInvite Nothing @@ -1510,8 +1514,9 @@ acceptPersonalInvite personID resource uInvite = do let audResource = case resourceDB of - Left la -> - AudLocal [la] [localActorFollowers la] + Left lr -> + let la = resourceToActor lr + in AudLocal [la] [localActorFollowers la] Right (remoteActor, ObjURI h lu) -> AudRemote h [lu] diff --git a/src/Vervis/Data/Collab.hs b/src/Vervis/Data/Collab.hs index f3b7f3c..5e018c9 100644 --- a/src/Vervis/Data/Collab.hs +++ b/src/Vervis/Data/Collab.hs @@ -30,17 +30,15 @@ module Vervis.Data.Collab , parseReject , parseRemove , AddTarget (..) - , addTargetActor + , addTargetResource , parseAdd - , grantResourceActorID - , ComponentBy (..) , parseComponent , hashComponent , unhashComponentE - , componentActor - , actorToComponent + , componentResource + , resourceToComponent ) where @@ -81,11 +79,11 @@ import Vervis.FedURI import Vervis.Foundation import Vervis.Model -parseGrantResourceCollabs (RepoCollabsR r) = Just $ LocalActorRepo r -parseGrantResourceCollabs (DeckCollabsR d) = Just $ LocalActorDeck d -parseGrantResourceCollabs (LoomCollabsR l) = Just $ LocalActorLoom l -parseGrantResourceCollabs (ProjectCollabsR l) = Just $ LocalActorProject l -parseGrantResourceCollabs (GroupMembersR l) = Just $ LocalActorGroup l +parseGrantResourceCollabs (RepoCollabsR r) = Just $ LocalResourceRepo r +parseGrantResourceCollabs (DeckCollabsR d) = Just $ LocalResourceDeck d +parseGrantResourceCollabs (LoomCollabsR l) = Just $ LocalResourceLoom l +parseGrantResourceCollabs (ProjectCollabsR l) = Just $ LocalResourceProject l +parseGrantResourceCollabs (GroupMembersR l) = Just $ LocalResourceGroup l parseGrantResourceCollabs _ = Nothing data GrantRecipBy f = GrantRecipPerson (f Person) @@ -122,7 +120,7 @@ verifyRole = pure parseTopic :: StageRoute Env ~ Route App - => FedURI -> ActE (Either (LocalActorBy Key) FedURI) + => FedURI -> ActE (Either (LocalResourceBy Key) FedURI) parseTopic u = do t <- parseTopic' u bitraverse @@ -136,7 +134,7 @@ parseTopic u = do parseTopic' :: StageRoute Env ~ Route App => FedURI - -> ActE (Either (Either (LocalActorBy Key) ProjectId) FedURI) + -> ActE (Either (Either (LocalResourceBy Key) ProjectId) FedURI) parseTopic' u = do routeOrRemote <- parseFedURI u bitraverse @@ -148,7 +146,7 @@ parseTopic' u = do fromMaybeE (parseGrantResourceCollabs route) "Not a shared resource collabs route" - unhashLocalActorE + unhashLocalResourceE resourceHash "Contains invalid hashid" ) @@ -220,7 +218,7 @@ parseInvite -> AP.Invite URIMode -> ActE ( AP.Role - , Either (Either (LocalActorBy Key) ProjectId) FedURI + , Either (Either (LocalResourceBy Key) ProjectId) FedURI , Either (Either (GrantRecipBy Key) (ComponentBy Key)) FedURI ) parseInvite sender (AP.Invite instrument object target) = @@ -232,7 +230,7 @@ parseInvite sender (AP.Invite instrument object target) = parseJoin :: StageRoute Env ~ Route App => AP.Join URIMode - -> ActE (AP.Role, Either (LocalActorBy Key) FedURI) + -> ActE (AP.Role, Either (LocalResourceBy Key) FedURI) parseJoin (AP.Join instrument object) = (,) <$> verifyRole instrument <*> nameExceptT "Join object" (parseTopic object) @@ -242,7 +240,7 @@ parseGrant -> AP.Grant URIMode -> ActE ( AP.RoleExt - , Either (LocalActorBy Key) LocalURI + , Either (LocalResourceBy Key) LocalURI , Either (GrantRecipBy Key) FedURI , Maybe (LocalURI, Maybe Int) , Maybe UTCTime @@ -276,7 +274,7 @@ parseGrant h (AP.Grant object context target mresult mstart mend allows deleg) = fromMaybeE (decodeRouteLocal lu) "Grant context isn't a valid route" - parseLocalActorE' route + parseLocalResourceE' route else pure $ Right lu parseTarget u@(ObjURI h lu) = do hl <- hostIsLocal h @@ -375,7 +373,7 @@ parseCollabs route = do fromMaybeE (parseGrantResourceCollabs route) "Not a shared resource collabs route" - unhashLocalActorE + unhashLocalResourceE resourceHash "Contains invalid hashid" @@ -384,7 +382,7 @@ parseRemove => Either (LocalActorBy Key) FedURI -> AP.Remove URIMode -> ActE - ( Either (Either (LocalActorBy Key) AddTarget) FedURI + ( Either (Either (LocalResourceBy Key) AddTarget) FedURI , Either (LocalActorBy Key) FedURI ) parseRemove sender (AP.Remove object origin) = @@ -424,13 +422,13 @@ data AddTarget | ATGroupChildren GroupId deriving Eq -addTargetActor :: AddTarget -> LocalActorBy Key -addTargetActor = \case - ATProjectComponents j -> LocalActorProject j - ATProjectParents j -> LocalActorProject j - ATProjectChildren j -> LocalActorProject j - ATGroupParents g -> LocalActorGroup g - ATGroupChildren g -> LocalActorGroup g +addTargetResource :: AddTarget -> LocalResourceBy Key +addTargetResource = \case + ATProjectComponents j -> LocalResourceProject j + ATProjectParents j -> LocalResourceProject j + ATProjectChildren j -> LocalResourceProject j + ATGroupParents g -> LocalResourceGroup g + ATGroupChildren g -> LocalResourceGroup g parseAdd :: StageRoute Env ~ Route App @@ -451,7 +449,7 @@ parseAdd sender (AP.Add object target role _context) = do when (sender == component) $ throwE "Sender and component are the same" case collection of - Left t | sender == Left (addTargetActor t) -> + Left t | sender == Left (resourceToActor $ addTargetResource t) -> throwE "Sender and target collection actor are the same" _ -> pure () return (component, collection, role) @@ -484,14 +482,6 @@ parseAdd sender (AP.Add object target role _context) = do pure routeOrRemote -grantResourceActorID :: LocalActorBy Identity -> ActorId -grantResourceActorID (LocalActorPerson (Identity p)) = personActor p -grantResourceActorID (LocalActorRepo (Identity r)) = repoActor r -grantResourceActorID (LocalActorDeck (Identity d)) = deckActor d -grantResourceActorID (LocalActorLoom (Identity l)) = loomActor l -grantResourceActorID (LocalActorProject (Identity j)) = projectActor j -grantResourceActorID (LocalActorGroup (Identity g)) = groupActor g - data ComponentBy f = ComponentRepo (f Repo) | ComponentDeck (f Deck) @@ -524,14 +514,13 @@ unhashComponent c = do unhashComponentE c e = ExceptT $ maybe (Left e) Right <$> unhashComponent c -componentActor (ComponentRepo r) = LocalActorRepo r -componentActor (ComponentDeck d) = LocalActorDeck d -componentActor (ComponentLoom l) = LocalActorLoom l +componentResource (ComponentRepo r) = LocalResourceRepo r +componentResource (ComponentDeck d) = LocalResourceDeck d +componentResource (ComponentLoom l) = LocalResourceLoom l -actorToComponent = \case - LocalActorPerson _ -> Nothing - LocalActorRepo k -> Just $ ComponentRepo k - LocalActorDeck k -> Just $ ComponentDeck k - LocalActorLoom k -> Just $ ComponentLoom k - LocalActorProject _ -> Nothing - LocalActorGroup _ -> Nothing +resourceToComponent = \case + LocalResourceRepo k -> Just $ ComponentRepo k + LocalResourceDeck k -> Just $ ComponentDeck k + LocalResourceLoom k -> Just $ ComponentLoom k + LocalResourceProject _ -> Nothing + LocalResourceGroup _ -> Nothing diff --git a/src/Vervis/Form/Tracker.hs b/src/Vervis/Form/Tracker.hs index 6d206d6..d4466c9 100644 --- a/src/Vervis/Form/Tracker.hs +++ b/src/Vervis/Form/Tracker.hs @@ -1,6 +1,7 @@ {- This file is part of Vervis. - - - Written in 2016, 2019, 2022, 2023 by fr33domlover . + - Written in 2016, 2019, 2022, 2023, 2024 + - by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -125,10 +126,11 @@ deckInviteForm deckID = renderDivs $ DeckInvite <*> areq selectRole "Role*" Nothing where selectPerson = selectField $ do - l <- runDB $ E.select $ - E.from $ \ (person `E.InnerJoin` actor `E.LeftOuterJoin` (recip `E.InnerJoin` topic)) -> do - E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicDeckCollab E.&&. - topic E.^. CollabTopicDeckDeck E.==. E.val deckID + l <- runDB $ do + resourceID <- deckResource <$> getJust deckID + E.select $ E.from $ \ (person `E.InnerJoin` actor `E.LeftOuterJoin` (recip `E.InnerJoin` collab)) -> do + E.on $ recip E.^. CollabRecipLocalCollab E.==. collab E.^. CollabId E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.on $ person E.^. PersonId E.==. recip E.^. CollabRecipLocalPerson E.on $ person E.^. PersonActor E.==. actor E.^. ActorId E.where_ $ E.isNothing $ E.just $ recip E.^. CollabRecipLocalId @@ -157,10 +159,11 @@ projectInviteForm projectID = renderDivs $ ProjectInvite <*> areq selectRole "Role*" Nothing where selectPerson = selectField $ do - l <- runDB $ E.select $ - E.from $ \ (person `E.InnerJoin` actor `E.LeftOuterJoin` (recip `E.InnerJoin` topic)) -> do - E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicProjectCollab E.&&. - topic E.^. CollabTopicProjectProject E.==. E.val projectID + l <- runDB $ do + resourceID <- projectResource <$> getJust projectID + E.select $ E.from $ \ (person `E.InnerJoin` actor `E.LeftOuterJoin` (recip `E.InnerJoin` collab)) -> do + E.on $ recip E.^. CollabRecipLocalCollab E.==. collab E.^. CollabId E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.on $ person E.^. PersonId E.==. recip E.^. CollabRecipLocalPerson E.on $ person E.^. PersonActor E.==. actor E.^. ActorId E.where_ $ E.isNothing $ E.just $ recip E.^. CollabRecipLocalId @@ -192,10 +195,11 @@ groupInviteForm groupID = renderDivs $ GroupInvite <*> areq selectRole "Role*" Nothing where selectPerson = selectField $ do - l <- runDB $ E.select $ - E.from $ \ (person `E.InnerJoin` actor `E.LeftOuterJoin` (recip `E.InnerJoin` topic)) -> do - E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicGroupCollab E.&&. - topic E.^. CollabTopicGroupGroup E.==. E.val groupID + l <- runDB $ do + resourceID <- groupResource <$> getJust groupID + E.select $ E.from $ \ (person `E.InnerJoin` actor `E.LeftOuterJoin` (recip `E.InnerJoin` collab)) -> do + E.on $ recip E.^. CollabRecipLocalCollab E.==. collab E.^. CollabId E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.on $ person E.^. PersonId E.==. recip E.^. CollabRecipLocalPerson E.on $ person E.^. PersonActor E.==. actor E.^. ActorId E.where_ $ E.isNothing $ E.just $ recip E.^. CollabRecipLocalId diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs index 61bb729..a7f3bac 100644 --- a/src/Vervis/Handler/Client.hs +++ b/src/Vervis/Handler/Client.hs @@ -186,14 +186,11 @@ getHomeR = do ) encodeRouteHome <- getEncodeRouteHome for ls $ \ (E.Value gestureID, E.Value role, E.Value topicID) -> do - topic <- getPermitTopicLocal topicID - actorID <- do - ma <- getLocalActorEntity topic - case ma of - Nothing -> error "Impossible, we should have found the local actor in DB" - Just a -> pure $ localActorID a + PermitTopicLocal _ resourceID <- getJust topicID + Resource actorID <- getJust resourceID actor <- getJust actorID delegator <- getKeyBy $ UniquePermitPersonSendDelegator gestureID + topic <- resourceToActor <$> getLocalResource resourceID exts <- case delegator of Nothing -> pure [] @@ -274,14 +271,11 @@ getHomeR = do , topic E.^. PermitTopicLocalId ) for ls $ \ (E.Value fulfillsID, E.Value role, E.Value valid, E.Value accept, E.Value topicID) -> do - topic <- getPermitTopicLocal topicID - actorID <- do - ma <- getLocalActorEntity topic - case ma of - Nothing -> error "Impossible, we should have found the local actor in DB" - Just a -> pure $ localActorID a + PermitTopicLocal _ resourceID <- getJust topicID + Resource actorID <- getJust resourceID actor <- getJust actorID fulfillsHash <- encodeKeyHashid fulfillsID + topic <- resourceToActor <$> getLocalResource resourceID return ( fulfillsID , role diff --git a/src/Vervis/Handler/Cloth.hs b/src/Vervis/Handler/Cloth.hs index 14a2b1f..ed869e3 100644 --- a/src/Vervis/Handler/Cloth.hs +++ b/src/Vervis/Handler/Cloth.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2020, 2022, 2023 by fr33domlover . + - Written in 2020, 2022, 2023, 2024 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -708,14 +708,14 @@ postClothApplyR loomHash clothHash = do ep@(Entity personID person) <- requireAuth (grantIDs, proposal, actor, loomID) <- runDB $ do - (Entity loomID _, _, _, _, _, proposal) <- getCloth404 loomHash clothHash + (Entity loomID loom, _, _, _, _, proposal) <- getCloth404 loomHash clothHash grantIDs <- - E.select $ E.from $ \ (topic `E.InnerJoin` recip `E.InnerJoin` enable) -> do - E.on $ topic E.^. CollabTopicLoomCollab E.==. enable E.^. CollabEnableCollab - E.on $ topic E.^. CollabTopicLoomCollab E.==. recip E.^. CollabRecipLocalCollab + E.select $ E.from $ \ (collab `E.InnerJoin` recip `E.InnerJoin` enable) -> do + E.on $ collab E.^. CollabId E.==. enable E.^. CollabEnableCollab + E.on $ collab E.^. CollabId E.==. recip E.^. CollabRecipLocalCollab E.where_ $ - topic E.^. CollabTopicLoomLoom E.==. E.val loomID E.&&. + collab E.^. CollabTopic E.==. E.val (loomResource loom) E.&&. recip E.^. CollabRecipLocalPerson E.==. E.val personID return $ enable E.^. CollabEnableGrant diff --git a/src/Vervis/Handler/Deck.hs b/src/Vervis/Handler/Deck.hs index f6b0241..30e02bd 100644 --- a/src/Vervis/Handler/Deck.hs +++ b/src/Vervis/Handler/Deck.hs @@ -417,8 +417,8 @@ getDeckCollabsR :: KeyHashid Deck -> Handler TypedContent getDeckCollabsR deckHash = do deckID <- decodeKeyHashid404 deckHash collabs <- runDB $ do - _deck <- get404 deckID - grants <- getTopicGrants CollabTopicDeckCollab CollabTopicDeckDeck deckID + deck <- get404 deckID + grants <- getTopicGrants $ deckResource deck for grants $ \ (role, actor, _ct, time) -> (role,time,) <$> bitraverse pure (getRemoteActorURI <=< getJust) actor h <- asksSite siteInstanceHost @@ -457,21 +457,18 @@ getDeckCollabsR deckHash = do deck <- get404 deckID actor <- getJust $ deckActor deck collabs <- do - grants <- - getTopicGrants CollabTopicDeckCollab CollabTopicDeckDeck deckID + grants <- getTopicGrants $ deckResource deck for grants $ \ (role, actor, ct, time) -> (,role,ct,time) <$> getPersonWidgetInfo actor invites <- do - invites' <- - getTopicInvites CollabTopicDeckCollab CollabTopicDeckDeck deckID + invites' <- getTopicInvites $ deckResource deck for invites' $ \ (inviter, recip, time, role) -> (,,,) <$> (getPersonWidgetInfo =<< bitraverse grabPerson pure inviter) <*> getPersonWidgetInfo recip <*> pure time <*> pure role joins <- do - joins' <- - getTopicJoins CollabTopicDeckCollab CollabTopicDeckDeck deckID + joins' <- getTopicJoins $ deckResource deck for joins' $ \ (recip, time, role) -> (,time,role) <$> getPersonWidgetInfo recip return (deck, actor, collabs, invites, joins) @@ -506,7 +503,9 @@ postDeckInviteR deckHash = do uResourceCollabs = encodeRouteHome $ DeckCollabsR deckHash C.invite personID uRecipient uResourceCollabs role grantID <- do - maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID + maybeItem <- lift $ runDB $ do + resourceID <- deckResource <$> get404 deckID + getGrant resourceID personID fromMaybeE maybeItem "You need to be a collaborator in the Deck to invite people" grantHash <- encodeKeyHashid grantID let uCap = encodeRouteHome $ DeckOutboxItemR deckHash grantHash @@ -525,8 +524,8 @@ postDeckInviteR deckHash = do setMessage "Invite sent" redirect $ DeckCollabsR deckHash -postDeckRemoveR :: KeyHashid Deck -> CollabTopicDeckId -> Handler Html -postDeckRemoveR deckHash ctID = do +postDeckRemoveR :: KeyHashid Deck -> CollabId -> Handler Html +postDeckRemoveR deckHash collabID = do deckID <- decodeKeyHashid404 deckHash personEntity@(Entity personID person) <- requireAuth @@ -535,18 +534,20 @@ postDeckRemoveR deckHash ctID = do result <- runExceptT $ do mpidOrU <- lift $ runDB $ runMaybeT $ do - CollabTopicDeck collabID deckID' <- MaybeT $ get ctID - guard $ deckID' == deckID + Collab _ resourceID <- MaybeT $ get collabID + d <- MaybeT $ get deckID + guard $ resourceID == deckResource d _ <- MaybeT $ getBy $ UniqueCollabEnable collabID member <- Left <$> MaybeT (getValBy $ UniqueCollabRecipLocal collabID) <|> Right <$> MaybeT (getValBy $ UniqueCollabRecipRemote collabID) lift $ + (resourceID,) <$> bitraverse (pure . collabRecipLocalPerson) (getRemoteActorURI <=< getJust . collabRecipRemoteActor) member - pidOrU <- maybe notFound pure mpidOrU + (resourceID, pidOrU) <- maybe notFound pure mpidOrU (maybeSummary, audience, remove) <- do uRecipient <- case pidOrU of @@ -555,7 +556,7 @@ postDeckRemoveR deckHash ctID = do let uResourceCollabs = encodeRouteHome $ DeckCollabsR deckHash C.remove personID uRecipient uResourceCollabs grantID <- do - maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID + maybeItem <- lift $ runDB $ getGrant resourceID personID fromMaybeE maybeItem "You need to be a collaborator in the Deck to remove people" grantHash <- encodeKeyHashid grantID let uCap = encodeRouteHome $ DeckOutboxItemR deckHash grantHash @@ -651,7 +652,9 @@ postDeckApproveCompR deckHash stemHash = do (maybeSummary, audience, accept) <- C.acceptProjectInvite personID (LocalActorDeck deckID) jidOrURI uInvite grantID <- do - maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID + maybeItem <- lift $ runDB $ do + resourceID <- deckResource <$> get404 deckID + getGrant resourceID personID fromMaybeE maybeItem "You need to be a collaborator in the Deck to remove people" grantHash <- encodeKeyHashid grantID let uCap = encodeRouteHome $ DeckOutboxItemR deckHash grantHash diff --git a/src/Vervis/Handler/Group.hs b/src/Vervis/Handler/Group.hs index b69a6e7..beccf20 100644 --- a/src/Vervis/Handler/Group.hs +++ b/src/Vervis/Handler/Group.hs @@ -237,9 +237,8 @@ getGroupMembersR :: KeyHashid Group -> Handler TypedContent getGroupMembersR groupHash = do groupID <- decodeKeyHashid404 groupHash members <- runDB $ do - _group <- get404 groupID - grants <- - getTopicGrants CollabTopicGroupCollab CollabTopicGroupGroup groupID + group <- get404 groupID + grants <- getTopicGrants $ groupResource group for grants $ \ (role, actor, _ct, time) -> (role,time,) <$> bitraverse pure (getRemoteActorURI <=< getJust) actor h <- asksSite siteInstanceHost @@ -278,21 +277,18 @@ getGroupMembersR groupHash = do group <- get404 groupID actor <- getJust $ groupActor group members <- do - grants <- - getTopicGrants CollabTopicGroupCollab CollabTopicGroupGroup groupID + grants <- getTopicGrants $ groupResource group for grants $ \ (role, actor, ct, time) -> (,role,ct,time) <$> getPersonWidgetInfo actor invites <- do - invites' <- - getTopicInvites CollabTopicGroupCollab CollabTopicGroupGroup groupID + invites' <- getTopicInvites $ groupResource group for invites' $ \ (inviter, recip, time, role) -> (,,,) <$> (getPersonWidgetInfo =<< bitraverse grabPerson pure inviter) <*> getPersonWidgetInfo recip <*> pure time <*> pure role joins <- do - joins' <- - getTopicJoins CollabTopicGroupCollab CollabTopicGroupGroup groupID + joins' <- getTopicJoins $ groupResource group for joins' $ \ (recip, time, role) -> (,time,role) <$> getPersonWidgetInfo recip return (group, actor, members, invites, joins) @@ -327,7 +323,9 @@ postGroupInviteR groupHash = do uResourceCollabs = encodeRouteHome $ GroupMembersR groupHash C.invite personID uRecipient uResourceCollabs role grantID <- do - maybeItem <- lift $ runDB $ getGrant CollabTopicGroupCollab CollabTopicGroupGroup groupID personID + maybeItem <- lift $ runDB $ do + resourceID <- groupResource <$> get404 groupID + getGrant resourceID personID fromMaybeE maybeItem "You need to be a collaborator in the Group to invite people" grantHash <- encodeKeyHashid grantID let uCap = encodeRouteHome $ GroupOutboxItemR groupHash grantHash @@ -346,8 +344,8 @@ postGroupInviteR groupHash = do setMessage "Invite sent" redirect $ GroupMembersR groupHash -postGroupRemoveR :: KeyHashid Group -> CollabTopicGroupId -> Handler Html -postGroupRemoveR groupHash ctID = do +postGroupRemoveR :: KeyHashid Group -> CollabId -> Handler Html +postGroupRemoveR groupHash collabID = do groupID <- decodeKeyHashid404 groupHash personEntity@(Entity personID person) <- requireAuth @@ -356,18 +354,20 @@ postGroupRemoveR groupHash ctID = do result <- runExceptT $ do mpidOrU <- lift $ runDB $ runMaybeT $ do - CollabTopicGroup collabID groupID' <- MaybeT $ get ctID - guard $ groupID' == groupID + Collab _ resourceID <- MaybeT $ get collabID + g <- MaybeT $ get groupID + guard $ resourceID == groupResource g _ <- MaybeT $ getBy $ UniqueCollabEnable collabID member <- Left <$> MaybeT (getValBy $ UniqueCollabRecipLocal collabID) <|> Right <$> MaybeT (getValBy $ UniqueCollabRecipRemote collabID) lift $ + (resourceID,) <$> bitraverse (pure . collabRecipLocalPerson) (getRemoteActorURI <=< getJust . collabRecipRemoteActor) member - pidOrU <- maybe notFound pure mpidOrU + (resourceID, pidOrU) <- maybe notFound pure mpidOrU (maybeSummary, audience, remove) <- do uRecipient <- case pidOrU of @@ -376,7 +376,7 @@ postGroupRemoveR groupHash ctID = do let uResourceCollabs = encodeRouteHome $ GroupMembersR groupHash C.remove personID uRecipient uResourceCollabs grantID <- do - maybeItem <- lift $ runDB $ getGrant CollabTopicGroupCollab CollabTopicGroupGroup groupID personID + maybeItem <- lift $ runDB $ getGrant resourceID personID fromMaybeE maybeItem "You need to be a collaborator in the Group to remove people" grantHash <- encodeKeyHashid grantID let uCap = encodeRouteHome $ GroupOutboxItemR groupHash grantHash diff --git a/src/Vervis/Handler/Loom.hs b/src/Vervis/Handler/Loom.hs index f698d93..6b56328 100644 --- a/src/Vervis/Handler/Loom.hs +++ b/src/Vervis/Handler/Loom.hs @@ -302,15 +302,15 @@ postLoomNewR = do actor <- runDB $ do -- Find the specified repo in DB - _ <- getJust repoID + repo <- getJust repoID -- Make sure the repo has a single, full-access collab, granted to the -- creator of the loom maybeApproved <- runMaybeT $ do - collabs <- lift $ selectList [CollabTopicRepoRepo ==. repoID] [] - collabID <- + collabs <- lift $ selectKeysList [CollabTopic ==. repoResource repo] [] + collabID <- case collabs of - [Entity _ c] -> return $ collabTopicRepoCollab c + [c] -> return c _ -> mzero CollabRecipLocal _ recipID <- MaybeT $ getValBy $ UniqueCollabRecipLocal collabID diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs index d9e0c62..c93864f 100644 --- a/src/Vervis/Handler/Project.hs +++ b/src/Vervis/Handler/Project.hs @@ -95,6 +95,7 @@ import Yesod.Form.Local import Yesod.Persist.Local import Vervis.Access +import Vervis.Actor (resourceToActor) import Vervis.API import Vervis.Data.Collab import Vervis.Federation.Auth @@ -235,8 +236,8 @@ getProjectCollabsR :: KeyHashid Project -> Handler TypedContent getProjectCollabsR projectHash = do projectID <- decodeKeyHashid404 projectHash collabs <- runDB $ do - _project <- get404 projectID - grants <- getTopicGrants CollabTopicProjectCollab CollabTopicProjectProject projectID + project <- get404 projectID + grants <- getTopicGrants $ projectResource project for grants $ \ (role, actor, _ct, time) -> (role,time,) <$> bitraverse pure (getRemoteActorURI <=< getJust) actor h <- asksSite siteInstanceHost @@ -275,21 +276,18 @@ getProjectCollabsR projectHash = do project <- get404 projectID actor <- getJust $ projectActor project collabs <- do - grants <- - getTopicGrants CollabTopicProjectCollab CollabTopicProjectProject projectID + grants <- getTopicGrants $ projectResource project for grants $ \ (role, actor, ct, time) -> (,role,ct,time) <$> getPersonWidgetInfo actor invites <- do - invites' <- - getTopicInvites CollabTopicProjectCollab CollabTopicProjectProject projectID + invites' <- getTopicInvites $ projectResource project for invites' $ \ (inviter, recip, time, role) -> (,,,) <$> (getPersonWidgetInfo =<< bitraverse grabPerson pure inviter) <*> getPersonWidgetInfo recip <*> pure time <*> pure role joins <- do - joins' <- - getTopicJoins CollabTopicProjectCollab CollabTopicProjectProject projectID + joins' <- getTopicJoins $ projectResource project for joins' $ \ (recip, time, role) -> (,time,role) <$> getPersonWidgetInfo recip return (project, actor, collabs, invites, joins) @@ -324,7 +322,9 @@ postProjectInviteR projectHash = do uResourceCollabs = encodeRouteHome $ ProjectCollabsR projectHash C.invite personID uRecipient uResourceCollabs role grantID <- do - maybeItem <- lift $ runDB $ getGrant CollabTopicProjectCollab CollabTopicProjectProject projectID personID + maybeItem <- lift $ runDB $ do + resourceID <- projectResource <$> get404 projectID + getGrant resourceID personID fromMaybeE maybeItem "You need to be a collaborator in the Project to invite people" grantHash <- encodeKeyHashid grantID let uCap = encodeRouteHome $ ProjectOutboxItemR projectHash grantHash @@ -343,8 +343,8 @@ postProjectInviteR projectHash = do setMessage "Invite sent" redirect $ ProjectCollabsR projectHash -postProjectRemoveR :: KeyHashid Project -> CollabTopicProjectId -> Handler Html -postProjectRemoveR projectHash ctID = do +postProjectRemoveR :: KeyHashid Project -> CollabId -> Handler Html +postProjectRemoveR projectHash collabID = do projectID <- decodeKeyHashid404 projectHash personEntity@(Entity personID person) <- requireAuth @@ -353,18 +353,20 @@ postProjectRemoveR projectHash ctID = do result <- runExceptT $ do mpidOrU <- lift $ runDB $ runMaybeT $ do - CollabTopicProject collabID projectID' <- MaybeT $ get ctID - guard $ projectID' == projectID + Collab _ resourceID <- MaybeT $ get collabID + j <- MaybeT $ get projectID + guard $ resourceID == projectResource j _ <- MaybeT $ getBy $ UniqueCollabEnable collabID member <- Left <$> MaybeT (getValBy $ UniqueCollabRecipLocal collabID) <|> Right <$> MaybeT (getValBy $ UniqueCollabRecipRemote collabID) lift $ + (resourceID,) <$> bitraverse (pure . collabRecipLocalPerson) (getRemoteActorURI <=< getJust . collabRecipRemoteActor) member - pidOrU <- maybe notFound pure mpidOrU + (resourceID, pidOrU) <- maybe notFound pure mpidOrU (maybeSummary, audience, remove) <- do uRecipient <- case pidOrU of @@ -373,7 +375,7 @@ postProjectRemoveR projectHash ctID = do let uResourceCollabs = encodeRouteHome $ ProjectCollabsR projectHash C.remove personID uRecipient uResourceCollabs grantID <- do - maybeItem <- lift $ runDB $ getGrant CollabTopicProjectCollab CollabTopicProjectProject projectID personID + maybeItem <- lift $ runDB $ getGrant resourceID personID fromMaybeE maybeItem "You need to be a collaborator in the Project to remove people" grantHash <- encodeKeyHashid grantID let uCap = encodeRouteHome $ ProjectOutboxItemR projectHash grantHash @@ -415,7 +417,8 @@ getProjectComponentsR projectHash = do ( encodeRouteHome . renderLocalActor . hashActor - . componentActor + . resourceToActor + . componentResource ) id ) @@ -533,10 +536,10 @@ getProjectCollabLiveR projectHash enableHash = do projectID <- decodeKeyHashid404 projectHash enableID <- decodeKeyHashid404 enableHash runDB $ do + resourceID <- projectResource <$> get404 projectID CollabEnable collabID _ <- get404 enableID - CollabTopicProject _ j <- - getValBy404 $ UniqueCollabTopicProject collabID - unless (j == projectID) notFound + Collab _ resourceID' <- getJust collabID + unless (resourceID == resourceID') notFound getProjectInviteCompR :: KeyHashid Project -> Handler Html getProjectInviteCompR projectHash = do @@ -558,7 +561,9 @@ postProjectInviteCompR projectHash = do (maybeSummary, audience, invite) <- C.inviteComponent personID projectID uComp grantID <- do - maybeItem <- lift $ runDB $ getGrant CollabTopicProjectCollab CollabTopicProjectProject projectID personID + maybeItem <- lift $ runDB $ do + resourceID <- projectResource <$> get404 projectID + getGrant resourceID personID fromMaybeE maybeItem "You need to be a collaborator in the Project to invite people" grantHash <- encodeKeyHashid grantID let uCap = encodeRouteHome $ ProjectOutboxItemR projectHash grantHash diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index bdf9a4e..763ba02 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -730,10 +730,10 @@ postRepoLinkR repoHash loomHash = do -- Make sure both repo and loom have a single, full-access collab, -- granted to the logged-in person maybeApproved <- lift $ runMaybeT $ do - collabs <- lift $ selectList [CollabTopicRepoRepo ==. repoID] [] - collabID <- + collabs <- lift $ selectKeysList [CollabTopic ==. repoResource repo] [] + collabID <- case collabs of - [Entity _ c] -> return $ collabTopicRepoCollab c + [c] -> return c _ -> mzero CollabRecipLocal _ recipID <- MaybeT $ getValBy $ UniqueCollabRecipLocal collabID @@ -741,10 +741,10 @@ postRepoLinkR repoHash loomHash = do _ <- MaybeT $ getBy $ UniqueCollabFulfillsLocalTopicCreation collabID guard $ recipID == personID - collabs' <- lift $ selectList [CollabTopicLoomLoom ==. loomID] [] - collabID' <- + collabs' <- lift $ selectKeysList [CollabTopic ==. loomResource loom] [] + collabID' <- case collabs' of - [Entity _ c] -> return $ collabTopicLoomCollab c + [c] -> return c _ -> mzero CollabRecipLocal _ recipID' <- MaybeT $ getValBy $ UniqueCollabRecipLocal collabID' diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index f4ed5aa..e61b09a 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -502,7 +502,9 @@ postTicketCloseR deckHash taskHash = do result <- runExceptT $ do (maybeSummary, audience, detail) <- C.resolve personID uTicket grantID <- do - maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID + maybeItem <- lift $ runDB $ do + resourceID <- deckResource <$> get404 deckID + getGrant resourceID personID fromMaybeE maybeItem "You need to be a collaborator in the Deck to close tickets" grantHash <- encodeKeyHashid grantID let uCap = encodeRouteHome $ DeckOutboxItemR deckHash grantHash @@ -532,7 +534,9 @@ postTicketOpenR deckHash taskHash = do result <- runExceptT $ do (maybeSummary, audience, undo) <- C.unresolve personHash uTicket grantID <- do - maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID + maybeItem <- lift $ runDB $ do + resourceID <- deckResource <$> get404 deckID + getGrant resourceID personID fromMaybeE maybeItem "You need to be a collaborator in the Deck to reopen tickets" grantHash <- encodeKeyHashid grantID let uCap = encodeRouteHome $ DeckOutboxItemR deckHash grantHash diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 6d884f2..f19f8a5 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -82,6 +82,7 @@ import Yesod.MonadSite import Yesod.RenderSource import Data.Either.Local +import Data.Maybe.Local import Database.Persist.Local import Vervis.FedURI @@ -3489,6 +3490,118 @@ changes hLocal ctx = "Resource" -- 610 , removeField "PermitTopicExtendResourceLocal" "actor" + -- 611 + , addFieldRefRequired'' + "PermitTopicLocal" + (do inboxID <- insert Inbox611 + outboxID <- insert Outbox611 + followerSetID <- insert FollowerSet611 + actorID <- insert $ Actor611 "" "" defaultTime inboxID outboxID followerSetID Nothing + insertEntity $ Resource611 actorID + ) + (Just $ \ (Entity tempResourceID (Resource611 tempActorID)) -> do + l <- selectKeysList [] [] + for_ l $ \ k -> do + resourceID <- do + options <- + sequence + [ do + ma <- fmap permitTopicRepo611Repo <$> getValBy (UniquePermitTopicRepo611 k) + for ma $ fmap repo611Resource . getJust + , do + ma <- fmap permitTopicDeck611Deck <$> getValBy (UniquePermitTopicDeck611 k) + for ma $ fmap deck611Resource . getJust + , do + ma <- fmap permitTopicLoom611Loom <$> getValBy (UniquePermitTopicLoom611 k) + for ma $ fmap loom611Resource . getJust + , do + ma <- fmap permitTopicGroup611Group <$> getValBy (UniquePermitTopicGroup611 k) + for ma $ fmap group611Resource . getJust + , do + ma <- fmap permitTopicProject611Project <$> getValBy (UniquePermitTopicProject611 k) + for ma $ fmap project611Resource . getJust + ] + exactlyOneJust + options + "Found Permit without topic" + "Found Permit with multiple topics" + update k [PermitTopicLocal611Topic =. resourceID] + + Actor611 _ _ _ inboxID outboxID followerSetID _ <- getJust tempActorID + delete tempResourceID + delete tempActorID + delete inboxID + delete outboxID + delete followerSetID + ) + "topic" + "Resource" + -- 612 + , removeEntity "PermitTopicRepo" + -- 613 + , removeEntity "PermitTopicDeck" + -- 614 + , removeEntity "PermitTopicLoom" + -- 615 + , removeEntity "PermitTopicProject" + -- 616 + , removeEntity "PermitTopicGroup" + -- 617 + , addFieldRefRequired'' + "Collab" + (do inboxID <- insert Inbox611 + outboxID <- insert Outbox611 + followerSetID <- insert FollowerSet611 + actorID <- insert $ Actor611 "" "" defaultTime inboxID outboxID followerSetID Nothing + insertEntity $ Resource611 actorID + ) + (Just $ \ (Entity tempResourceID (Resource611 tempActorID)) -> do + l <- selectKeysList [] [] + for_ l $ \ k -> do + resourceID <- do + options <- + sequence + [ do + ma <- fmap collabTopicRepo611Repo <$> getValBy (UniqueCollabTopicRepo611 k) + for ma $ fmap repo611Resource . getJust + , do + ma <- fmap collabTopicDeck611Deck <$> getValBy (UniqueCollabTopicDeck611 k) + for ma $ fmap deck611Resource . getJust + , do + ma <- fmap collabTopicLoom611Loom <$> getValBy (UniqueCollabTopicLoom611 k) + for ma $ fmap loom611Resource . getJust + , do + ma <- fmap collabTopicGroup611Group <$> getValBy (UniqueCollabTopicGroup611 k) + for ma $ fmap group611Resource . getJust + , do + ma <- fmap collabTopicProject611Project <$> getValBy (UniqueCollabTopicProject611 k) + for ma $ fmap project611Resource . getJust + ] + exactlyOneJust + options + "Found Collab without topic" + "Found Collab with multiple topics" + update k [Collab611Topic =. resourceID] + + Actor611 _ _ _ inboxID outboxID followerSetID _ <- getJust tempActorID + delete tempResourceID + delete tempActorID + delete inboxID + delete outboxID + delete followerSetID + ) + "topic" + "Resource" + -- 618 + , removeEntity "CollabTopicRepo" + -- 619 + , removeEntity "CollabTopicDeck" + -- 620 + , removeEntity "CollabTopicLoom" + -- 621 + , removeEntity "CollabTopicProject" + -- 622 + , removeEntity "CollabTopicGroup" ] migrateDB diff --git a/src/Vervis/Migration/Model2024.hs b/src/Vervis/Migration/Model2024.hs index 8cc944d..550483e 100644 --- a/src/Vervis/Migration/Model2024.hs +++ b/src/Vervis/Migration/Model2024.hs @@ -63,3 +63,6 @@ makeEntitiesMigration "593" makeEntitiesMigration "604" $(modelFile "migrations/604_2024-04-20_resource.model") + +makeEntitiesMigration "611" + $(modelFile "migrations/611_2024-04-20_permit_resource.model") diff --git a/src/Vervis/Persist/Collab.hs b/src/Vervis/Persist/Collab.hs index 237feae..f3a2959 100644 --- a/src/Vervis/Persist/Collab.hs +++ b/src/Vervis/Persist/Collab.hs @@ -15,7 +15,6 @@ module Vervis.Persist.Collab ( getCollabTopic - , getCollabTopic' , getCollabRecip , getPermitTopicLocal , getPermitTopic @@ -94,31 +93,10 @@ import Vervis.Model import Vervis.Persist.Actor getCollabTopic - :: MonadIO m => CollabId -> ReaderT SqlBackend m (LocalActorBy Key) -getCollabTopic = fmap snd . getCollabTopic' - -getCollabTopic' - :: MonadIO m => CollabId -> ReaderT SqlBackend m (ReaderT SqlBackend m (), LocalActorBy Key) -getCollabTopic' collabID = do - maybeRepo <- getBy $ UniqueCollabTopicRepo collabID - maybeDeck <- getBy $ UniqueCollabTopicDeck collabID - maybeLoom <- getBy $ UniqueCollabTopicLoom collabID - maybeProject <- getBy $ UniqueCollabTopicProject collabID - maybeGroup <- getBy $ UniqueCollabTopicGroup collabID - return $ - case (maybeRepo, maybeDeck, maybeLoom, maybeProject, maybeGroup) of - (Nothing, Nothing, Nothing, Nothing, Nothing) -> error "Found Collab without topic" - (Just (Entity k r), Nothing, Nothing, Nothing, Nothing) -> - (delete k, LocalActorRepo $ collabTopicRepoRepo r) - (Nothing, Just (Entity k d), Nothing, Nothing, Nothing) -> - (delete k, LocalActorDeck $ collabTopicDeckDeck d) - (Nothing, Nothing, Just (Entity k l), Nothing, Nothing) -> - (delete k, LocalActorLoom $ collabTopicLoomLoom l) - (Nothing, Nothing, Nothing, Just (Entity k l), Nothing) -> - (delete k, LocalActorProject $ collabTopicProjectProject l) - (Nothing, Nothing, Nothing, Nothing, Just (Entity k l)) -> - (delete k, LocalActorGroup $ collabTopicGroupGroup l) - _ -> error "Found Collab with multiple topics" + :: MonadIO m => CollabId -> ReaderT SqlBackend m (LocalResourceBy Key) +getCollabTopic collabID = do + Collab _ resourceID <- getJust collabID + getLocalResource resourceID getCollabRecip :: MonadIO m @@ -135,32 +113,17 @@ getCollabRecip collabID = getPermitTopicLocal :: MonadIO m => PermitTopicLocalId - -> ReaderT SqlBackend m (LocalActorBy Key) + -> ReaderT SqlBackend m (LocalResourceBy Key) getPermitTopicLocal localID = do - options <- - sequence - [ fmap (LocalActorRepo . permitTopicRepoRepo) <$> - getValBy (UniquePermitTopicRepo localID) - , fmap (LocalActorDeck . permitTopicDeckDeck) <$> - getValBy (UniquePermitTopicDeck localID) - , fmap (LocalActorLoom . permitTopicLoomLoom) <$> - getValBy (UniquePermitTopicLoom localID) - , fmap (LocalActorProject . permitTopicProjectProject) <$> - getValBy (UniquePermitTopicProject localID) - , fmap (LocalActorGroup . permitTopicGroupGroup) <$> - getValBy (UniquePermitTopicGroup localID) - ] - exactlyOneJust - options - "Found Permit without topic" - "Found Permit with multiple topics" + PermitTopicLocal _ resourceID <- getJust localID + getLocalResource resourceID getPermitTopic :: MonadIO m => PermitId -> ReaderT SqlBackend m (Either - (PermitTopicLocalId, LocalActorBy Key) + (PermitTopicLocalId, LocalResourceBy Key) (PermitTopicRemoteId, RemoteActorId) ) getPermitTopic permitID = do @@ -208,29 +171,23 @@ getComponentE (ComponentDeck k) e = ComponentDeck <$> getEntityE k e getComponentE (ComponentLoom k) e = ComponentLoom <$> getEntityE k e getTopicGrants - :: ( MonadIO m - , PersistRecordBackend topic SqlBackend - , PersistRecordBackend resource SqlBackend - ) - => EntityField topic CollabId - -> EntityField topic (Key resource) - -> Key resource - -> ReaderT SqlBackend m [(AP.Role, Either PersonId RemoteActorId, Key topic, UTCTime)] -getTopicGrants topicCollabField topicActorField resourceID = + :: MonadIO m + => ResourceId + -> ReaderT SqlBackend m [(AP.Role, Either PersonId RemoteActorId, CollabId, UTCTime)] +getTopicGrants resourceID = fmap (reverse . sortOn (view _1) . map adapt) $ - E.select $ E.from $ \ (topic `E.InnerJoin` collab `E.InnerJoin` enable `E.InnerJoin` grant `E.LeftOuterJoin` recipL `E.LeftOuterJoin` recipR) -> do + E.select $ E.from $ \ (collab `E.InnerJoin` enable `E.InnerJoin` grant `E.LeftOuterJoin` recipL `E.LeftOuterJoin` recipR) -> do E.on $ E.just (enable E.^. CollabEnableCollab) E.==. recipR E.?. CollabRecipRemoteCollab E.on $ E.just (enable E.^. CollabEnableCollab) E.==. recipL E.?. CollabRecipLocalCollab E.on $ enable E.^. CollabEnableGrant E.==. grant E.^. OutboxItemId - E.on $ topic E.^. topicCollabField E.==. enable E.^. CollabEnableCollab - E.on $ topic E.^. topicCollabField E.==. collab E.^. CollabId - E.where_ $ topic E.^. topicActorField E.==. E.val resourceID + E.on $ collab E.^. CollabId E.==. enable E.^. CollabEnableCollab + E.where_ $ collab E.^. CollabTopic E.==. E.val resourceID E.orderBy [E.desc $ enable E.^. CollabEnableId] return ( collab E.^. CollabRole , recipL E.?. CollabRecipLocalPerson , recipR E.?. CollabRecipRemoteActor - , topic E.^. persistIdField + , collab E.^. CollabId , grant E.^. OutboxItemPublished ) where @@ -246,18 +203,13 @@ getTopicGrants topicCollabField topicActorField resourceID = ) getTopicInvites - :: ( MonadIO m - , PersistRecordBackend topic SqlBackend - , PersistRecordBackend resource SqlBackend - ) - => EntityField topic CollabId - -> EntityField topic (Key resource) - -> Key resource + :: MonadIO m + => ResourceId -> ReaderT SqlBackend m [(Either ActorId RemoteActorId, Either PersonId RemoteActorId, UTCTime, AP.Role)] -getTopicInvites topicCollabField topicActorField resourceID = +getTopicInvites resourceID = fmap (map adapt) $ E.select $ E.from $ - \ (topic `E.InnerJoin` collab `E.LeftOuterJoin` enable `E.InnerJoin` fulfills + \ (collab `E.LeftOuterJoin` enable `E.InnerJoin` fulfills `E.LeftOuterJoin` recipL `E.LeftOuterJoin` recipR `E.LeftOuterJoin` (inviterL `E.InnerJoin` item `E.InnerJoin` actor) `E.LeftOuterJoin` (inviterR `E.InnerJoin` activity) @@ -269,11 +221,10 @@ getTopicInvites topicCollabField topicActorField resourceID = E.on $ E.just (fulfills E.^. CollabFulfillsInviteId) E.==. inviterL E.?. CollabInviterLocalCollab E.on $ E.just (fulfills E.^. CollabFulfillsInviteCollab) E.==. recipR E.?. CollabRecipRemoteCollab E.on $ E.just (fulfills E.^. CollabFulfillsInviteCollab) E.==. recipL E.?. CollabRecipLocalCollab - E.on $ topic E.^. topicCollabField E.==. fulfills E.^. CollabFulfillsInviteCollab - E.on $ E.just (topic E.^. topicCollabField) E.==. enable E.?. CollabEnableCollab - E.on $ topic E.^. topicCollabField E.==. collab E.^. CollabId + E.on $ collab E.^. CollabId E.==. fulfills E.^. CollabFulfillsInviteCollab + E.on $ E.just (collab E.^. CollabId) E.==. enable E.?. CollabEnableCollab E.where_ $ - topic E.^. topicActorField E.==. E.val resourceID E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. E.isNothing (enable E.?. CollabEnableId) E.orderBy [E.asc $ fulfills E.^. CollabFulfillsInviteId] return @@ -314,18 +265,13 @@ getTopicInvites topicCollabField topicActorField resourceID = ) getTopicJoins - :: ( MonadIO m - , PersistRecordBackend topic SqlBackend - , PersistRecordBackend resource SqlBackend - ) - => EntityField topic CollabId - -> EntityField topic (Key resource) - -> Key resource + :: MonadIO m + => ResourceId -> ReaderT SqlBackend m [(Either PersonId RemoteActorId, UTCTime, AP.Role)] -getTopicJoins topicCollabField topicActorField resourceID = +getTopicJoins resourceID = fmap (map adapt) $ E.select $ E.from $ - \ (topic `E.InnerJoin` collab `E.LeftOuterJoin` enable `E.InnerJoin` fulfills + \ (collab `E.LeftOuterJoin` enable `E.InnerJoin` fulfills `E.LeftOuterJoin` (joinL `E.InnerJoin` recipL `E.InnerJoin` item) `E.LeftOuterJoin` (joinR `E.InnerJoin` recipR `E.InnerJoin` activity) ) -> do @@ -335,11 +281,10 @@ getTopicJoins topicCollabField topicActorField resourceID = E.on $ joinL E.?. CollabRecipLocalJoinJoin E.==. item E.?. OutboxItemId E.on $ joinL E.?. CollabRecipLocalJoinCollab E.==. recipL E.?. CollabRecipLocalId E.on $ E.just (fulfills E.^. CollabFulfillsJoinId) E.==. joinL E.?. CollabRecipLocalJoinFulfills - E.on $ topic E.^. topicCollabField E.==. fulfills E.^. CollabFulfillsJoinCollab - E.on $ E.just (topic E.^. topicCollabField) E.==. enable E.?. CollabEnableCollab - E.on $ topic E.^. topicCollabField E.==. collab E.^. CollabId + E.on $ collab E.^. CollabId E.==. fulfills E.^. CollabFulfillsJoinCollab + E.on $ E.just (collab E.^. CollabId) E.==. enable E.?. CollabEnableCollab E.where_ $ - topic E.^. topicActorField E.==. E.val resourceID E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. E.isNothing (enable E.?. CollabEnableId) E.orderBy [E.asc $ fulfills E.^. CollabFulfillsJoinId] return @@ -369,7 +314,7 @@ verifyCapability :: MonadIO m => (LocalActorBy Key, OutboxItemId) -> Either PersonId RemoteActorId - -> LocalActorBy Key + -> LocalResourceBy Key -> AP.Role -> ExceptT Text (ReaderT SqlBackend m) () verifyCapability (capActor, capItem) actor resource requiredRole = do @@ -401,7 +346,7 @@ verifyCapability (capActor, capItem) actor resource requiredRole = do topic <- lift $ getCollabTopic collabID -- Verify that topic is indeed the sender of the Grant - unless (topic == capActor) $ + unless (resourceToActor topic == capActor) $ error "Grant sender isn't the topic" -- Verify the topic matches the resource specified @@ -409,7 +354,7 @@ verifyCapability (capActor, capItem) actor resource requiredRole = do throwE "Capability topic is some other local resource" -- Verify that the granted role is equal or greater than the required role - Collab givenRole <- lift $ getJust collabID + Collab givenRole _ <- lift $ getJust collabID unless (givenRole >= requiredRole) $ throwE "The granted role doesn't allow the requested operation" @@ -419,7 +364,7 @@ verifyCapability' -> Either (LocalActorBy Key, ActorId, OutboxItemId) (RemoteAuthor, LocalURI, Maybe ByteString) - -> LocalActorBy Key + -> LocalResourceBy Key -> AP.Role -> ExceptT Text (ReaderT SqlBackend m) () verifyCapability' cap actor resource role = do @@ -435,30 +380,24 @@ verifyCapability' cap actor resource role = do processRemote (author, _, _) = pure $ remoteAuthorId author getGrant - :: ( MonadIO m - , PersistRecordBackend topic SqlBackend - , PersistRecordBackend resource SqlBackend - , Show (Key resource) - ) - => EntityField topic CollabId - -> EntityField topic (Key resource) - -> Key resource + :: MonadIO m + => ResourceId -> PersonId -> ReaderT SqlBackend m (Maybe OutboxItemId) -getGrant topicCollabField topicActorField resourceID personID = do +getGrant resourceID personID = do items <- - E.select $ E.from $ \ (topic `E.InnerJoin` enable `E.InnerJoin` grant `E.InnerJoin` recipL) -> do + E.select $ E.from $ \ (collab `E.InnerJoin` enable `E.InnerJoin` grant `E.InnerJoin` recipL) -> do E.on $ enable E.^. CollabEnableCollab E.==. recipL E.^. CollabRecipLocalCollab E.on $ enable E.^. CollabEnableGrant E.==. grant E.^. OutboxItemId - E.on $ topic E.^. topicCollabField E.==. enable E.^. CollabEnableCollab + E.on $ collab E.^. CollabId E.==. enable E.^. CollabEnableCollab E.where_ $ - topic E.^. topicActorField E.==. E.val resourceID E.&&. + collab E.^. CollabTopic E.==. E.val resourceID E.&&. recipL E.^. CollabRecipLocalPerson E.==. E.val personID return $ grant E.^. OutboxItemId case items of [] -> return Nothing [E.Value i] -> return $ Just i - _ -> error $ "Multiple grants for a Person in resource#" ++ show resourceID + _ -> error $ "Multiple grants for a Person in " ++ show resourceID getComponentIdent :: MonadIO m @@ -649,7 +588,7 @@ checkExistingStems componentByID projectDB = do const () <$> MaybeT (getBy $ UniqueStemProjectAcceptRemoteProject remoteID) checkExistingPermits - :: PersonId -> Either (LocalActorBy Key) RemoteActorId -> ActDBE () + :: PersonId -> Either ResourceId RemoteActorId -> ActDBE () checkExistingPermits personID topicDB = do -- Find existing Permit records I have for this topic @@ -682,63 +621,13 @@ checkExistingPermits personID topicDB = do where - getExistingPermits (Left (LocalActorPerson _)) = pure [] - getExistingPermits (Left (LocalActorRepo repoID)) = + getExistingPermits (Left resourceID) = fmap (map $ bimap E.unValue (Left . E.unValue)) $ - E.select $ E.from $ \ (permit `E.InnerJoin` local `E.InnerJoin` topic) -> do - E.on $ local E.^. PermitTopicLocalId E.==. topic E.^. PermitTopicRepoPermit + E.select $ E.from $ \ (permit `E.InnerJoin` local) -> do E.on $ permit E.^. PermitId E.==. local E.^. PermitTopicLocalPermit E.where_ $ permit E.^. PermitPerson E.==. E.val personID E.&&. - topic E.^. PermitTopicRepoRepo E.==. E.val repoID - return - ( permit E.^. PermitId - , local E.^. PermitTopicLocalId - ) - getExistingPermits (Left (LocalActorDeck deckID)) = - fmap (map $ bimap E.unValue (Left . E.unValue)) $ - E.select $ E.from $ \ (permit `E.InnerJoin` local `E.InnerJoin` topic) -> do - E.on $ local E.^. PermitTopicLocalId E.==. topic E.^. PermitTopicDeckPermit - E.on $ permit E.^. PermitId E.==. local E.^. PermitTopicLocalPermit - E.where_ $ - permit E.^. PermitPerson E.==. E.val personID E.&&. - topic E.^. PermitTopicDeckDeck E.==. E.val deckID - return - ( permit E.^. PermitId - , local E.^. PermitTopicLocalId - ) - getExistingPermits (Left (LocalActorLoom loomID)) = - fmap (map $ bimap E.unValue (Left . E.unValue)) $ - E.select $ E.from $ \ (permit `E.InnerJoin` local `E.InnerJoin` topic) -> do - E.on $ local E.^. PermitTopicLocalId E.==. topic E.^. PermitTopicLoomPermit - E.on $ permit E.^. PermitId E.==. local E.^. PermitTopicLocalPermit - E.where_ $ - permit E.^. PermitPerson E.==. E.val personID E.&&. - topic E.^. PermitTopicLoomLoom E.==. E.val loomID - return - ( permit E.^. PermitId - , local E.^. PermitTopicLocalId - ) - getExistingPermits (Left (LocalActorProject projectID)) = - fmap (map $ bimap E.unValue (Left . E.unValue)) $ - E.select $ E.from $ \ (permit `E.InnerJoin` local `E.InnerJoin` topic) -> do - E.on $ local E.^. PermitTopicLocalId E.==. topic E.^. PermitTopicProjectPermit - E.on $ permit E.^. PermitId E.==. local E.^. PermitTopicLocalPermit - E.where_ $ - permit E.^. PermitPerson E.==. E.val personID E.&&. - topic E.^. PermitTopicProjectProject E.==. E.val projectID - return - ( permit E.^. PermitId - , local E.^. PermitTopicLocalId - ) - getExistingPermits (Left (LocalActorGroup groupID)) = - fmap (map $ bimap E.unValue (Left . E.unValue)) $ - E.select $ E.from $ \ (permit `E.InnerJoin` local `E.InnerJoin` topic) -> do - E.on $ local E.^. PermitTopicLocalId E.==. topic E.^. PermitTopicGroupPermit - E.on $ permit E.^. PermitId E.==. local E.^. PermitTopicLocalPermit - E.where_ $ - permit E.^. PermitPerson E.==. E.val personID E.&&. - topic E.^. PermitTopicGroupGroup E.==. E.val groupID + local E.^. PermitTopicLocalTopic E.==. E.val resourceID return ( permit E.^. PermitId , local E.^. PermitTopicLocalId @@ -1120,12 +1009,14 @@ getPermitsForResource personID actor = do PermitTopicEnableLocal _ topicID _ <- getJust enableID byk <- getPermitTopicLocal topicID bye <- do - m <- getLocalActorEntity byk + m <- getLocalResourceEntity byk case m of Nothing -> error "I just found this PermitTopicLocal in DB but now the specific actor ID isn't found" Just bye -> pure bye - a <- getJust $ localActorID bye - return (Left (byk, grantID), Left (byk, a)) + Resource aid <- getJust $ localResourceID bye + a <- getJust aid + let byk' = resourceToActor byk + return (Left (byk', grantID), Left (byk', a)) Right (PermitTopicExtendRemote _ enableID grantID) -> do PermitTopicEnableRemote _ topicID _ <- getJust enableID PermitTopicRemote _ remoteActorID <- getJust topicID diff --git a/src/Vervis/Persist/Ticket.hs b/src/Vervis/Persist/Ticket.hs index f8615a7..acdc9ac 100644 --- a/src/Vervis/Persist/Ticket.hs +++ b/src/Vervis/Persist/Ticket.hs @@ -179,7 +179,7 @@ checkApplyDB actor capID (repoID, maybeBranch) (loomID, clothID, bundleID) = do case capID of Left (capActor, _, capItem) -> return (capActor, capItem) Right _ -> throwE "Capability is a remote URI, i.e. not authored by the local loom" - verifyCapability capability actor (LocalActorLoom loomID) AP.RoleWrite + verifyCapability capability actor (LocalResourceLoom loomID) AP.RoleWrite -- Get the patches from DB, verify VCS match just in case diffs <- do diff --git a/src/Vervis/Web/Collab.hs b/src/Vervis/Web/Collab.hs index 20a6993..07f583a 100644 --- a/src/Vervis/Web/Collab.hs +++ b/src/Vervis/Web/Collab.hs @@ -92,7 +92,7 @@ verifyCapability'' -> Either (LocalActorBy Key, ActorId, OutboxItemId) (RemoteAuthor, LocalURI, Maybe ByteString) - -> LocalActorBy Key + -> LocalResourceBy Key -> AP.Role -> ActE () verifyCapability'' uCap recipientActor resource requiredRole = do @@ -100,7 +100,7 @@ verifyCapability'' uCap recipientActor resource requiredRole = do maxDepth <- appMaxGrantChainLength <$> asksEnv envSettings encodeRouteHome <- getEncodeRouteHome uResource <- - encodeRouteHome . VR.renderLocalActor <$> hashLocalActor resource + encodeRouteHome . VR.renderLocalResource <$> hashLocalResource resource now <- liftIO getCurrentTime grants <- traverseGrants maxDepth manager uResource now unless (checkRole grants) $ @@ -198,7 +198,7 @@ verifyCapability'' uCap recipientActor resource requiredRole = do case cap of Left (actor, _, itemID) -> return (actor, itemID) Right _ -> throwE "Remote, so definitely not by me" - unless (capActor == resource) $ + unless (capActor == resourceToActor resource) $ throwE "Capability's actor isn't me, the resource" -- Options here: @@ -229,7 +229,7 @@ verifyCapability'' uCap recipientActor resource requiredRole = do -- Find the local topic, on which this Collab gives access topic <- lift $ getCollabTopic collabID -- Verify that topic is indeed the sender of the Grant - unless (topic == capActor) $ + unless (resourceToActor topic == capActor) $ error "Grant sender isn't the topic" -- Verify the topic matches the resource specified unless (topic == resource) $ @@ -237,7 +237,7 @@ verifyCapability'' uCap recipientActor resource requiredRole = do -- There are more Grants in the chain, so we're -- looking for a Stem or Dest record - else case actorToComponent capActor of + else case (resourceToComponent <=< actorToResource) capActor of Just capTopic -> nameExceptT "Stem" $ do -- Find the Stem record stemID <- do @@ -252,7 +252,7 @@ verifyCapability'' uCap recipientActor resource requiredRole = do unless (topic == capTopic) $ error "Grant sender isn't the Stem ident" -- Verify the topic matches the resource specified - unless (componentActor topic == resource) $ + unless (componentResource topic == resource) $ throwE "Capability topic is some other local resource" Nothing -> nameExceptT "Dest" $ do -- Find the Dest record @@ -266,11 +266,11 @@ verifyCapability'' uCap recipientActor resource requiredRole = do holder <- lift $ getDestHolder destID let holderActor = either - (LocalActorProject . snd) - (LocalActorGroup . snd) + (LocalResourceProject . snd) + (LocalResourceGroup . snd) holder -- Verify that holder is indeed the sender of the Grant - unless (holderActor == capActor) $ + unless (resourceToActor holderActor == capActor) $ error "Grant sender isn't the Dest holder" -- Verify the topic matches the resource specified unless (holderActor == resource) $ @@ -283,7 +283,7 @@ verifyCapability'' uCap recipientActor resource requiredRole = do throwE "Chain is longer than the max depth" case cap of Left (actor, _, _) - | resource == actor -> + | resourceToActor resource == actor -> throwE "Grant.delegates specified but Grant's actor is me" _ -> return () (luResult, _) <- fromMaybeE (AP.grantResult grant) "Grant.result not specified" @@ -428,7 +428,7 @@ checkCapabilityBeforeExtending uCap extender = do -- We already checked that the activity exists in DB -- So proceed to find the Stem or Dest record - case actorToComponent capActor of + case (resourceToComponent <=< actorToResource) capActor of Just capTopic -> nameExceptT "Stem" $ do -- Find the Stem record stemID <- do @@ -444,7 +444,7 @@ checkCapabilityBeforeExtending uCap extender = do error "Grant sender isn't the Stem ident" -- Verify the topic matches the resource specified uTopic <- lift $ lift $ do - actorR <- VR.renderLocalActor <$> hashLocalActor (componentActor topic) + actorR <- VR.renderLocalResource <$> hashLocalResource (componentResource topic) encodeRouteHome <- getEncodeRouteHome return $ encodeRouteHome actorR unless (uTopic == AP.grantContext grant) $ diff --git a/th/models b/th/models index 80e7661..b2acdbf 100644 --- a/th/models +++ b/th/models @@ -591,7 +591,8 @@ RemoteMessage ------------------------------------------------------------------------------ Collab - role Role + role Role + topic ResourceId -------------------------------- Collab reason ------------------------------- @@ -660,38 +661,6 @@ CollabRecipRemoteJoin UniqueCollabRecipRemoteJoinFulfills fulfills UniqueCollabRecipRemoteJoinJoin join --------------------------------- Collab topic -------------------------------- - -CollabTopicRepo - collab CollabId - repo RepoId - - UniqueCollabTopicRepo collab - -CollabTopicDeck - collab CollabId - deck DeckId - - UniqueCollabTopicDeck collab - -CollabTopicLoom - collab CollabId - loom LoomId - - UniqueCollabTopicLoom collab - -CollabTopicProject - collab CollabId - project ProjectId - - UniqueCollabTopicProject collab - -CollabTopicGroup - collab CollabId - group GroupId - - UniqueCollabTopicGroup collab - -------------------------------- Collab recipient ---------------------------- CollabRecipLocal @@ -767,39 +736,10 @@ Permit PermitTopicLocal permit PermitId + topic ResourceId UniquePermitTopicLocal permit -PermitTopicRepo - permit PermitTopicLocalId - repo RepoId - - UniquePermitTopicRepo permit - -PermitTopicDeck - permit PermitTopicLocalId - deck DeckId - - UniquePermitTopicDeck permit - -PermitTopicLoom - permit PermitTopicLocalId - loom LoomId - - UniquePermitTopicLoom permit - -PermitTopicProject - permit PermitTopicLocalId - project ProjectId - - UniquePermitTopicProject permit - -PermitTopicGroup - permit PermitTopicLocalId - group GroupId - - UniquePermitTopicGroup permit - PermitTopicRemote permit PermitId actor RemoteActorId diff --git a/th/routes b/th/routes index 107e4d8..91159fb 100644 --- a/th/routes +++ b/th/routes @@ -174,7 +174,7 @@ /groups/#GroupKeyHashid/members GroupMembersR GET /groups/#GroupKeyHashid/invite GroupInviteR GET POST -/groups/#GroupKeyHashid/remove/#CollabTopicGroupId GroupRemoveR POST +/groups/#GroupKeyHashid/remove/#CollabId GroupRemoveR POST /groups/#GroupKeyHashid/children GroupChildrenR GET /groups/#GroupKeyHashid/children/#DestUsStartKeyHashid/live GroupChildLiveR GET @@ -237,7 +237,7 @@ /decks/#DeckKeyHashid/collabs DeckCollabsR GET /decks/#DeckKeyHashid/invite DeckInviteR GET POST -/decks/#DeckKeyHashid/remove/#CollabTopicDeckId DeckRemoveR POST +/decks/#DeckKeyHashid/remove/#CollabId DeckRemoveR POST /decks/#DeckKeyHashid/projects DeckProjectsR GET /decks/#DeckKeyHashid/projects/approve/#StemKeyHashid DeckApproveCompR POST @@ -343,7 +343,7 @@ /projects/#ProjectKeyHashid/collabs ProjectCollabsR GET /projects/#ProjectKeyHashid/invite ProjectInviteR GET POST -/projects/#ProjectKeyHashid/remove/#CollabTopicProjectId ProjectRemoveR POST +/projects/#ProjectKeyHashid/remove/#CollabId ProjectRemoveR POST /projects/#ProjectKeyHashid/components ProjectComponentsR GET /projects/#ProjectKeyHashid/collabs/#CollabEnableKeyHashid/live ProjectCollabLiveR GET