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

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

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,9 +238,16 @@ 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
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
@ -255,7 +263,14 @@ verifyCapability'' uCap recipientActor resource requiredRole = do
-- Verify the topic matches the resource specified -- Verify the topic matches the resource specified
unless (componentResource topic == resource) $ unless (componentResource topic == resource) $
throwE "Capability topic is some other local resource" throwE "Capability topic is some other local 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
@ -271,12 +286,37 @@ verifyCapability'' uCap recipientActor resource requiredRole = do
(LocalResourceGroup . snd) (LocalResourceGroup . snd)
holder holder
-- Verify that holder is indeed the sender of the Grant -- Verify that holder is indeed the sender of the Grant
unless (resourceToActor holderActor == capActor) $ unless (holderActor == capResource) $
error "Grant sender isn't the Dest holder" error "Grant sender isn't the Dest holder"
-- Verify the topic matches the resource specified -- Verify the topic matches the resource specified
unless (holderActor == resource) $ unless (holderActor == resource) $
throwE "Capability topic is some other local 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
Just uParent -> nameExceptT "Extension-Grant" $ do Just uParent -> nameExceptT "Extension-Grant" $ do
@ -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