Fix bug in OCAP verification, wasn't checking Squad records
This commit is contained in:
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"
|
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
|
||||||
|
|
Loading…
Reference in a new issue