S2S: Project: Grant: When getting a new parent, send them a start-Grant

This was accidentally not happening until now.

If I, project A, send a start-Grant to my new parent project B, it means
that whoever has access to project B will have access to my settings as
well (for the specific operations their role allows).

migrations/583_2024-04-13_dest_start.model

@@ -0,0 +1,6 @@
+DestUsStart
+    dest  DestUsAcceptId
+    grant OutboxItemId
+
+    UniqueDestUsStart      dest
+    UniqueDestUsStartGrant grant

src/Vervis/Actor/Project.hs

@@ -2236,6 +2236,7 @@ data GrantKind
 --
 --      * Option 4 - Almost-Parent sending me the delegator-Grant
 --          * Update the Dest record, enabling the parent
+--          * Send a start-Grant giving access-to-me
 --          * For each of my components, send an extension-Grant to the new
 --            parent
 --          * For each grant I've been delegated from my children, send an
@@ -3324,6 +3325,14 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
                         fromMaybeE mk "I already have such a DestThemSendDelegatorRemote"
                     _ -> error "projectGrant.parent impossible"
 
+                -- Prepare a start-Grant
+                startID <- lift $ insertEmptyOutboxItem' (actorOutbox recipActor) now
+                start@(actionStart, _, _, _) <- lift $ prepareStartGrant role to
+                let recipByKey = LocalActorProject projectID
+                _luStart <- lift $ updateOutboxItem' recipByKey startID actionStart
+
+                lift $ insert_ $ DestUsStart acceptID startID
+
                 -- For each Component in me, prepare a delegation-extension Grant
                 localComponents <-
                     lift $
@@ -3446,7 +3455,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
 
                 return
                     ( recipActorID
-                    , localExtensions ++ remoteExtensions ++ fromChildren
+                    , (startID, start) : localExtensions ++ remoteExtensions ++ fromChildren
                     )
 
         case maybeNew of
@@ -3458,7 +3467,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
                         sendActivity
                             recipByID recipActorID localRecipsExt
                             remoteRecipsExt fwdHostsExt extID actionExt
-                done "Sent extensions from components and children"
+                done "Sent start-Grant and extensions from components and children"
 
         where
 
@@ -3519,6 +3528,55 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
 
             return (action, recipientSet, remoteActors, fwdHosts)
 
+        prepareStartGrant role deleg = do
+            encodeRouteHome <- getEncodeRouteHome
+            encodeRouteLocal <- getEncodeRouteLocal
+
+            projectHash <- encodeKeyHashid projectID
+
+            uDeleg <- lift $ getActivityURI authorIdMsig
+
+            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   = [uDeleg]
+                    , AP.actionSpecific   = AP.GrantActivity AP.Grant
+                        { AP.grantObject    = AP.RXRole role
+                        , AP.grantContext   = encodeRouteHome $ ProjectR projectHash
+                        , AP.grantTarget    = uParent
+                        , AP.grantResult    =
+                            Just
+                                ( encodeRouteLocal resultR
+                                , Nothing
+                                )
+                        , AP.grantStart     = Just now
+                        , AP.grantEnd       = Nothing
+                        , AP.grantAllows    = AP.GatherAndConvey
+                        , AP.grantDelegates = Nothing
+                        }
+                    }
+
+            return (action, recipientSet, remoteActors, fwdHosts)
+
         prepareExtensionGrantFromChild uStart grant role to = do
             encodeRouteHome <- getEncodeRouteHome
             encodeRouteLocal <- getEncodeRouteLocal
@@ -4571,6 +4629,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
                         deleteWhere [SourceUsGatherId <-. gatherIDs]
 
                 -- Delete the whole Dest record
+                deleteBy $ UniqueDestUsStart usAcceptID
                 case topic of
                     Left (_, _, sendID) -> delete sendID
                     Right (_, sendID) -> delete sendID
@@ -4999,6 +5058,7 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus
                         deleteWhere [SourceUsGatherId <-. gatherIDs]
 
                 -- Delete the whole Dest record
+                deleteBy $ UniqueDestUsStart usAcceptID
                 case send of
                     Left sendID -> delete sendID
                     Right sendID -> delete sendID

src/Vervis/Migration.hs

@@ -3222,6 +3222,8 @@ changes hLocal ctx =
     , addUnique' "SourceThemDelegateLocal" "" ["grant"]
       -- 582
     , addUnique' "SourceThemDelegateRemote" "" ["grant"]
+      -- 583
+    , addEntities model_583_dest_start
     ]
 
 migrateDB

src/Vervis/Migration/Entities.hs

@@ -70,6 +70,7 @@ module Vervis.Migration.Entities
     , model_570_source_dest
     , model_577_component_gather
     , model_578_source_remove
+    , model_583_dest_start
     )
 where
 
@@ -272,3 +273,6 @@ model_577_component_gather = $(schema "577_2024-03-13_component_gather")
 
 model_578_source_remove :: [Entity SqlBackend]
 model_578_source_remove = $(schema "578_2024-04-03_source_remove")
+
+model_583_dest_start :: [Entity SqlBackend]
+model_583_dest_start = $(schema "583_2024-04-13_dest_start")

th/models

@@ -1684,3 +1684,13 @@ DestThemSendDelegatorRemote
     UniqueDestThemSendDelegatorRemote      dest
     UniqueDestThemSendDelegatorRemoteTopic topic
     UniqueDestThemSendDelegatorRemoteGrant grant
+
+-- Witnesses that, seeing the delegator-Grant, I've sent my new parent a
+-- start-Grant to delegate further
+
+DestUsStart
+    dest  DestUsAcceptId
+    grant OutboxItemId
+
+    UniqueDestUsStart      dest
+    UniqueDestUsStartGrant grant