forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Fix bug in OCAP verification, wasn't checking Squad records

Browse source
This commit is contained in:
Pere Lev 2024-08-08 14:36:11 +03:00
parent a03968ca0b
commit 83a36824a0
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
1 changed files with 129 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

175
src/Vervis/Web/Collab.hs
View file

@ -203,12 +203,13 @@ verifyCapability'' uCap recipientActor resource requiredRole = do
throwE "Capability's actor isn't me, the resource" throwE "Capability's actor isn't me, the resource"
-- Options here: -- 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 component, sent out a Stem record
-- I'm a project/team, sent out a Dest 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 -- 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 if null l
-- This is the only Grant in the chain, so we're -- 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" throwE "Capability topic is some other local resource"
-- There are more Grants in the chain, so we're -- There are more Grants in the chain, so we're
-- looking for a Stem or Dest record -- looking for a Stem, Dest or Squad record
else case (resourceToComponent <=< actorToResource) capActor of else nameExceptT "Stem/Dest/Squad" $ do
Just capTopic -> nameExceptT "Stem" $ do
-- Find the Stem record capResource <- fromMaybeE (actorToResource capActor) "capActor isn't a LocalResource"
stemID <- do
scaID <- do asum
maybeSCA <- lift $ getValBy $ UniqueStemDelegateLocalGrant capItem [ nameExceptT "Stem" $ do
stemDelegateLocalStem <$>
fromMaybeE maybeSCA "No StemDelegateLocal for this activity" capTopic <- fromMaybeE (resourceToComponent capResource) "capResource isn't a LocalComponent"
lift $ stemComponentAcceptStem <$> getJust scaID
-- Find the local topic, on which this Stem gives access -- Find the Stem record
topic <- lift $ getStemIdent stemID stemID <- do
-- Verify that topic is indeed the sender of the Grant scaID <- do
unless (topic == capTopic) $ maybeSCA <- lift $ getValBy $ UniqueStemDelegateLocalGrant capItem
error "Grant sender isn't the Stem ident" stemDelegateLocalStem <$>
-- Verify the topic matches the resource specified fromMaybeE maybeSCA "No StemDelegateLocal for this activity"
unless (componentResource topic == resource) $ lift $ stemComponentAcceptStem <$> getJust scaID
throwE "Capability topic is some other local resource" -- Find the local topic, on which this Stem gives access
Nothing -> nameExceptT "Dest" $ do topic <- lift $ getStemIdent stemID
-- Find the Dest record -- Verify that topic is indeed the sender of the Grant
destID <- do unless (topic == capTopic) $
duaID <- do error "Grant sender isn't the Stem ident"
maybeDUS <- lift $ getValBy $ UniqueDestUsStartGrant capItem -- Verify the topic matches the resource specified
destUsStartDest <$> unless (componentResource topic == resource) $
fromMaybeE maybeDUS "No DestUsStart for this activity" throwE "Capability topic is some other local resource"
lift $ destUsAcceptDest <$> getJust duaID
-- Find the local holder, on which this Dest gives access , nameExceptT "Dest" $ do
holder <- lift $ getDestHolder destID
let holderActor = case capResource of
either LocalResourceProject _ -> pure ()
(LocalResourceProject . snd) LocalResourceGroup _ -> pure ()
(LocalResourceGroup . snd) _ -> throwE "capActor neither Project nor Group"
holder
-- Verify that holder is indeed the sender of the Grant -- Find the Dest record
unless (resourceToActor holderActor == capActor) $ destID <- do
error "Grant sender isn't the Dest holder" duaID <- do
-- Verify the topic matches the resource specified maybeDUS <- lift $ getValBy $ UniqueDestUsStartGrant capItem
unless (holderActor == resource) $ destUsStartDest <$>
throwE "Capability topic is some other local resource" 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 return $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l
@ -421,16 +461,23 @@ checkCapabilityBeforeExtending uCap extender = do
unless (host == hContext) $ unless (host == hContext) $
throwE "Start-Grant id and context are from different hosts" throwE "Start-Grant id and context are from different hosts"
case cap of case cap of
Left (capActor, _, capItem) -> Left (capActor, _, capItem) -> nameExceptT "Stem/Dest/Squad" $ do
-- Options here: -- Options here:
-- It's a component, sent out a StemDelegate record -- It's a component, sent out a StemDelegate record
-- It's a project/team, sent out a DestUsStart 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 -- We already checked that the activity exists in DB
-- So proceed to find the Stem or Dest record -- So proceed to find the Stem, Dest or Squad record
case (resourceToComponent <=< actorToResource) capActor of
Just capTopic -> nameExceptT "Stem" $ 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 -- Find the Stem record
stemID <- do stemID <- do
scaID <- do scaID <- do
@ -450,7 +497,14 @@ checkCapabilityBeforeExtending uCap extender = do
return $ encodeRouteHome actorR return $ encodeRouteHome actorR
unless (uTopic == AP.grantContext grant) $ unless (uTopic == AP.grantContext grant) $
throwE "Capability topic is some other resource" 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 -- Find the Dest record
destID <- do destID <- do
duaID <- do duaID <- do
@ -476,6 +530,35 @@ checkCapabilityBeforeExtending uCap extender = do
unless (uHolder == AP.grantContext grant) $ unless (uHolder == AP.grantContext grant) $
throwE "Capability topic is some other resource" 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 () Right _ -> pure ()
return $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l return $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l