S2S: Project: Grant: Prepare for adding the child/parent modes
This commit is contained in:
Pere Lev
parent
3570d502cb
commit
533d8e2ff7
1 changed files with 85 additions and 97 deletions
|
|
@ -1854,6 +1854,11 @@ projectFollow now recipProjectID verse follow = do
|
|||
(\ _ -> pure [])
|
||||
now recipProjectID verse follow
|
||||
|
||||
data GrantKind
|
||||
= GKDelegationStart AP.Role
|
||||
| GKDelegationExtend AP.Role
|
||||
| GKDelegator
|
||||
|
||||
-- Meaning: An actor is granting access-to-some-resource to another actor
|
||||
-- Behavior:
|
||||
-- * Option 1 - Component sending me a delegation-start - Verify that:
|
||||
|
|
@ -1961,31 +1966,27 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
|
|||
_ -> throwE "Capability is remote i.e. definitely not by me"
|
||||
|
||||
-- Check grant
|
||||
grant' <-
|
||||
Left <$> checkDelegationStart grant <|>
|
||||
Right <$> checkDelegator grant
|
||||
|
||||
case grant' of
|
||||
Left (role, component) -> handleComp capability role component
|
||||
Right collab -> handleCollab capability collab
|
||||
grant' <- checkGrant grant
|
||||
let adapt = maybe (Right Nothing) (either Left (Right . Just))
|
||||
maybeMode <-
|
||||
withDBExcept $ ExceptT $ fmap adapt $ runMaybeT $
|
||||
runExceptT (Left <$> tryComp capability grant') <|>
|
||||
runExceptT (Right <$> tryCollab capability grant')
|
||||
mode <-
|
||||
fromMaybeE
|
||||
maybeMode
|
||||
"Not a relevant Grant that I'm aware of"
|
||||
case mode of
|
||||
Left (role, enableID, ident, identForCheck) ->
|
||||
handleComp role enableID ident identForCheck
|
||||
Right (enableID, role, recip) ->
|
||||
handleCollab enableID role recip
|
||||
|
||||
where
|
||||
|
||||
checkDelegationStart g = do
|
||||
checkGrant g = do
|
||||
(role, resource, recipient, _mresult, mstart, mend, usage, mdeleg) <-
|
||||
parseGrant' g
|
||||
role' <-
|
||||
case role of
|
||||
AP.RXRole r -> pure r
|
||||
AP.RXDelegator -> throwE "Role is delegator"
|
||||
component <-
|
||||
fromMaybeE
|
||||
(bitraverse actorToComponent Just resource)
|
||||
"Resource is a local project, therefore not a component of mine"
|
||||
case (component, authorIdMsig) of
|
||||
(Left c, Left (a, _, _)) | componentActor c == a -> pure ()
|
||||
(Right u, Right (ra, _, _)) | remoteAuthorURI ra == u -> pure ()
|
||||
_ -> throwE "Author and context aren't the same actor"
|
||||
case recipient of
|
||||
Left (LocalActorProject j) | j == projectID -> pure ()
|
||||
_ -> throwE "Target isn't me"
|
||||
|
|
@ -1993,44 +1994,48 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
|
|||
unless (start < now) $ throwE "Start time is in the future"
|
||||
for_ mend $ \ _ ->
|
||||
throwE "End time is specified"
|
||||
unless (usage == AP.GatherAndConvey) $
|
||||
throwE "Usage isn't GatherAndConvey"
|
||||
for_ mdeleg $ \ _ ->
|
||||
throwE "'delegates' is specified"
|
||||
return (role', component)
|
||||
|
||||
checkDelegator g = do
|
||||
(role, resource, recipient, _mresult, mstart, mend, usage, mdeleg) <-
|
||||
parseGrant' g
|
||||
case role of
|
||||
AP.RXRole _ -> throwE "Role isn't delegator"
|
||||
AP.RXDelegator -> pure ()
|
||||
collab <-
|
||||
let resourceIsAuthor =
|
||||
case (resource, authorIdMsig) of
|
||||
(Left a, Left (a', _, _)) -> a == a'
|
||||
(Right u, Right (ra, _, _)) -> remoteAuthorURI ra == u
|
||||
_ -> False
|
||||
|
||||
case (role, resourceIsAuthor, usage, mdeleg) of
|
||||
(AP.RXRole r, True, AP.GatherAndConvey, Nothing) ->
|
||||
pure $ GKDelegationStart r
|
||||
(AP.RXRole r, False, AP.GatherAndConvey, Just _) ->
|
||||
pure $ GKDelegationExtend r
|
||||
(AP.RXDelegator, True, AP.Invoke, Nothing) ->
|
||||
pure GKDelegator
|
||||
_ -> throwE "A kind of Grant that I don't use"
|
||||
|
||||
tryComp _ (GKDelegationExtend _) = lift mzero
|
||||
tryComp _ GKDelegator = lift mzero
|
||||
tryComp capability (GKDelegationStart role) = do
|
||||
-- Find the Component record from the capability
|
||||
Entity enableID (ComponentEnable componentID _) <- lift $ do
|
||||
-- Capability isn't mine
|
||||
guard $ fst capability == LocalActorProject projectID
|
||||
-- I don't have a Component with this capability
|
||||
MaybeT $ getBy $ UniqueComponentEnableGrant $ snd capability
|
||||
Component j role' <- lift $ lift $ getJust componentID
|
||||
-- Found a Component for this delegator-Grant but it's not mine
|
||||
lift $ guard $ j == projectID
|
||||
unless (role' == role) $
|
||||
throwE "Grant role isn't the same as in the Invite/Add"
|
||||
ident <- lift $ lift $ getComponentIdent componentID
|
||||
identForCheck <-
|
||||
lift $ lift $
|
||||
bitraverse
|
||||
(\case
|
||||
LocalActorPerson p -> pure p
|
||||
_ -> throwE "Local resource isn't a Person, therefore not a collaborator of mine"
|
||||
)
|
||||
pure
|
||||
resource
|
||||
case (collab, authorIdMsig) of
|
||||
(Left c, Left (a, _, _)) | LocalActorPerson c == a -> pure ()
|
||||
(Right u, Right (ra, _, _)) | remoteAuthorURI ra == u -> pure ()
|
||||
_ -> throwE "Author and context aren't the same actor"
|
||||
case recipient of
|
||||
Left (LocalActorProject j) | j == projectID -> pure ()
|
||||
_ -> throwE "Target isn't me"
|
||||
for_ mstart $ \ start ->
|
||||
unless (start < now) $ throwE "Start time is in the future"
|
||||
for_ mend $ \ _ ->
|
||||
throwE "End time is specified"
|
||||
unless (usage == AP.Invoke) $
|
||||
throwE "Usage isn't Invoke"
|
||||
for_ mdeleg $ \ _ ->
|
||||
throwE "'delegates' is specified"
|
||||
return collab
|
||||
(pure . snd)
|
||||
(\ (_, raID) -> getRemoteActorURI =<< getJust raID)
|
||||
ident
|
||||
unless (first componentActor identForCheck == bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig) $
|
||||
throwE "Capability's component and Grant author aren't the same actor"
|
||||
return (role, enableID, ident, identForCheck)
|
||||
|
||||
handleComp capability role component = do
|
||||
handleComp role enableID ident identForCheck = do
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
|
|
@ -2040,27 +2045,6 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
|
|||
let actorID = projectActor recip
|
||||
(actorID,) <$> getJust actorID
|
||||
|
||||
-- Find the Component record from the capability
|
||||
Entity enableID (ComponentEnable componentID _) <- do
|
||||
unless (fst capability == LocalActorProject projectID) $
|
||||
throwE "Capability isn't mine"
|
||||
m <- lift $ getBy $ UniqueComponentEnableGrant $ snd capability
|
||||
fromMaybeE m "I don't have a Component with this capability"
|
||||
Component j role' <- lift $ getJust componentID
|
||||
unless (j == projectID) $
|
||||
throwE "Found a Component for this delegator-Grant but it's not mine"
|
||||
unless (role' == role) $
|
||||
throwE "Grant role isn't the same as in the Invite/Add"
|
||||
ident <- lift $ getComponentIdent componentID
|
||||
identForCheck <-
|
||||
lift $
|
||||
bitraverse
|
||||
(pure . snd)
|
||||
(\ (_, raID) -> getRemoteActorURI =<< getJust raID)
|
||||
ident
|
||||
unless (identForCheck == component) $
|
||||
throwE "Capability's component and Grant author aren't the same actor"
|
||||
|
||||
-- Verify I don't yet have a delegation from the component
|
||||
maybeDeleg <-
|
||||
lift $ case bimap fst fst ident of
|
||||
|
|
@ -2327,7 +2311,31 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
|
|||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
handleCollab capability collab = do
|
||||
tryCollab _ (GKDelegationStart _) = lift mzero
|
||||
tryCollab _ (GKDelegationExtend _) = lift mzero
|
||||
tryCollab capability GKDelegator = do
|
||||
-- Find the Collab record from the capability
|
||||
Entity enableID (CollabEnable collabID _) <- lift $ do
|
||||
-- Capability isn't mine
|
||||
guard $ fst capability == LocalActorProject projectID
|
||||
-- I don't have a Collab with this capability
|
||||
MaybeT $ getBy $ UniqueCollabEnableGrant $ snd capability
|
||||
Collab role <- lift $ lift $ getJust collabID
|
||||
topic <- lift $ lift $ getCollabTopic collabID
|
||||
-- Found a Collab for this direct-Grant but it's not mine
|
||||
lift $ guard $ topic == LocalActorProject projectID
|
||||
recip <- lift $ lift $ getCollabRecip collabID
|
||||
recipForCheck <-
|
||||
lift $ lift $
|
||||
bitraverse
|
||||
(pure . collabRecipLocalPerson . entityVal)
|
||||
(getRemoteActorURI <=< getJust . collabRecipRemoteActor . entityVal)
|
||||
recip
|
||||
unless (first LocalActorPerson recipForCheck == bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig) $
|
||||
throwE "Capability's collaborator and Grant author aren't the same actor"
|
||||
return (enableID, role, recip)
|
||||
|
||||
handleCollab enableID role recip = do
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
|
|
@ -2337,26 +2345,6 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
|
|||
let actorID = projectActor recip
|
||||
(actorID,) <$> getJust actorID
|
||||
|
||||
-- Find the Collab record from the capability
|
||||
Entity enableID (CollabEnable collabID _) <- do
|
||||
unless (fst capability == LocalActorProject projectID) $
|
||||
throwE "Capability isn't mine"
|
||||
m <- lift $ getBy $ UniqueCollabEnableGrant $ snd capability
|
||||
fromMaybeE m "I don't have a Collab with this capability"
|
||||
Collab role <- lift $ getJust collabID
|
||||
topic <- lift $ getCollabTopic collabID
|
||||
unless (topic == LocalActorProject projectID) $
|
||||
throwE "Found a Collab for this direct-Grant but it's not mine"
|
||||
recip <- lift $ getCollabRecip collabID
|
||||
recipForCheck <-
|
||||
lift $
|
||||
bitraverse
|
||||
(pure . collabRecipLocalPerson . entityVal)
|
||||
(getRemoteActorURI <=< getJust . collabRecipRemoteActor . entityVal)
|
||||
recip
|
||||
unless (recipForCheck == collab) $
|
||||
throwE "Capability's collaborator and Grant author aren't the same actor"
|
||||
|
||||
-- Verify I don't yet have a delegator-Grant from the collaborator
|
||||
maybeDeleg <-
|
||||
lift $ case bimap entityKey entityKey recip of
|
||||
|
|
|
|||
Loading…
Reference in a new issue