S2S: OCAP verification: Support detection of DestUsStart start-Grants
Until now, a start-Grant could be only a Collab (if it's stand-alone) or a Stem (if it starts a chain). In other words, either a resource enabling a direct collaborator, or a component enabling a project that contains it. With the new project nesting feature now implemented, there's a new kind of start-Grant: A child project, once enabled by its parent, sending the first delegation, giving access-to-self.
This commit is contained in:
Pere Lev
parent
789411f5d2
commit
8f6f5d61bf
2 changed files with 106 additions and 56 deletions
|
|
@ -35,6 +35,7 @@ module Vervis.Persist.Collab
|
|||
, getComponentIdent
|
||||
, getSourceTopic
|
||||
, getDestTopic
|
||||
, getDestHolder
|
||||
|
||||
, checkExistingStems
|
||||
, checkExistingPermits
|
||||
|
|
@ -543,6 +544,25 @@ getDestTopic destID = do
|
|||
(\ (Entity k v) -> pure (k, destTopicRemoteTopic v))
|
||||
ident
|
||||
|
||||
getDestHolder
|
||||
:: MonadIO m
|
||||
=> DestId
|
||||
-> ReaderT SqlBackend m
|
||||
(Either
|
||||
(DestHolderProjectId, ProjectId)
|
||||
(DestHolderGroupId, GroupId)
|
||||
)
|
||||
getDestHolder destID =
|
||||
bimap
|
||||
(\ (Entity k (DestHolderProject _ j)) -> (k, j))
|
||||
(\ (Entity k (DestHolderGroup _ g)) -> (k, g))
|
||||
<$>
|
||||
requireEitherAlt
|
||||
(getBy $ UniqueDestHolderProject destID)
|
||||
(getBy $ UniqueDestHolderGroup destID)
|
||||
"Found Dest without holder"
|
||||
"Found Dest with both project and team holder"
|
||||
|
||||
checkExistingStems
|
||||
:: ComponentBy Key -> Either (Entity Project) RemoteActorId -> ActDBE ()
|
||||
checkExistingStems componentByID projectDB = do
|
||||
|
|
|
|||
|
|
@ -198,11 +198,19 @@ verifyCapability'' uCap recipientActor resource requiredRole = do
|
|||
case cap of
|
||||
Left (actor, _, itemID) -> return (actor, itemID)
|
||||
Right _ -> throwE "Remote, so definitely not by me"
|
||||
unless (capActor == resource) $
|
||||
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, sent out a Stem record
|
||||
-- I'm a project/team, sent out a Dest record
|
||||
|
||||
-- We already checked that the activity exists in DB
|
||||
-- So proceed to find the Collab or Stem record
|
||||
-- So proceed to find the Collab, Stem or Dest record
|
||||
if null l
|
||||
|
||||
-- This is thr only Grant in the chain, so we're
|
||||
-- This is the only Grant in the chain, so we're
|
||||
-- looking for a Collab record
|
||||
then nameExceptT "Collab" $ do
|
||||
-- Find the Collab record
|
||||
|
|
@ -228,23 +236,45 @@ 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 record
|
||||
else 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 (componentActor topic == capActor) $
|
||||
error "Grant sender isn't the Stem ident"
|
||||
-- Verify the topic matches the resource specified
|
||||
unless (componentActor topic == resource) $
|
||||
throwE "Capability topic is some other local resource"
|
||||
-- looking for a Stem or Dest record
|
||||
else case actorToComponent 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 (componentActor 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
|
||||
(LocalActorProject . snd)
|
||||
(LocalActorGroup . snd)
|
||||
holder
|
||||
-- Verify that holder is indeed the sender of the Grant
|
||||
unless (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"
|
||||
|
||||
return $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l
|
||||
|
||||
|
|
@ -390,43 +420,16 @@ checkCapabilityBeforeExtending uCap extender = do
|
|||
unless (host == hContext) $
|
||||
throwE "Start-Grant id and context are from different hosts"
|
||||
case cap of
|
||||
Left (capActor, _, capItem) -> do
|
||||
Left (capActor, _, capItem) ->
|
||||
|
||||
-- Options here:
|
||||
-- It's a component, sent out a StemDelegate record
|
||||
-- It's a project/team, sent out a DestUsStart record
|
||||
|
||||
-- We already checked that the activity exists in DB
|
||||
-- So proceed to find the Collab or Stem record
|
||||
if null l
|
||||
|
||||
-- This is thr only Grant in the chain, so we're
|
||||
-- looking for a Collab record
|
||||
then nameExceptT "Collab" $ do
|
||||
-- Find the Collab record
|
||||
collabID <- do
|
||||
maybeEnable <- lift $ getValBy $ UniqueCollabEnableGrant capItem
|
||||
collabEnableCollab <$>
|
||||
fromMaybeE maybeEnable "No CollabEnable for this activity"
|
||||
-- Find the recipient of that Collab
|
||||
recipID <-
|
||||
lift $ bimap collabRecipLocalPerson collabRecipRemoteActor <$>
|
||||
requireEitherAlt
|
||||
(getValBy $ UniqueCollabRecipLocal collabID)
|
||||
(getValBy $ UniqueCollabRecipRemote collabID)
|
||||
"No collab recip"
|
||||
"Both local and remote recips for collab"
|
||||
-- Find the local topic, on which this Collab gives access
|
||||
topic <- lift $ getCollabTopic collabID
|
||||
-- Verify that topic is indeed the sender of the Grant
|
||||
unless (topic == capActor) $
|
||||
error "Grant sender isn't the topic"
|
||||
-- Verify the topic matches the resource specified
|
||||
uTopic <- lift $ lift $ do
|
||||
actorR <- VR.renderLocalActor <$> hashLocalActor topic
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
return $ encodeRouteHome actorR
|
||||
unless (uTopic == AP.grantContext grant) $
|
||||
throwE "Capability topic is some other resource"
|
||||
|
||||
-- There are more Grants in the chain, so we're
|
||||
-- looking for a Stem record
|
||||
else nameExceptT "Stem" $ do
|
||||
-- So proceed to find the Stem or Dest record
|
||||
case actorToComponent capActor of
|
||||
Just capTopic -> nameExceptT "Stem" $ do
|
||||
-- Find the Stem record
|
||||
stemID <- do
|
||||
scaID <- do
|
||||
|
|
@ -437,7 +440,7 @@ checkCapabilityBeforeExtending uCap extender = do
|
|||
-- 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 (componentActor topic == capActor) $
|
||||
unless (topic == capTopic) $
|
||||
error "Grant sender isn't the Stem ident"
|
||||
-- Verify the topic matches the resource specified
|
||||
uTopic <- lift $ lift $ do
|
||||
|
|
@ -446,6 +449,32 @@ checkCapabilityBeforeExtending uCap extender = do
|
|||
return $ encodeRouteHome actorR
|
||||
unless (uTopic == AP.grantContext grant) $
|
||||
throwE "Capability topic is some other 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
|
||||
(LocalActorProject . snd)
|
||||
(LocalActorGroup . snd)
|
||||
holder
|
||||
-- Verify that holder is indeed the sender of the Grant
|
||||
unless (holderActor == capActor) $
|
||||
error "Grant sender isn't the Dest holder"
|
||||
-- Verify the holder matches the resource specified
|
||||
uHolder <- lift $ lift $ do
|
||||
actorR <- VR.renderLocalActor <$> hashLocalActor 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
|
||||
|
|
@ -466,6 +495,7 @@ checkCapabilityBeforeExtending uCap extender = do
|
|||
throwE "Result URI gave neither 200 nor 204 status"
|
||||
let uNextRecip = ObjURI host $ AP.activityActor activity
|
||||
go uParent uNextRecip (== AP.grantContext grant) (depth + 1) $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l
|
||||
|
||||
checkRole [] = error "Ended up with empty list of grants, impossible"
|
||||
checkRole (g:gs) = go g gs (view _4 g)
|
||||
where
|
||||
|
|
|
|||
Loading…
Reference in a new issue