Fix bug in OCAP verification, wasn't checking Squad records
This commit is contained in:
Pere Lev
parent
a03968ca0b
commit
83a36824a0
1 changed files with 129 additions and 46 deletions
|
|
@ -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,9 +238,16 @@ 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
|
||||
-- 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
|
||||
|
|
@ -255,7 +263,14 @@ verifyCapability'' uCap recipientActor resource requiredRole = do
|
|||
-- Verify the topic matches the resource specified
|
||||
unless (componentResource topic == 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
|
||||
destID <- do
|
||||
duaID <- do
|
||||
|
|
@ -271,12 +286,37 @@ verifyCapability'' uCap recipientActor resource requiredRole = do
|
|||
(LocalResourceGroup . snd)
|
||||
holder
|
||||
-- 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"
|
||||
-- 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
|
||||
|
||||
Just uParent -> nameExceptT "Extension-Grant" $ do
|
||||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue