S2S: Project: Grant: Implement parent mode
This commit is contained in:
Pere Lev
parent
f187c66d69
commit
1c10d3fb03
5 changed files with 419 additions and 36 deletions
15
migrations/577_2024-03-13_component_gather.model
Normal file
15
migrations/577_2024-03-13_component_gather.model
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
ComponentGatherLocal
|
||||
component ComponentEnableId
|
||||
parent DestThemSendDelegatorLocalId
|
||||
grant OutboxItemId
|
||||
|
||||
UniqueComponentGatherLocal component parent
|
||||
UniqueComponentGatherLocalGrant grant
|
||||
|
||||
ComponentGatherRemote
|
||||
component ComponentEnableId
|
||||
parent DestThemSendDelegatorRemoteId
|
||||
grant OutboxItemId
|
||||
|
||||
UniqueComponentGatherRemote component parent
|
||||
UniqueComponentGatherRemoteGrant grant
|
||||
|
|
@ -1946,33 +1946,14 @@ projectGrant
|
|||
-> ActE (Text, Act (), Next)
|
||||
projectGrant now projectID (Verse authorIdMsig body) grant = do
|
||||
|
||||
-- Check capability
|
||||
capability <- do
|
||||
|
||||
-- Verify that a capability is provided
|
||||
uCap <- do
|
||||
let muCap = AP.activityCapability $ actbActivity body
|
||||
fromMaybeE muCap "No capability provided"
|
||||
|
||||
-- Verify the capability URI is one of:
|
||||
-- * Outbox item URI of a local actor, i.e. a local activity
|
||||
-- * A remote URI
|
||||
cap <- nameExceptT "Invite capability" $ parseActivityURI' uCap
|
||||
|
||||
-- Verify the capability is local
|
||||
case cap of
|
||||
Left (actorByKey, _, outboxItemID) ->
|
||||
return (actorByKey, outboxItemID)
|
||||
_ -> throwE "Capability is remote i.e. definitely not by me"
|
||||
|
||||
-- Check grant
|
||||
grant' <- checkGrant grant
|
||||
let adapt = maybe (Right Nothing) (either Left (Right . Just))
|
||||
maybeMode <-
|
||||
withDBExcept $ ExceptT $ fmap adapt $ runMaybeT $
|
||||
runExceptT (Left . Left <$> tryComp capability grant') <|>
|
||||
runExceptT (Left . Right <$> tryCollab capability grant') <|>
|
||||
runExceptT (Right <$> tryChild capability grant')
|
||||
runExceptT (Left . Left <$> tryComp grant') <|>
|
||||
runExceptT (Left . Right <$> tryCollab grant') <|>
|
||||
runExceptT (Right . Left <$> tryChild grant') <|>
|
||||
runExceptT (Right . Right <$> tryParent grant')
|
||||
mode <-
|
||||
fromMaybeE
|
||||
maybeMode
|
||||
|
|
@ -1982,11 +1963,30 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
|
|||
handleComp role enableID ident identForCheck
|
||||
Left (Right (enableID, role, recip)) ->
|
||||
handleCollab enableID role recip
|
||||
Right (role, sendID, topic) ->
|
||||
Right (Left (role, sendID, topic)) ->
|
||||
handleChild role sendID topic
|
||||
Right (Right (role, topic, acceptID)) ->
|
||||
handleParent role topic acceptID
|
||||
|
||||
where
|
||||
|
||||
checkCapability = do
|
||||
-- Verify that a capability is provided
|
||||
uCap <- do
|
||||
let muCap = AP.activityCapability $ actbActivity body
|
||||
fromMaybeE muCap "No capability provided"
|
||||
|
||||
-- Verify the capability URI is one of:
|
||||
-- * Outbox item URI of a local actor, i.e. a local activity
|
||||
-- * A remote URI
|
||||
cap <- nameExceptT "Grant capability" $ parseActivityURI' uCap
|
||||
|
||||
-- Verify the capability is local
|
||||
case cap of
|
||||
Left (actorByKey, _, outboxItemID) ->
|
||||
return (actorByKey, outboxItemID)
|
||||
_ -> throwE "Capability is remote i.e. definitely not by me"
|
||||
|
||||
checkGrant g = do
|
||||
(role, resource, recipient, _mresult, mstart, mend, usage, mdeleg) <-
|
||||
parseGrant' g
|
||||
|
|
@ -2013,9 +2013,10 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
|
|||
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
|
||||
tryComp (GKDelegationExtend _ _) = lift mzero
|
||||
tryComp GKDelegator = lift mzero
|
||||
tryComp (GKDelegationStart role) = do
|
||||
capability <- ExceptT $ lift $ lift $ runExceptT checkCapability
|
||||
-- Find the Component record from the capability
|
||||
Entity enableID (ComponentEnable componentID _) <- lift $ do
|
||||
-- Capability isn't mine
|
||||
|
|
@ -2314,9 +2315,10 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
|
|||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
tryCollab _ (GKDelegationStart _) = lift mzero
|
||||
tryCollab _ (GKDelegationExtend _ _) = lift mzero
|
||||
tryCollab capability GKDelegator = do
|
||||
tryCollab (GKDelegationStart _) = lift mzero
|
||||
tryCollab (GKDelegationExtend _ _) = lift mzero
|
||||
tryCollab GKDelegator = do
|
||||
capability <- ExceptT $ lift $ lift $ runExceptT checkCapability
|
||||
-- Find the Collab record from the capability
|
||||
Entity enableID (CollabEnable collabID _) <- lift $ do
|
||||
-- Capability isn't mine
|
||||
|
|
@ -2597,7 +2599,8 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
|
|||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
tryChild capability gk = do
|
||||
tryChild gk = do
|
||||
capability <- ExceptT $ lift $ lift $ runExceptT checkCapability
|
||||
role <-
|
||||
case gk of
|
||||
GKDelegationStart role -> pure role
|
||||
|
|
@ -2922,6 +2925,348 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
|
|||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
tryParent (GKDelegationStart _) = lift mzero
|
||||
tryParent (GKDelegationExtend _ _) = lift mzero
|
||||
tryParent GKDelegator = do
|
||||
uFulfills <-
|
||||
case AP.activityFulfills $ actbActivity body of
|
||||
[] -> throwE "No fulfills"
|
||||
[u] -> pure u
|
||||
_ -> throwE "Multiple fulfills"
|
||||
fulfills <- ExceptT $ lift $ lift $ runExceptT $ first (\ (a, _, i) -> (a, i)) <$> parseActivityURI' uFulfills
|
||||
fulfillsDB <- ExceptT $ MaybeT $ either (Just . Left) (fmap Right) <$> runExceptT (getActivity fulfills)
|
||||
-- Find the Dest record from the fulfills
|
||||
destID <-
|
||||
lift $
|
||||
case fulfillsDB of
|
||||
Left (_, _, addID) ->
|
||||
(do DestUsGestureLocal destID _ <- MaybeT $ getValBy $ UniqueDestUsGestureLocalActivity addID
|
||||
_ <- MaybeT $ getBy $ UniqueDestOriginUs destID
|
||||
return destID
|
||||
)
|
||||
<|>
|
||||
(do DestThemGestureLocal themID _ <- MaybeT $ getValBy $ UniqueDestThemGestureLocalAdd addID
|
||||
DestOriginThem destID <- lift $ getJust themID
|
||||
return destID
|
||||
)
|
||||
Right addID ->
|
||||
(do DestUsGestureRemote destID _ _ <- MaybeT $ getValBy $ UniqueDestUsGestureRemoteActivity addID
|
||||
_ <- MaybeT $ getBy $ UniqueDestOriginUs destID
|
||||
return destID
|
||||
)
|
||||
<|>
|
||||
(do DestThemGestureRemote themID _ _ <- MaybeT $ getValBy $ UniqueDestThemGestureRemoteAdd addID
|
||||
DestOriginThem destID <- lift $ getJust themID
|
||||
return destID
|
||||
)
|
||||
-- Verify this Dest record is mine
|
||||
DestHolderProject _ j <- lift $ MaybeT $ getValBy $ UniqueDestHolderProject destID
|
||||
lift $ guard $ j == projectID
|
||||
-- Verify the Grant sender is the Dest topic
|
||||
topic <- do
|
||||
t <- lift $ lift $ getDestTopic destID
|
||||
bitraverse
|
||||
(bitraverse
|
||||
pure
|
||||
(\case
|
||||
Left j -> pure j
|
||||
Right _g -> error "I have a DestTopic that is a Group"
|
||||
)
|
||||
)
|
||||
pure
|
||||
t
|
||||
topicForCheck <-
|
||||
lift $ lift $
|
||||
bitraverse
|
||||
(pure . snd)
|
||||
(\ (_, raID) -> getRemoteActorURI =<< getJust raID)
|
||||
topic
|
||||
unless (first LocalActorProject topicForCheck == bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig) $
|
||||
throwE "Dest topic and Grant author aren't the same actor"
|
||||
-- Verify I sent my Accept
|
||||
maybeMe <- lift $ lift $ getKeyBy $ UniqueDestUsAccept destID
|
||||
meAcceptID <- fromMaybeE maybeMe "I haven't sent my Accept"
|
||||
-- Verify I haven't yet seen a delegator-Grant from the parent
|
||||
case bimap fst fst topic of
|
||||
Left localID -> do
|
||||
m <- lift $ lift $ getBy $ UniqueDestThemSendDelegatorLocalTopic localID
|
||||
verifyNothingE m "Already have a DestThemSendDelegatorLocal"
|
||||
Right remoteID -> do
|
||||
m <- lift $ lift $ getBy $ UniqueDestThemSendDelegatorRemoteTopic remoteID
|
||||
verifyNothingE m "Already have a DestThemSendDelegatorRemote"
|
||||
Dest role <- lift $ lift $ getJust destID
|
||||
return (role, topic, meAcceptID)
|
||||
|
||||
handleParent role topic acceptID = do
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
(recipActorID, recipActor) <- lift $ do
|
||||
recip <- getJust projectID
|
||||
let actorID = projectActor recip
|
||||
(actorID,) <$> getJust actorID
|
||||
|
||||
maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
|
||||
for maybeGrantDB $ \ grantDB -> do
|
||||
|
||||
-- Record the delegator-Grant in DB
|
||||
to <- case (grantDB, bimap fst fst topic) of
|
||||
(Left (_, _, grantID), Left localID) -> Left <$> do
|
||||
mk <- lift $ insertUnique $ DestThemSendDelegatorLocal acceptID localID grantID
|
||||
fromMaybeE mk "I already have such a DestThemSendDelegatorLocal"
|
||||
(Right (_, _, grantID), Right remoteID) -> Right <$> do
|
||||
mk <- lift $ insertUnique $ DestThemSendDelegatorRemote acceptID remoteID grantID
|
||||
fromMaybeE mk "I already have such a DestThemSendDelegatorRemote"
|
||||
_ -> error "projectGrant.parent impossible"
|
||||
|
||||
-- For each Component in me, prepare a delegation-extension Grant
|
||||
localComponents <-
|
||||
lift $
|
||||
E.select $ E.from $ \ (deleg `E.InnerJoin` local `E.InnerJoin` comp `E.InnerJoin` enable) -> do
|
||||
E.on $ comp E.^. ComponentId E.==. enable E.^. ComponentEnableComponent
|
||||
E.on $ local E.^. ComponentLocalComponent E.==. comp E.^. ComponentId
|
||||
E.on $ deleg E.^. ComponentDelegateLocalComponent E.==.local E.^. ComponentLocalId
|
||||
E.where_ $ comp E.^. ComponentProject E.==. E.val projectID
|
||||
return
|
||||
( deleg E.^. ComponentDelegateLocalGrant
|
||||
, comp
|
||||
, enable
|
||||
)
|
||||
localExtensions <- lift $ for localComponents $ \ (E.Value startID, Entity componentID component, Entity enableID _) -> do
|
||||
extID <- insertEmptyOutboxItem' (actorOutbox recipActor) now
|
||||
case to of
|
||||
Left localID -> insert_ $ ComponentGatherLocal enableID localID extID
|
||||
Right remoteID -> insert_ $ ComponentGatherRemote enableID remoteID extID
|
||||
componentIdent <- do
|
||||
i <- getComponentIdent componentID
|
||||
bitraverse
|
||||
(pure . snd)
|
||||
(\ (_, raID) -> getRemoteActorURI =<< getJust raID)
|
||||
i
|
||||
uStart <- do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
c <-
|
||||
case componentIdent of
|
||||
Left ci -> hashComponent ci
|
||||
Right _ -> error "Delegation-start Grant URI is local, but component found to be remote, impossible"
|
||||
s <- encodeKeyHashid startID
|
||||
return $ encodeRouteHome $ activityRoute (componentActor c) s
|
||||
ext@(actionExt, _, _, _) <-
|
||||
prepareExtensionGrant componentIdent uStart (min role (componentRole component)) enableID to
|
||||
let recipByKey = LocalActorProject projectID
|
||||
_luExt <- updateOutboxItem' recipByKey extID actionExt
|
||||
return (extID, ext)
|
||||
|
||||
remoteComponents <-
|
||||
lift $
|
||||
E.select $ E.from $ \ (deleg `E.InnerJoin` remote `E.InnerJoin` comp `E.InnerJoin` enable) -> do
|
||||
E.on $ comp E.^. ComponentId E.==. enable E.^. ComponentEnableComponent
|
||||
E.on $ remote E.^. ComponentRemoteComponent E.==. comp E.^. ComponentId
|
||||
E.on $ deleg E.^. ComponentDelegateRemoteComponent E.==.remote E.^. ComponentRemoteId
|
||||
E.where_ $ comp E.^. ComponentProject E.==. E.val projectID
|
||||
return
|
||||
( deleg E.^. ComponentDelegateRemoteGrant
|
||||
, comp
|
||||
, enable
|
||||
)
|
||||
remoteExtensions <- lift $ for remoteComponents $ \ (E.Value startID, Entity componentID component, Entity enableID _) -> do
|
||||
extID <- insertEmptyOutboxItem' (actorOutbox recipActor) now
|
||||
case to of
|
||||
Left localID -> insert_ $ ComponentGatherLocal enableID localID extID
|
||||
Right remoteID -> insert_ $ ComponentGatherRemote enableID remoteID extID
|
||||
componentIdent <- do
|
||||
i <- getComponentIdent componentID
|
||||
bitraverse
|
||||
(pure . snd)
|
||||
(\ (_, raID) -> getRemoteActorURI =<< getJust raID)
|
||||
i
|
||||
uStart <- do
|
||||
ra <- getJust startID
|
||||
getRemoteActivityURI ra
|
||||
ext@(actionExt, _, _, _) <-
|
||||
prepareExtensionGrant componentIdent uStart (min role (componentRole component)) enableID to
|
||||
let recipByKey = LocalActorProject projectID
|
||||
_luExt <- updateOutboxItem' recipByKey extID actionExt
|
||||
return (extID, ext)
|
||||
|
||||
-- For each Grant I got from a child, prepare a
|
||||
-- delegation-extension Grant
|
||||
l <-
|
||||
lift $ fmap (map $ over _2 Left) $
|
||||
E.select $ E.from $ \ (source `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` accept `E.InnerJoin` send `E.InnerJoin` deleg) -> do
|
||||
E.on $ accept E.^. SourceThemAcceptLocalId E.==. deleg E.^. SourceThemDelegateLocalSource
|
||||
E.on $ source E.^. SourceId E.==. send E.^. SourceUsSendDelegatorSource
|
||||
E.on $ topic E.^. SourceTopicLocalId E.==. accept E.^. SourceThemAcceptLocalTopic
|
||||
E.on $ source E.^. SourceId E.==. topic E.^. SourceTopicLocalSource
|
||||
E.on $ source E.^. SourceId E.==. holder E.^. SourceHolderProjectSource
|
||||
E.where_ $ holder E.^. SourceHolderProjectProject E.==. E.val projectID
|
||||
return
|
||||
( send E.^. SourceUsSendDelegatorId
|
||||
, deleg
|
||||
)
|
||||
r <-
|
||||
lift $ fmap (map $ over _2 Right) $
|
||||
E.select $ E.from $ \ (source `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` accept `E.InnerJoin` send `E.InnerJoin` deleg) -> do
|
||||
E.on $ accept E.^. SourceThemAcceptRemoteId E.==. deleg E.^. SourceThemDelegateRemoteSource
|
||||
E.on $ source E.^. SourceId E.==. send E.^. SourceUsSendDelegatorSource
|
||||
E.on $ topic E.^. SourceTopicRemoteId E.==. accept E.^. SourceThemAcceptRemoteTopic
|
||||
E.on $ source E.^. SourceId E.==. topic E.^. SourceTopicRemoteSource
|
||||
E.on $ source E.^. SourceId E.==. holder E.^. SourceHolderProjectSource
|
||||
E.where_ $ holder E.^. SourceHolderProjectProject E.==. E.val projectID
|
||||
return
|
||||
( send E.^. SourceUsSendDelegatorId
|
||||
, deleg
|
||||
)
|
||||
fromChildren <- lift $ for (l ++ r) $ \ (E.Value sendID, deleg) -> do
|
||||
extID <- insertEmptyOutboxItem' (actorOutbox recipActor) now
|
||||
|
||||
gatherID <- insert $ SourceUsGather sendID acceptID extID
|
||||
case bimap entityKey entityKey deleg of
|
||||
Left localID -> insert_ $ SourceUsGatherFromLocal gatherID localID
|
||||
Right remoteID -> insert_ $ SourceUsGatherFromRemote gatherID remoteID
|
||||
case to of
|
||||
Left localID -> insert_ $ SourceUsGatherToLocal gatherID localID
|
||||
Right remoteID -> insert_ $ SourceUsGatherToRemote gatherID remoteID
|
||||
|
||||
(AP.Doc h a, grant) <- getGrantActivityBody $ bimap (sourceThemDelegateLocalGrant . entityVal) (sourceThemDelegateRemoteGrant . entityVal) deleg
|
||||
uStart <-
|
||||
case AP.activityId a of
|
||||
Nothing -> error "SourceThemDelegate grant has no 'id'"
|
||||
Just lu -> pure $ ObjURI h lu
|
||||
ext@(actionExt, _, _, _) <-
|
||||
prepareExtensionGrantFromChild uStart grant role to
|
||||
let recipByKey = LocalActorProject projectID
|
||||
_luExt <- updateOutboxItem' recipByKey extID actionExt
|
||||
return (extID, ext)
|
||||
|
||||
return
|
||||
( recipActorID
|
||||
, localExtensions ++ remoteExtensions ++ fromChildren
|
||||
)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (recipActorID, exts) -> do
|
||||
let recipByID = LocalActorProject projectID
|
||||
lift $ for_ exts $
|
||||
\ (extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt)) ->
|
||||
sendActivity
|
||||
recipByID recipActorID localRecipsExt
|
||||
remoteRecipsExt fwdHostsExt extID actionExt
|
||||
done "Sent extensions from components and children"
|
||||
|
||||
where
|
||||
|
||||
prepareExtensionGrant component uStart role enableID deleg = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
|
||||
projectHash <- encodeKeyHashid projectID
|
||||
|
||||
uDeleg <- lift $ getActivityURI authorIdMsig
|
||||
uComponent <-
|
||||
case component of
|
||||
Left c -> do
|
||||
a <- componentActor <$> hashComponent c
|
||||
return $ encodeRouteHome $ renderLocalActor a
|
||||
Right u -> pure u
|
||||
|
||||
enableHash <- encodeKeyHashid enableID
|
||||
|
||||
audParent <- lift $ makeAudSenderOnly authorIdMsig
|
||||
uParent <- lift $ getActorURI authorIdMsig
|
||||
|
||||
resultR <-
|
||||
case deleg of
|
||||
Left delegID -> do
|
||||
delegHash <- encodeKeyHashid delegID
|
||||
return $
|
||||
ProjectParentLocalLiveR projectHash delegHash
|
||||
Right delegID -> do
|
||||
delegHash <- encodeKeyHashid delegID
|
||||
return $
|
||||
ProjectParentRemoteLiveR projectHash delegHash
|
||||
|
||||
let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audParent]
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
action = AP.Action
|
||||
{ AP.actionCapability = Just uDeleg
|
||||
, AP.actionSummary = Nothing
|
||||
, AP.actionAudience = AP.Audience recips [] [] [] [] []
|
||||
, AP.actionFulfills = [uStart]
|
||||
, AP.actionSpecific = AP.GrantActivity AP.Grant
|
||||
{ AP.grantObject = AP.RXRole role
|
||||
, AP.grantContext = uComponent
|
||||
, AP.grantTarget = uParent
|
||||
, AP.grantResult =
|
||||
Just
|
||||
( encodeRouteLocal resultR
|
||||
, Nothing
|
||||
)
|
||||
, AP.grantStart = Just now
|
||||
, AP.grantEnd = Nothing
|
||||
, AP.grantAllows = AP.GatherAndConvey
|
||||
, AP.grantDelegates = Just uStart
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
prepareExtensionGrantFromChild uStart grant role to = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
|
||||
projectHash <- encodeKeyHashid projectID
|
||||
finalRole <-
|
||||
case AP.grantObject grant of
|
||||
AP.RXRole r -> pure $ min role r
|
||||
AP.RXDelegator -> error "Why was I delegated a Grant with object=delegator?"
|
||||
|
||||
uDeleg <- lift $ getActivityURI authorIdMsig
|
||||
audParent <- lift $ makeAudSenderOnly authorIdMsig
|
||||
uParent <- lift $ getActorURI authorIdMsig
|
||||
|
||||
resultR <-
|
||||
case to of
|
||||
Left delegID -> do
|
||||
delegHash <- encodeKeyHashid delegID
|
||||
return $
|
||||
ProjectParentLocalLiveR projectHash delegHash
|
||||
Right delegID -> do
|
||||
delegHash <- encodeKeyHashid delegID
|
||||
return $
|
||||
ProjectParentRemoteLiveR projectHash delegHash
|
||||
|
||||
let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audParent]
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
action = AP.Action
|
||||
{ AP.actionCapability = Just uDeleg
|
||||
, AP.actionSummary = Nothing
|
||||
, AP.actionAudience = AP.Audience recips [] [] [] [] []
|
||||
, AP.actionFulfills = [uStart]
|
||||
, AP.actionSpecific = AP.GrantActivity AP.Grant
|
||||
{ AP.grantObject = AP.RXRole finalRole
|
||||
, AP.grantContext = AP.grantContext grant
|
||||
, AP.grantTarget = uParent
|
||||
, AP.grantResult =
|
||||
Just
|
||||
( encodeRouteLocal resultR
|
||||
, Nothing
|
||||
)
|
||||
, AP.grantStart = Just now
|
||||
, AP.grantEnd = Nothing
|
||||
, AP.grantAllows = AP.GatherAndConvey
|
||||
, AP.grantDelegates = Just uStart
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
-- Meaning: An actor A invited actor B to a resource
|
||||
-- Behavior:
|
||||
-- * Verify the resource is my collabs or components list
|
||||
|
|
|
|||
|
|
@ -3210,6 +3210,8 @@ changes hLocal ctx =
|
|||
, addUnique' "SourceThemDelegateLocal" "" ["source", "grant"]
|
||||
-- 576
|
||||
, addUnique' "SourceThemDelegateRemote" "" ["source", "grant"]
|
||||
-- 577
|
||||
, addEntities model_577_component_gather
|
||||
]
|
||||
|
||||
migrateDB
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2018, 2019, 2020, 2022, 2023
|
||||
- Written in 2018, 2019, 2020, 2022, 2023, 2024
|
||||
- by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
|
|
@ -68,6 +68,7 @@ module Vervis.Migration.Entities
|
|||
, model_552_collab_deleg
|
||||
, model_564_permit
|
||||
, model_570_source_dest
|
||||
, model_577_component_gather
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -264,3 +265,6 @@ model_564_permit = $(schema "564_2023-11-22_permit")
|
|||
|
||||
model_570_source_dest :: [Entity SqlBackend]
|
||||
model_570_source_dest = $(schema "570_2023-12-09_source_dest")
|
||||
|
||||
model_577_component_gather :: [Entity SqlBackend]
|
||||
model_577_component_gather = $(schema "577_2024-03-13_component_gather")
|
||||
|
|
|
|||
25
th/models
25
th/models
|
|
@ -1067,6 +1067,7 @@ ComponentEnable
|
|||
|
||||
-- Witnesses that the component used the delegator Grant to send an admin
|
||||
-- delegation to the project, to extend the delegation further
|
||||
|
||||
ComponentDelegateLocal
|
||||
component ComponentLocalId
|
||||
grant OutboxItemId
|
||||
|
|
@ -1074,8 +1075,6 @@ ComponentDelegateLocal
|
|||
UniqueComponentDelegateLocal component
|
||||
UniqueComponentDelegateLocalGrant grant
|
||||
|
||||
-- Witnesses that the component used the delegator Grant to send an admin
|
||||
-- delegation to the project, to extend the delegation further
|
||||
ComponentDelegateRemote
|
||||
component ComponentRemoteId
|
||||
grant RemoteActivityId
|
||||
|
|
@ -1085,6 +1084,7 @@ ComponentDelegateRemote
|
|||
|
||||
-- Witnesses that the project has extended a given delegation to a given
|
||||
-- direct collaborator
|
||||
|
||||
ComponentFurtherLocal
|
||||
component ComponentEnableId
|
||||
collab CollabDelegLocalId
|
||||
|
|
@ -1093,8 +1093,6 @@ ComponentFurtherLocal
|
|||
UniqueComponentFurtherLocal component collab
|
||||
UniqueComponentFurtherLocalGrant grant
|
||||
|
||||
-- Witnesses that the project has extended a given delegation to a given
|
||||
-- direct collaborator
|
||||
ComponentFurtherRemote
|
||||
component ComponentEnableId
|
||||
collab CollabDelegRemoteId
|
||||
|
|
@ -1103,6 +1101,25 @@ ComponentFurtherRemote
|
|||
UniqueComponentFurtherRemote component collab
|
||||
UniqueComponentFurtherRemoteGrant grant
|
||||
|
||||
-- Witnesses that the project has extended a given delegation to a given
|
||||
-- parent
|
||||
|
||||
ComponentGatherLocal
|
||||
component ComponentEnableId
|
||||
parent DestThemSendDelegatorLocalId
|
||||
grant OutboxItemId
|
||||
|
||||
UniqueComponentGatherLocal component parent
|
||||
UniqueComponentGatherLocalGrant grant
|
||||
|
||||
ComponentGatherRemote
|
||||
component ComponentEnableId
|
||||
parent DestThemSendDelegatorRemoteId
|
||||
grant OutboxItemId
|
||||
|
||||
UniqueComponentGatherRemote component parent
|
||||
UniqueComponentGatherRemoteGrant grant
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Components, from component perspective
|
||||
------------------------------------------------------------------------------
|
||||
|
|
|
|||
Loading…
Reference in a new issue