forge/Vervis
1
0
Fork 0
Code Pull requests Activity

S2S: OCAP verification: Support detection of DestUsStart start-Grants

Browse source 
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 2024-04-14 12:49:42 +03:00
parent 789411f5d2
commit 8f6f5d61bf
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
2 changed files with 106 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
src/Vervis/Persist/Collab.hs
View file

@ -35,6 +35,7 @@ module Vervis.Persist.Collab
, getComponentIdent , getComponentIdent
, getSourceTopic , getSourceTopic
, getDestTopic , getDestTopic
, getDestHolder
, checkExistingStems , checkExistingStems
, checkExistingPermits , checkExistingPermits
@ -543,6 +544,25 @@ getDestTopic destID = do
(\ (Entity k v) -> pure (k, destTopicRemoteTopic v)) (\ (Entity k v) -> pure (k, destTopicRemoteTopic v))
ident 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 checkExistingStems
:: ComponentBy Key -> Either (Entity Project) RemoteActorId -> ActDBE () :: ComponentBy Key -> Either (Entity Project) RemoteActorId -> ActDBE ()
checkExistingStems componentByID projectDB = do checkExistingStems componentByID projectDB = do

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

@ -198,11 +198,19 @@ verifyCapability'' uCap recipientActor resource requiredRole = do
case cap of case cap of
Left (actor, _, itemID) -> return (actor, itemID) Left (actor, _, itemID) -> return (actor, itemID)
Right _ -> throwE "Remote, so definitely not by me" 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 -- 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 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 -- looking for a Collab record
then nameExceptT "Collab" $ do then nameExceptT "Collab" $ do
-- Find the Collab record -- Find the Collab record
@ -228,23 +236,45 @@ 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 record -- looking for a Stem or Dest record
else nameExceptT "Stem" $ do else case actorToComponent capActor of
-- Find the Stem record Just capTopic -> nameExceptT "Stem" $ do
stemID <- do -- Find the Stem record
scaID <- do stemID <- do
maybeSCA <- lift $ getValBy $ UniqueStemDelegateLocalGrant capItem scaID <- do
stemDelegateLocalStem <$> maybeSCA <- lift $ getValBy $ UniqueStemDelegateLocalGrant capItem
fromMaybeE maybeSCA "No StemDelegateLocal for this activity" stemDelegateLocalStem <$>
lift $ stemComponentAcceptStem <$> getJust scaID fromMaybeE maybeSCA "No StemDelegateLocal for this activity"
-- Find the local topic, on which this Stem gives access lift $ stemComponentAcceptStem <$> getJust scaID
topic <- lift $ getStemIdent stemID -- Find the local topic, on which this Stem gives access
-- Verify that topic is indeed the sender of the Grant topic <- lift $ getStemIdent stemID
unless (componentActor topic == capActor) $ -- Verify that topic is indeed the sender of the Grant
error "Grant sender isn't the Stem ident" unless (topic == capTopic) $
-- Verify the topic matches the resource specified error "Grant sender isn't the Stem ident"
unless (componentActor topic == resource) $ -- Verify the topic matches the resource specified
throwE "Capability topic is some other local resource" 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 return $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l
@ -390,43 +420,16 @@ 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) -> 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 -- We already checked that the activity exists in DB
-- So proceed to find the Collab or Stem record -- So proceed to find the Stem or Dest record
if null l case actorToComponent capActor of
Just capTopic -> nameExceptT "Stem" $ do
-- 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
-- Find the Stem record -- Find the Stem record
stemID <- do stemID <- do
scaID <- do scaID <- do
@ -437,7 +440,7 @@ checkCapabilityBeforeExtending uCap extender = do
-- Find the local topic, on which this Stem gives access -- Find the local topic, on which this Stem gives access
topic <- lift $ getStemIdent stemID topic <- lift $ getStemIdent stemID
-- Verify that topic is indeed the sender of the Grant -- 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" error "Grant sender isn't the Stem ident"
-- Verify the topic matches the resource specified -- Verify the topic matches the resource specified
uTopic <- lift $ lift $ do uTopic <- lift $ lift $ do
@ -446,6 +449,32 @@ 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
-- 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 () Right _ -> pure ()
return $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l 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" throwE "Result URI gave neither 200 nor 204 status"
let uNextRecip = ObjURI host $ AP.activityActor activity let uNextRecip = ObjURI host $ AP.activityActor activity
go uParent uNextRecip (== AP.grantContext grant) (depth + 1) $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l 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 [] = error "Ended up with empty list of grants, impossible"
checkRole (g:gs) = go g gs (view _4 g) checkRole (g:gs) = go g gs (view _4 g)
where where