diff --git a/src/Vervis/Web/Collab.hs b/src/Vervis/Web/Collab.hs index a8db9de..2d9876b 100644 --- a/src/Vervis/Web/Collab.hs +++ b/src/Vervis/Web/Collab.hs @@ -203,12 +203,13 @@ verifyCapability'' uCap recipientActor resource requiredRole = do 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/project/team/factory, sent out a Collab record -- I'm a component, sent out a Stem record -- I'm a project/team, sent out a Dest record + -- I'm a component/project/factory, sent out a Squad record -- We already checked that the activity exists in DB - -- So proceed to find the Collab, Stem or Dest record + -- So proceed to find the Collab, Stem, Dest or Squad record if null l -- This is the only Grant in the chain, so we're @@ -237,45 +238,84 @@ 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 or Dest record - else case (resourceToComponent <=< actorToResource) 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 (componentResource 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 - (LocalResourceProject . snd) - (LocalResourceGroup . snd) - holder - -- Verify that holder is indeed the sender of the Grant - unless (resourceToActor 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" + -- looking for a Stem, Dest or Squad record + else nameExceptT "Stem/Dest/Squad" $ do + + capResource <- fromMaybeE (actorToResource capActor) "capActor isn't a LocalResource" + + asum + [ nameExceptT "Stem" $ do + + capTopic <- fromMaybeE (resourceToComponent capResource) "capResource isn't a LocalComponent" + + -- 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 (componentResource topic == resource) $ + throwE "Capability topic is some other local resource" + + , nameExceptT "Dest" $ do + + case capResource of + LocalResourceProject _ -> pure () + LocalResourceGroup _ -> pure () + _ -> throwE "capActor neither Project nor Group" + + -- 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 + (LocalResourceProject . snd) + (LocalResourceGroup . snd) + holder + -- Verify that holder is indeed the sender of the Grant + unless (holderActor == capResource) $ + 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" + + , nameExceptT "Squad" $ do + + case capResource of + LocalResourceGroup _ -> throwE "capResource is Group" + _ -> pure () + + -- Find the Squad record + squadID <- do + suaID <- do + maybeSUS <- lift $ getValBy $ UniqueSquadUsStartGrant capItem + squadUsStartSquad <$> + fromMaybeE maybeSUS "No SquadUsStart for this activity" + lift $ squadUsAcceptSquad <$> getJust suaID + -- Find the local holder, on which this Squad gives access + holderActor <- lift $ do + Squad _ resourceID <- getJust squadID + getLocalResource resourceID + -- Verify that holder is indeed the sender of the Grant + unless (holderActor == capResource) $ + error "Grant sender isn't the Squad 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 @@ -421,16 +461,23 @@ checkCapabilityBeforeExtending uCap extender = do unless (host == hContext) $ throwE "Start-Grant id and context are from different hosts" case cap of - Left (capActor, _, capItem) -> + Left (capActor, _, capItem) -> nameExceptT "Stem/Dest/Squad" $ do -- Options here: -- It's a component, sent out a StemDelegate record -- It's a project/team, sent out a DestUsStart record + -- I'm a component/project/factory, sent out a Squad record -- We already checked that the activity exists in DB - -- So proceed to find the Stem or Dest record - case (resourceToComponent <=< actorToResource) capActor of - Just capTopic -> nameExceptT "Stem" $ do + -- So proceed to find the Stem, Dest or Squad record + + capResource <- fromMaybeE (actorToResource capActor) "capActor isn't a LocalResource" + + asum + [ nameExceptT "Stem" $ do + + capTopic <- fromMaybeE (resourceToComponent capResource) "capResource isn't a LocalComponent" + -- Find the Stem record stemID <- do scaID <- do @@ -450,7 +497,14 @@ checkCapabilityBeforeExtending uCap extender = do return $ encodeRouteHome actorR unless (uTopic == AP.grantContext grant) $ throwE "Capability topic is some other resource" - Nothing -> nameExceptT "Dest" $ do + + , nameExceptT "Dest" $ do + + case capResource of + LocalResourceProject _ -> pure () + LocalResourceGroup _ -> pure () + _ -> throwE "capActor neither Project nor Group" + -- Find the Dest record destID <- do duaID <- do @@ -476,6 +530,35 @@ checkCapabilityBeforeExtending uCap extender = do unless (uHolder == AP.grantContext grant) $ throwE "Capability topic is some other resource" + , nameExceptT "Squad" $ do + + case capResource of + LocalResourceGroup _ -> throwE "capResource is Group" + _ -> pure () + + -- Find the Squad record + squadID <- do + suaID <- do + maybeSUS <- lift $ getValBy $ UniqueSquadUsStartGrant capItem + squadUsStartSquad <$> + fromMaybeE maybeSUS "No SquadUsStart for this activity" + lift $ squadUsAcceptSquad <$> getJust suaID + -- Find the local holder, on which this Squad gives access + holderActor <- lift $ do + Squad _ resourceID <- getJust squadID + getLocalResource resourceID + -- Verify that holder is indeed the sender of the Grant + unless (holderActor == capResource) $ + error "Grant sender isn't the Squad holder" + -- Verify the holder matches the resource specified + uHolder <- lift $ lift $ do + actorR <- VR.renderLocalResource <$> hashLocalResource 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