diff --git a/src/Vervis/Persist/Collab.hs b/src/Vervis/Persist/Collab.hs index b366045..d5233bd 100644 --- a/src/Vervis/Persist/Collab.hs +++ b/src/Vervis/Persist/Collab.hs @@ -35,6 +35,7 @@ module Vervis.Persist.Collab , getComponentIdent , getSourceTopic , getDestTopic + , getDestHolder , checkExistingStems , checkExistingPermits @@ -543,6 +544,25 @@ getDestTopic destID = do (\ (Entity k v) -> pure (k, destTopicRemoteTopic v)) ident +getDestHolder + :: MonadIO m + => DestId + -> ReaderT SqlBackend m + (Either + (DestHolderProjectId, ProjectId) + (DestHolderGroupId, GroupId) + ) +getDestHolder destID = + bimap + (\ (Entity k (DestHolderProject _ j)) -> (k, j)) + (\ (Entity k (DestHolderGroup _ g)) -> (k, g)) + <$> + requireEitherAlt + (getBy $ UniqueDestHolderProject destID) + (getBy $ UniqueDestHolderGroup destID) + "Found Dest without holder" + "Found Dest with both project and team holder" + checkExistingStems :: ComponentBy Key -> Either (Entity Project) RemoteActorId -> ActDBE () checkExistingStems componentByID projectDB = do diff --git a/src/Vervis/Web/Collab.hs b/src/Vervis/Web/Collab.hs index 7a3d5f7..20a6993 100644 --- a/src/Vervis/Web/Collab.hs +++ b/src/Vervis/Web/Collab.hs @@ -198,11 +198,19 @@ 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) $ + throwE "Capability's actor isn't me, the resource" + + -- Options here: + -- I'm a component/project/team, sent out a Collab record + -- I'm a component, sent out a Stem record + -- I'm a project/team, sent out a Dest record + -- We already checked that the activity exists in DB - -- So proceed to find the Collab or Stem record + -- So proceed to find the Collab, Stem or Dest record if null l - -- This is thr only Grant in the chain, so we're + -- This is the only Grant in the chain, so we're -- looking for a Collab record then nameExceptT "Collab" $ do -- Find the Collab record @@ -228,23 +236,45 @@ verifyCapability'' uCap recipientActor resource requiredRole = do throwE "Capability topic is some other local resource" -- There are more Grants in the chain, so we're - -- looking for a Stem record - else nameExceptT "Stem" $ do - -- Find the Stem record - stemID <- do - scaID <- do - maybeSCA <- lift $ getValBy $ UniqueStemDelegateLocalGrant capItem - stemDelegateLocalStem <$> - fromMaybeE maybeSCA "No StemDelegateLocal for this activity" - lift $ stemComponentAcceptStem <$> getJust scaID - -- Find the local topic, on which this Stem gives access - topic <- lift $ getStemIdent stemID - -- Verify that topic is indeed the sender of the Grant - unless (componentActor topic == capActor) $ - error "Grant sender isn't the Stem ident" - -- Verify the topic matches the resource specified - unless (componentActor topic == resource) $ - throwE "Capability topic is some other local resource" + -- looking for a Stem or Dest record + else case actorToComponent capActor of + Just capTopic -> nameExceptT "Stem" $ do + -- Find the Stem record + stemID <- do + scaID <- do + maybeSCA <- lift $ getValBy $ UniqueStemDelegateLocalGrant capItem + stemDelegateLocalStem <$> + fromMaybeE maybeSCA "No StemDelegateLocal for this activity" + lift $ stemComponentAcceptStem <$> getJust scaID + -- Find the local topic, on which this Stem gives access + topic <- lift $ getStemIdent stemID + -- Verify that topic is indeed the sender of the Grant + unless (topic == capTopic) $ + error "Grant sender isn't the Stem ident" + -- Verify the topic matches the resource specified + unless (componentActor topic == resource) $ + throwE "Capability topic is some other local resource" + Nothing -> nameExceptT "Dest" $ do + -- Find the Dest record + destID <- do + duaID <- do + maybeDUS <- lift $ getValBy $ UniqueDestUsStartGrant capItem + destUsStartDest <$> + fromMaybeE maybeDUS "No DestUsStart for this activity" + lift $ destUsAcceptDest <$> getJust duaID + -- Find the local holder, on which this Dest gives access + holder <- lift $ getDestHolder destID + let holderActor = + either + (LocalActorProject . snd) + (LocalActorGroup . snd) + holder + -- Verify that holder is indeed the sender of the Grant + unless (holderActor == capActor) $ + error "Grant sender isn't the Dest holder" + -- Verify the topic matches the resource specified + unless (holderActor == resource) $ + throwE "Capability topic is some other local resource" return $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l @@ -390,43 +420,16 @@ checkCapabilityBeforeExtending uCap extender = do unless (host == hContext) $ throwE "Start-Grant id and context are from different hosts" case cap of - Left (capActor, _, capItem) -> do + Left (capActor, _, capItem) -> + + -- Options here: + -- It's a component, sent out a StemDelegate record + -- It's a project/team, sent out a DestUsStart record + -- We already checked that the activity exists in DB - -- So proceed to find the Collab or Stem record - if null l - - -- This is thr only Grant in the chain, so we're - -- looking for a Collab record - then nameExceptT "Collab" $ do - -- Find the Collab record - collabID <- do - maybeEnable <- lift $ getValBy $ UniqueCollabEnableGrant capItem - collabEnableCollab <$> - fromMaybeE maybeEnable "No CollabEnable for this activity" - -- Find the recipient of that Collab - recipID <- - lift $ bimap collabRecipLocalPerson collabRecipRemoteActor <$> - requireEitherAlt - (getValBy $ UniqueCollabRecipLocal collabID) - (getValBy $ UniqueCollabRecipRemote collabID) - "No collab recip" - "Both local and remote recips for collab" - -- 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) $ - error "Grant sender isn't the topic" - -- Verify the topic matches the resource specified - uTopic <- lift $ lift $ do - actorR <- VR.renderLocalActor <$> hashLocalActor topic - encodeRouteHome <- getEncodeRouteHome - return $ encodeRouteHome actorR - unless (uTopic == AP.grantContext grant) $ - throwE "Capability topic is some other resource" - - -- There are more Grants in the chain, so we're - -- looking for a Stem record - else nameExceptT "Stem" $ do + -- So proceed to find the Stem or Dest record + case actorToComponent capActor of + Just capTopic -> nameExceptT "Stem" $ do -- Find the Stem record stemID <- do scaID <- do @@ -437,7 +440,7 @@ checkCapabilityBeforeExtending uCap extender = do -- Find the local topic, on which this Stem gives access topic <- lift $ getStemIdent stemID -- Verify that topic is indeed the sender of the Grant - unless (componentActor topic == capActor) $ + unless (topic == capTopic) $ error "Grant sender isn't the Stem ident" -- Verify the topic matches the resource specified uTopic <- lift $ lift $ do @@ -446,6 +449,32 @@ checkCapabilityBeforeExtending uCap extender = do return $ encodeRouteHome actorR unless (uTopic == AP.grantContext grant) $ throwE "Capability topic is some other resource" + Nothing -> nameExceptT "Dest" $ do + -- Find the Dest record + destID <- do + duaID <- do + maybeDUS <- lift $ getValBy $ UniqueDestUsStartGrant capItem + destUsStartDest <$> + fromMaybeE maybeDUS "No DestUsStart for this activity" + lift $ destUsAcceptDest <$> getJust duaID + -- Find the local holder, on which this Dest gives access + holder <- lift $ getDestHolder destID + let holderActor = + either + (LocalActorProject . snd) + (LocalActorGroup . snd) + holder + -- Verify that holder is indeed the sender of the Grant + unless (holderActor == capActor) $ + error "Grant sender isn't the Dest holder" + -- Verify the holder matches the resource specified + uHolder <- lift $ lift $ do + actorR <- VR.renderLocalActor <$> hashLocalActor holderActor + encodeRouteHome <- getEncodeRouteHome + return $ encodeRouteHome actorR + unless (uHolder == AP.grantContext grant) $ + throwE "Capability topic is some other resource" + Right _ -> pure () return $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l @@ -466,6 +495,7 @@ checkCapabilityBeforeExtending uCap extender = do throwE "Result URI gave neither 200 nor 204 status" let uNextRecip = ObjURI host $ AP.activityActor activity go uParent uNextRecip (== AP.grantContext grant) (depth + 1) $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l + checkRole [] = error "Ended up with empty list of grants, impossible" checkRole (g:gs) = go g gs (view _4 g) where