S2S: Project: Grant: Before extending a Grant, test to avoid infinite loop
This commit is contained in:
Pere Lev
parent
6dd6dc17e5
commit
789411f5d2
2 changed files with 206 additions and 0 deletions
|
|
@ -2946,6 +2946,9 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
|
|||
|
||||
handleChild role sendID topic = do
|
||||
|
||||
uCap <- lift $ getActivityURI authorIdMsig
|
||||
checkCapabilityBeforeExtending uCap (LocalActorProject projectID)
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@
|
|||
|
||||
module Vervis.Web.Collab
|
||||
( verifyCapability''
|
||||
, checkCapabilityBeforeExtending
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -284,3 +285,205 @@ verifyCapability'' uCap recipientActor resource requiredRole = do
|
|||
AP.grantAllows grant == AP.Distribute &&
|
||||
targetIsTeam &&
|
||||
(AP.grantAllows h == AP.Distribute || AP.grantAllows h == AP.Invoke)
|
||||
|
||||
checkCapabilityBeforeExtending
|
||||
:: FedURI
|
||||
-> LocalActorBy Key
|
||||
-> ActE ()
|
||||
checkCapabilityBeforeExtending uCap extender = do
|
||||
manager <- asksEnv envHttpManager
|
||||
maxDepth <- appMaxGrantChainLength <$> asksEnv envSettings
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
uExtender <-
|
||||
encodeRouteHome . VR.renderLocalActor <$> hashLocalActor extender
|
||||
now <- liftIO getCurrentTime
|
||||
grants <- traverseGrants maxDepth manager uExtender now
|
||||
unless (checkRole grants) $
|
||||
throwE "checkRole returns False"
|
||||
where
|
||||
traverseGrants maxDepth manager uExtender now = go uCap uExtender (const True) 1 []
|
||||
where
|
||||
go u@(ObjURI h lu) recipActor resourceOk depth l = do
|
||||
cap <- parseActivityURI' u
|
||||
AP.Doc host activity <-
|
||||
case cap of
|
||||
Left (actor, _, itemID) -> withDBExcept $ do
|
||||
when (actor == extender) $
|
||||
throwE "Found my own Grant in the chain"
|
||||
|
||||
item <- getE itemID "No such OutboxItemId in DB"
|
||||
let outboxID = outboxItemOutbox item
|
||||
actorID <- do
|
||||
ma <- lift $ getKeyBy $ UniqueActorOutbox outboxID
|
||||
fromMaybeE ma "Item's outbox doesn't belong to any actor"
|
||||
itemActor <- lift $ getLocalActor actorID
|
||||
unless (itemActor == actor) $
|
||||
throwE "No such local activity in DB, actor and item mismatch"
|
||||
let obj = persistJSONDoc $ outboxItemActivity item
|
||||
case fromJSON $ Object obj of
|
||||
Error s -> throwE $ "Parsing local activity JSON object into an Activity failed: " <> T.pack s
|
||||
Success doc -> return doc
|
||||
Right _ -> do
|
||||
ract <- lift $ withDB $ runMaybeT $ do
|
||||
instanceID <- MaybeT $ getKeyBy $ UniqueInstance h
|
||||
objectID <- MaybeT $ getKeyBy $ UniqueRemoteObject instanceID lu
|
||||
MaybeT $ getValBy $ UniqueRemoteActivity objectID
|
||||
case ract of
|
||||
Just act -> do
|
||||
let obj = persistJSONDoc $ remoteActivityContent act
|
||||
case fromJSON $ Object obj of
|
||||
Error s -> throwE $ "Parsing cached remote activity JSON object into an Activity failed: " <> T.pack s
|
||||
Success doc -> return doc
|
||||
Nothing -> withExceptT T.pack $ AP.fetchAP manager $ Left u
|
||||
luId <- fromMaybeE (AP.activityId activity) "Activity without id"
|
||||
unless (u == ObjURI host luId) $
|
||||
throwE "Fetched URI and activity id mismatch"
|
||||
grant <-
|
||||
case AP.activitySpecific activity of
|
||||
AP.GrantActivity g -> return g
|
||||
_ -> throwE "Not a Grant activity"
|
||||
|
||||
unless (resourceOk $ AP.grantContext grant) $
|
||||
throwE "Grant.context isn't the resource"
|
||||
unless (AP.grantTarget grant == recipActor) $
|
||||
throwE "Grant.target isn't the actor of the previous grant"
|
||||
when (any ((== u) . view _1) l) $
|
||||
throwE "This Grant is already listed in l"
|
||||
for_ (AP.grantStart grant) $ \ start ->
|
||||
unless (start <= now) $
|
||||
throwE "Grant starts in the future"
|
||||
for_ (AP.grantEnd grant) $ \ end ->
|
||||
unless (now < end) $
|
||||
throwE "Grant has already expired"
|
||||
|
||||
role <-
|
||||
case AP.grantObject grant of
|
||||
AP.RXRole r -> pure r
|
||||
RXDelegator -> throwE "Role is delegator"
|
||||
(targetIsProject, targetIsTeam) <- do
|
||||
routeOrRemote <- parseFedURI $ AP.grantTarget grant
|
||||
case routeOrRemote of
|
||||
Left route -> do
|
||||
actor <- nameExceptT "Grant.target" $ parseLocalActorE' route
|
||||
return $
|
||||
case actor of
|
||||
LocalActorGroup _ -> (False, True)
|
||||
LocalActorProject _ -> (True, False)
|
||||
_ -> (False, False)
|
||||
Right (ObjURI hTarget luTarget) -> do
|
||||
mact <- lift $ withDB $ runMaybeT $ do
|
||||
instanceID <- MaybeT $ getKeyBy $ UniqueInstance h
|
||||
objectID <- MaybeT $ getKeyBy $ UniqueRemoteObject instanceID lu
|
||||
MaybeT $ getValBy $ UniqueRemoteActor objectID
|
||||
typ <-
|
||||
case mact of
|
||||
Just act -> return $ remoteActorType act
|
||||
Nothing -> do
|
||||
actor <- ExceptT $ first T.pack <$> AP.fetchAPID manager (AP.actorId . AP.actorLocal) hTarget luTarget
|
||||
return $ AP.actorType $ AP.actorDetail actor
|
||||
return (typ == AP.ActorTypeProject, typ == AP.ActorTypeTeam)
|
||||
|
||||
case AP.grantDelegates grant of
|
||||
|
||||
Nothing -> nameExceptT "Leaf-Grant" $ withDBExcept $ do
|
||||
let hContext = objUriAuthority $ AP.grantContext grant
|
||||
unless (host == hContext) $
|
||||
throwE "Start-Grant id and context are from different hosts"
|
||||
case cap of
|
||||
Left (capActor, _, capItem) -> do
|
||||
-- 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
|
||||
-- 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
|
||||
uTopic <- lift $ lift $ do
|
||||
actorR <- VR.renderLocalActor <$> hashLocalActor (componentActor topic)
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
return $ encodeRouteHome actorR
|
||||
unless (uTopic == AP.grantContext grant) $
|
||||
throwE "Capability topic is some other resource"
|
||||
Right _ -> pure ()
|
||||
|
||||
return $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l
|
||||
|
||||
Just uParent -> nameExceptT "Extension-Grant" $ do
|
||||
when (depth >= maxDepth) $
|
||||
throwE "Chain is longer than the max depth"
|
||||
when (ObjURI host (AP.activityActor activity) == AP.grantContext grant) $
|
||||
throwE "Grant.delegates specified but Grant's actor is the resource"
|
||||
(luResult, _) <- fromMaybeE (AP.grantResult grant) "Grant.result not specified"
|
||||
req <- either (throwE . T.pack . displayException) pure $ requestFromURI $ uriFromObjURI $ ObjURI host luResult
|
||||
let req' =
|
||||
req { method = "HEAD"
|
||||
}
|
||||
response <- liftIO $ httpNoBody req' manager
|
||||
let status = responseStatus response
|
||||
unless (status == ok200 || status == noContent204) $
|
||||
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
|
||||
go (u, activity, grant, _, targetIsProject, targetIsTeam) rest role =
|
||||
case rest of
|
||||
[] -> checkLeaf
|
||||
h@(_, _, next, role', _, _) : rest' ->
|
||||
role' <= role && checkItem next && go h rest' role'
|
||||
where
|
||||
checkLeaf =
|
||||
case (AP.grantAllows grant, extender) of
|
||||
(AP.GatherAndConvey, LocalActorProject _) -> True
|
||||
(AP.Distribute, LocalActorGroup _) -> True
|
||||
_ -> False
|
||||
checkItem h =
|
||||
AP.grantAllows grant == AP.GatherAndConvey &&
|
||||
targetIsProject
|
||||
||
|
||||
AP.grantAllows grant == AP.Distribute &&
|
||||
targetIsTeam &&
|
||||
(AP.grantAllows h == AP.Distribute || AP.grantAllows h == AP.Invoke)
|
||||
|
|
|
|||
Loading…
Reference in a new issue