S2S: Project: Remove: Implement child/parent mode
This commit is contained in:
Pere Lev
parent
7a0ea1f63d
commit
048c429def
7 changed files with 1021 additions and 231 deletions
6
migrations/578_2024-04-03_source_remove.model
Normal file
6
migrations/578_2024-04-03_source_remove.model
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
SourceRemove
|
||||
send SourceUsSendDelegatorId
|
||||
activity InboxItemId
|
||||
|
||||
UniqueSourceRemove send
|
||||
UniqueSourceRemoveActivity activity
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2019, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||
- Written in 2019, 2022, 2024 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
|
|
@ -17,6 +17,7 @@ module Control.Monad.Trans.Except.Local
|
|||
( fromMaybeE
|
||||
, verifyNothingE
|
||||
, nameExceptT
|
||||
, verifySingleE
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -33,3 +34,9 @@ verifyNothingE (Just _) e = throwE e
|
|||
|
||||
nameExceptT :: Functor m => Text -> ExceptT Text m a -> ExceptT Text m a
|
||||
nameExceptT title = withExceptT $ \ e -> title <> ": " <> e
|
||||
|
||||
verifySingleE list none several =
|
||||
case list of
|
||||
[] -> throwE none
|
||||
[x] -> pure x
|
||||
_ -> throwE several
|
||||
|
|
|
|||
|
|
@ -1445,7 +1445,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
|
|||
uCap
|
||||
authorIdMsig
|
||||
(LocalActorProject projectID)
|
||||
AP.RoleTriage
|
||||
AP.RoleAdmin
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
|
|
@ -3580,9 +3580,9 @@ projectReject
|
|||
-> ActE (Text, Act (), Next)
|
||||
projectReject = topicReject projectActor LocalActorProject
|
||||
|
||||
-- Meaning: An actor A is removing actor B from a resource
|
||||
-- Meaning: An actor A is removing actor B from collection C
|
||||
-- Behavior:
|
||||
-- * Verify the resource is me
|
||||
-- * If C is my collaborators collection:
|
||||
-- * Verify A isn't removing themselves
|
||||
-- * Verify A is authorized by me to remove actors from me
|
||||
-- * Verify B already has a Grant for me
|
||||
|
|
@ -3591,6 +3591,34 @@ projectReject = topicReject projectActor LocalActorProject
|
|||
-- * Send a Revoke:
|
||||
-- * To: Actor B
|
||||
-- * CC: Actor A, B's followers, my followers
|
||||
-- * If C is my children collection:
|
||||
-- * Verify A isn't removing themselves
|
||||
-- * Verify A is authorized by me to remove actors from me
|
||||
-- * Verify B is an active child of mine
|
||||
-- * Remove the whole Source record from DB
|
||||
-- * Forward the Remove to my followers
|
||||
-- * Send a Revoke on the delegator-Grant I had for B:
|
||||
-- * To: Actor B
|
||||
-- * CC: Actor A, B's followers, my followers
|
||||
-- * Send a Revoke on every extention-Grant I extended on every
|
||||
-- delegation Grant I got from B
|
||||
-- * To: The parent/collaborator/team to whom I'd sent the Grant
|
||||
-- * CC: -
|
||||
-- * If C is my parents collection:
|
||||
-- * Verify A isn't removing themselves
|
||||
-- * Verify A is authorized by me to remove actors from me
|
||||
-- * Verify B is an active parent of mine
|
||||
-- * Remove the whole Dest record from DB
|
||||
-- * Forward the Remove to my followers
|
||||
-- * Send an Accept on the Remove:
|
||||
-- * To: Actor B
|
||||
-- * CC: Actor A, B's followers, my followers
|
||||
-- * If I'm B, being removed from the parents of a child of mine:
|
||||
-- * Record this Remove in the Source record
|
||||
-- * Forward to followers
|
||||
-- * If I'm B, being removed from the children of a parent of mine:
|
||||
-- * Do nothing, just waiting for parent to send a Revoke on the
|
||||
-- delegator-Grant
|
||||
projectRemove
|
||||
:: UTCTime
|
||||
-> ProjectId
|
||||
|
|
@ -3599,19 +3627,50 @@ projectRemove
|
|||
-> ActE (Text, Act (), Next)
|
||||
projectRemove now projectID (Verse authorIdMsig body) remove = do
|
||||
|
||||
-- Check remove
|
||||
memberByKey <- do
|
||||
let author = bimap (view _1) (remoteAuthorURI . view _1) authorIdMsig
|
||||
(resource, memberOrComp) <- parseRemove author remove
|
||||
unless (Left (Left $ LocalActorProject projectID) == resource) $
|
||||
throwE "Remove topic isn't my collabs URI"
|
||||
(collection, item) <- parseRemove author remove
|
||||
case (collection, item) of
|
||||
(Left (Left (LocalActorProject j)), _) | j == projectID ->
|
||||
removeCollab item
|
||||
(Left (Right (ATProjectChildren j)), _) | j == projectID ->
|
||||
removeChildActive item
|
||||
(Left (Right (ATProjectParents j)), _) | j == projectID ->
|
||||
removeParentActive item
|
||||
(_, Left (LocalActorProject j)) | j == projectID ->
|
||||
case collection of
|
||||
Left (Right (ATProjectParents j)) | j /= projectID ->
|
||||
removeChildPassive $ Left j
|
||||
Left (Right (ATProjectChildren j)) | j /= projectID ->
|
||||
removeParentPassive $ Left j
|
||||
Right (ObjURI h luColl) -> do
|
||||
-- NOTE this is HTTP GET done synchronously in the activity
|
||||
-- handler
|
||||
manager <- asksEnv envHttpManager
|
||||
c <- AP.fetchAPID_T manager (AP.collectionId :: AP.Collection FedURI URIMode -> LocalURI) h luColl
|
||||
lu <- fromMaybeE (AP.collectionContext c) "No context"
|
||||
j <- AP.fetchAPID_T manager (AP.actorId . AP.actorLocal . AP.projectActor) h lu
|
||||
case (luColl == AP.projectChildren j, luColl == AP.projectParents j) of
|
||||
(True, False) ->
|
||||
removeParentPassive $ Right $ ObjURI h lu
|
||||
(False, True) ->
|
||||
removeChildPassive $ Right $ ObjURI h lu
|
||||
_ -> throwE "Weird collection situation"
|
||||
_ -> throwE "I'm being removed from somewhere irrelevant"
|
||||
_ -> throwE "This Remove isn't for me"
|
||||
|
||||
where
|
||||
|
||||
removeCollab member = do
|
||||
|
||||
-- Check remove
|
||||
memberByKey <-
|
||||
bitraverse
|
||||
(\case
|
||||
LocalActorPerson p -> pure p
|
||||
_ -> throwE "Not accepting non-person actors as collabs"
|
||||
)
|
||||
pure
|
||||
memberOrComp
|
||||
member
|
||||
|
||||
-- Verify the specified capability gives relevant access
|
||||
uCap <- do
|
||||
|
|
@ -3803,6 +3862,686 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
|
|||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
removeChildActive child = do
|
||||
|
||||
-- If child is local, find it in our DB
|
||||
-- If child is remote, HTTP GET it, verify it's an actor of Project
|
||||
-- type, and store in our DB (if it's already there, no need for HTTP)
|
||||
--
|
||||
-- NOTE: This is a blocking HTTP GET done right here in the handler,
|
||||
-- which is NOT a good idea. Ideally, it would be done async, and the
|
||||
-- handler result would be sent later in a separate (e.g. Accept) activity.
|
||||
-- But for the PoC level, the current situation will hopefully do.
|
||||
childDB <-
|
||||
bitraverse
|
||||
(\case
|
||||
LocalActorProject j -> withDBExcept $ getEntityE j "Child not found in DB"
|
||||
_ -> throwE "Local proposed child of non-project type"
|
||||
)
|
||||
(\ u@(ObjURI h lu) -> do
|
||||
instanceID <-
|
||||
lift $ withDB $ either entityKey id <$> insertBy' (Instance h)
|
||||
result <-
|
||||
ExceptT $ first (T.pack . displayException) <$>
|
||||
fetchRemoteActor' instanceID h lu
|
||||
case result of
|
||||
Left Nothing -> throwE "Child @id mismatch"
|
||||
Left (Just err) -> throwE $ T.pack $ displayException err
|
||||
Right Nothing -> throwE "Child isn't an actor"
|
||||
Right (Just actor) -> do
|
||||
case remoteActorType $ entityVal actor of
|
||||
AP.ActorTypeProject -> pure ()
|
||||
_ -> throwE "Remote child type isn't Project"
|
||||
return (u, actor)
|
||||
)
|
||||
child
|
||||
|
||||
-- Verify that a capability is provided
|
||||
uCap <- do
|
||||
let muCap = AP.activityCapability $ actbActivity body
|
||||
fromMaybeE muCap "No capability provided"
|
||||
|
||||
-- Verify the sender is authorized by me to remove a child
|
||||
verifyCapability''
|
||||
uCap
|
||||
authorIdMsig
|
||||
(LocalActorProject projectID)
|
||||
AP.RoleAdmin
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
(project, actorRecip) <- lift $ do
|
||||
p <- getJust projectID
|
||||
(p,) <$> getJust (projectActor p)
|
||||
|
||||
-- Verify it's an active child of mine
|
||||
sources <- lift $ case childDB of
|
||||
Left (Entity j _) ->
|
||||
fmap (map $ \ (s, h, d, E.Value a, E.Value t, E.Value i) -> (s, h, d, Left (a, t, i))) $
|
||||
E.select $ E.from $ \ (source `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` accept `E.InnerJoin` send) -> do
|
||||
E.on $ source E.^. SourceId E.==. send E.^. SourceUsSendDelegatorSource
|
||||
E.on $ topic E.^. SourceTopicProjectTopic E.==. accept E.^. SourceThemAcceptLocalTopic
|
||||
E.on $ holder E.^. SourceHolderProjectId E.==. topic E.^. SourceTopicProjectHolder
|
||||
E.on $ source E.^. SourceId E.==. holder E.^. SourceHolderProjectSource
|
||||
E.where_ $
|
||||
holder E.^. SourceHolderProjectProject E.==. E.val projectID E.&&.
|
||||
topic E.^. SourceTopicProjectChild E.==. E.val j
|
||||
return
|
||||
( source E.^. SourceId
|
||||
, holder E.^. SourceHolderProjectId
|
||||
, send
|
||||
, accept E.^. SourceThemAcceptLocalId
|
||||
, topic E.^. SourceTopicProjectTopic
|
||||
, topic E.^. SourceTopicProjectId
|
||||
)
|
||||
Right (_, Entity a _) ->
|
||||
fmap (map $ \ (s, h, d, E.Value a, E.Value t) -> (s, h, d, Right (a, t))) $
|
||||
E.select $ E.from $ \ (source `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` accept `E.InnerJoin` send) -> do
|
||||
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 E.&&.
|
||||
topic E.^. SourceTopicRemoteTopic E.==. E.val a
|
||||
return
|
||||
( source E.^. SourceId
|
||||
, holder E.^. SourceHolderProjectId
|
||||
, send
|
||||
, accept E.^. SourceThemAcceptRemoteId
|
||||
, topic E.^. SourceTopicRemoteId
|
||||
)
|
||||
(E.Value sourceID, E.Value holderID, Entity sendID (SourceUsSendDelegator _ grantID), topic) <-
|
||||
verifySingleE sources "No source" "Multiple sources"
|
||||
|
||||
maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
|
||||
lift $ for maybeRemoveDB $ \ _removeDB -> do
|
||||
|
||||
-- Grab extension-Grants that I'm about to revoke
|
||||
gathers <- selectList [SourceUsGatherSource ==. sendID] []
|
||||
leafs <- selectList [SourceUsLeafSource ==. sendID] []
|
||||
|
||||
-- Delete the whole Source record
|
||||
deleteWhere [SourceRemoveSend ==. sendID]
|
||||
let gatherIDs = map entityKey gathers
|
||||
deleteWhere [SourceUsGatherFromLocalGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherFromRemoteGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherToLocalGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherToRemoteGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherId <-. gatherIDs]
|
||||
let leafIDs = map entityKey leafs
|
||||
deleteWhere [SourceUsLeafFromLocalLeaf <-. leafIDs]
|
||||
deleteWhere [SourceUsLeafFromRemoteLeaf <-. leafIDs]
|
||||
deleteWhere [SourceUsLeafToLocalLeaf <-. leafIDs]
|
||||
deleteWhere [SourceUsLeafToRemoteLeaf <-. leafIDs]
|
||||
case topic of
|
||||
Left (localID, _, _) -> do
|
||||
deleteWhere [SourceThemDelegateLocalSource ==. localID]
|
||||
delete localID
|
||||
Right (remoteID, _) -> do
|
||||
deleteWhere [SourceThemDelegateRemoteSource ==. remoteID]
|
||||
delete remoteID
|
||||
delete sendID
|
||||
origin <-
|
||||
requireEitherAlt
|
||||
(getKeyBy $ UniqueSourceOriginUs sourceID)
|
||||
(getKeyBy $ UniqueSourceOriginThem sourceID)
|
||||
"Neither us nor them"
|
||||
"Both us and them"
|
||||
case origin of
|
||||
Left usID -> do
|
||||
deleteBy $ UniqueSourceUsAccept usID
|
||||
deleteBy $ UniqueSourceUsGestureLocal usID
|
||||
deleteBy $ UniqueSourceUsGestureRemote usID
|
||||
delete usID
|
||||
Right themID -> do
|
||||
deleteBy $ UniqueSourceThemGestureLocal themID
|
||||
deleteBy $ UniqueSourceThemGestureRemote themID
|
||||
delete themID
|
||||
case topic of
|
||||
Left (_, l, j) -> delete j >> delete l
|
||||
Right (_, r) -> delete r
|
||||
delete holderID
|
||||
delete sourceID
|
||||
|
||||
-- Prepare forwarding Remove to my followers
|
||||
sieve <- lift $ do
|
||||
topicHash <- encodeKeyHashid projectID
|
||||
let topicByHash =
|
||||
LocalActorProject topicHash
|
||||
return $ makeRecipientSet [] [localActorFollowers topicByHash]
|
||||
|
||||
-- Prepare main Revoke activity and insert to my outbox
|
||||
revoke@(actionRevoke, _, _, _) <-
|
||||
lift $ prepareMainRevoke childDB grantID
|
||||
let recipByKey = LocalActorProject projectID
|
||||
revokeID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now
|
||||
_luRevoke <- updateOutboxItem' recipByKey revokeID actionRevoke
|
||||
|
||||
-- Prepare and insert Revokes on all the extension-Grants
|
||||
revokesG <- for gathers $ \ (Entity _ (SourceUsGather _ acceptID grantID)) -> do
|
||||
DestUsAccept destID _ <- getJust acceptID
|
||||
parent <- do
|
||||
p <- getDestTopic destID
|
||||
bitraverse
|
||||
(\case
|
||||
Left j -> pure $ LocalActorProject j
|
||||
Right _ -> error "I'm a project but I have a parent who is a Group"
|
||||
)
|
||||
pure
|
||||
(bimap snd snd p)
|
||||
return (parent, grantID)
|
||||
revokesL <- for leafs $ \ (Entity _ (SourceUsLeaf _ enableID grantID)) -> do
|
||||
CollabEnable collabID _ <- getJust enableID
|
||||
recip <- getCollabRecip collabID
|
||||
return
|
||||
( bimap
|
||||
(LocalActorPerson . collabRecipLocalPerson . entityVal)
|
||||
(collabRecipRemoteActor . entityVal)
|
||||
recip
|
||||
, grantID
|
||||
)
|
||||
revokes <- for (revokesG ++ revokesL) $ \ (actor, grantID) -> do
|
||||
ext@(actionExt, _, _, _) <- prepareExtRevoke actor grantID
|
||||
let recipByKey = LocalActorProject projectID
|
||||
extID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now
|
||||
_luExt <- updateOutboxItem' recipByKey extID actionExt
|
||||
return (extID, ext)
|
||||
|
||||
return (projectActor project, sieve, revokeID, revoke, revokes)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), revokes) -> do
|
||||
let topicByID = LocalActorProject projectID
|
||||
forwardActivity authorIdMsig body topicByID topicActorID sieve
|
||||
lift $ do
|
||||
sendActivity
|
||||
topicByID topicActorID localRecipsRevoke
|
||||
remoteRecipsRevoke fwdHostsRevoke revokeID actionRevoke
|
||||
for_ revokes $ \ (extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt)) ->
|
||||
sendActivity
|
||||
topicByID topicActorID localRecipsExt
|
||||
remoteRecipsExt fwdHostsExt extID actionExt
|
||||
done "Deleted the Child/Source, forwarded Remove, sent Revokes"
|
||||
|
||||
where
|
||||
|
||||
prepareMainRevoke child grantID = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
|
||||
recipHash <- encodeKeyHashid projectID
|
||||
let topicByHash = LocalActorProject recipHash
|
||||
|
||||
childHash <- bitraverse (encodeKeyHashid . entityKey) pure child
|
||||
|
||||
audRemover <- makeAudSenderOnly authorIdMsig
|
||||
let audChild =
|
||||
case childHash of
|
||||
Left j ->
|
||||
AudLocal [LocalActorProject j] [LocalStageProjectFollowers j]
|
||||
Right (ObjURI h lu, Entity _ actor) ->
|
||||
AudRemote h [lu] (maybeToList $ remoteActorFollowers actor)
|
||||
audMe = AudLocal [] [localActorFollowers topicByHash]
|
||||
|
||||
(recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audRemover, audChild, audMe]
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
|
||||
uRemove <- getActivityURI authorIdMsig
|
||||
luGrant <- do
|
||||
grantHash <- encodeKeyHashid grantID
|
||||
return $ encodeRouteLocal $ activityRoute topicByHash grantHash
|
||||
let action = AP.Action
|
||||
{ AP.actionCapability = Nothing
|
||||
, AP.actionSummary = Nothing
|
||||
, AP.actionAudience = AP.Audience recips [] [] [] [] []
|
||||
, AP.actionFulfills = [uRemove]
|
||||
, AP.actionSpecific = AP.RevokeActivity AP.Revoke
|
||||
{ AP.revokeObject = luGrant :| []
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
prepareExtRevoke recipient grantID = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
|
||||
projectHash <- encodeKeyHashid projectID
|
||||
let topicByHash = LocalActorProject projectHash
|
||||
|
||||
audRecip <-
|
||||
case recipient of
|
||||
Left a -> do
|
||||
h <- hashLocalActor a
|
||||
return $ AudLocal [h] [localActorFollowers h]
|
||||
Right actorID -> do
|
||||
actor <- getJust actorID
|
||||
ObjURI h lu <- getRemoteActorURI actor
|
||||
return $
|
||||
AudRemote h [lu] (maybeToList $ remoteActorFollowers actor)
|
||||
|
||||
let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audRecip]
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
|
||||
uRemove <- lift $ getActivityURI authorIdMsig
|
||||
luGrant <- do
|
||||
grantHash <- encodeKeyHashid grantID
|
||||
return $ encodeRouteLocal $ activityRoute topicByHash grantHash
|
||||
let action = AP.Action
|
||||
{ AP.actionCapability = Nothing
|
||||
, AP.actionSummary = Nothing
|
||||
, AP.actionAudience = AP.Audience recips [] [] [] [] []
|
||||
, AP.actionFulfills = [uRemove]
|
||||
, AP.actionSpecific = AP.RevokeActivity AP.Revoke
|
||||
{ AP.revokeObject = luGrant :| []
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
removeParentActive parent = do
|
||||
|
||||
-- If parent is local, find it in our DB
|
||||
-- If parent is remote, HTTP GET it, verify it's an actor of Project
|
||||
-- type, and store in our DB (if it's already there, no need for HTTP)
|
||||
--
|
||||
-- NOTE: This is a blocking HTTP GET done right here in the handler,
|
||||
-- which is NOT a good idea. Ideally, it would be done async, and the
|
||||
-- handler result would be sent later in a separate (e.g. Accept) activity.
|
||||
-- But for the PoC level, the current situation will hopefully do.
|
||||
parentDB <-
|
||||
bitraverse
|
||||
(\case
|
||||
LocalActorProject j -> withDBExcept $ getEntityE j "Parent not found in DB"
|
||||
_ -> throwE "Local proposed parent of non-project type"
|
||||
)
|
||||
(\ u@(ObjURI h lu) -> do
|
||||
instanceID <-
|
||||
lift $ withDB $ either entityKey id <$> insertBy' (Instance h)
|
||||
result <-
|
||||
ExceptT $ first (T.pack . displayException) <$>
|
||||
fetchRemoteActor' instanceID h lu
|
||||
case result of
|
||||
Left Nothing -> throwE "Parent @id mismatch"
|
||||
Left (Just err) -> throwE $ T.pack $ displayException err
|
||||
Right Nothing -> throwE "Parent isn't an actor"
|
||||
Right (Just actor) -> do
|
||||
case remoteActorType $ entityVal actor of
|
||||
AP.ActorTypeProject -> pure ()
|
||||
_ -> throwE "Remote parent type isn't Project"
|
||||
return (u, actor)
|
||||
)
|
||||
parent
|
||||
|
||||
-- Verify that a capability is provided
|
||||
uCap <- do
|
||||
let muCap = AP.activityCapability $ actbActivity body
|
||||
fromMaybeE muCap "No capability provided"
|
||||
|
||||
-- Verify the sender is authorized by me to remove a parent
|
||||
verifyCapability''
|
||||
uCap
|
||||
authorIdMsig
|
||||
(LocalActorProject projectID)
|
||||
AP.RoleAdmin
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
(project, actorRecip) <- lift $ do
|
||||
p <- getJust projectID
|
||||
(p,) <$> getJust (projectActor p)
|
||||
|
||||
-- Verify it's an active child of mine
|
||||
dests <- lift $ case parentDB of
|
||||
Left (Entity j _) ->
|
||||
fmap (map $ \ (d, h, a, E.Value l, E.Value t, E.Value s) -> (d, h, a, Left (l, t, s))) $
|
||||
E.select $ E.from $ \ (dest `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` send) -> do
|
||||
E.on $ topic E.^. DestTopicProjectTopic E.==. send E.^. DestThemSendDelegatorLocalTopic
|
||||
E.on $ holder E.^. DestHolderProjectId E.==. topic E.^. DestTopicProjectHolder
|
||||
E.on $ dest E.^. DestId E.==. holder E.^. DestHolderProjectDest
|
||||
E.where_ $
|
||||
holder E.^. DestHolderProjectProject E.==. E.val projectID E.&&.
|
||||
topic E.^. DestTopicProjectParent E.==. E.val j
|
||||
return
|
||||
( dest E.^. DestId
|
||||
, holder E.^. DestHolderProjectId
|
||||
, send E.^. DestThemSendDelegatorLocalDest
|
||||
, topic E.^. DestTopicProjectTopic
|
||||
, topic E.^. DestTopicProjectId
|
||||
, send E.^. DestThemSendDelegatorLocalId
|
||||
)
|
||||
Right (_, Entity a _) ->
|
||||
fmap (map $ \ (d, h, a, E.Value t, E.Value s) -> (d, h, a, Right (t, s))) $
|
||||
E.select $ E.from $ \ (dest `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` send) -> do
|
||||
E.on $ topic E.^. DestTopicRemoteId E.==. send E.^. DestThemSendDelegatorRemoteTopic
|
||||
E.on $ dest E.^. DestId E.==. topic E.^. DestTopicRemoteDest
|
||||
E.on $ dest E.^. DestId E.==. holder E.^. DestHolderProjectDest
|
||||
E.where_ $
|
||||
holder E.^. DestHolderProjectProject E.==. E.val projectID E.&&.
|
||||
topic E.^. DestTopicRemoteTopic E.==. E.val a
|
||||
return
|
||||
( dest E.^. DestId
|
||||
, holder E.^. DestHolderProjectId
|
||||
, send E.^. DestThemSendDelegatorRemoteDest
|
||||
, topic E.^. DestTopicRemoteId
|
||||
, send E.^. DestThemSendDelegatorRemoteId
|
||||
)
|
||||
|
||||
(E.Value destID, E.Value holderID, E.Value usAcceptID, topic) <-
|
||||
verifySingleE dests "No dest" "Multiple dests"
|
||||
|
||||
maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
|
||||
lift $ for maybeRemoveDB $ \ _removeDB -> do
|
||||
|
||||
-- Delete uses of this Dest from my Component records
|
||||
case topic of
|
||||
Left (_, _, sendID) ->
|
||||
deleteWhere [ComponentGatherLocalParent ==. sendID]
|
||||
Right (_, sendID) ->
|
||||
deleteWhere [ComponentGatherRemoteParent ==. sendID]
|
||||
|
||||
-- Delete uses of this Dest from my Source records
|
||||
case topic of
|
||||
Left (_, _, sendID) -> do
|
||||
gatherIDs <-
|
||||
map (sourceUsGatherToLocalGather . entityVal) <$>
|
||||
selectList [SourceUsGatherToLocalTo ==. sendID] []
|
||||
deleteWhere [SourceUsGatherFromLocalGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherFromRemoteGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherToLocalGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherId <-. gatherIDs]
|
||||
Right (_, sendID) -> do
|
||||
gatherIDs <-
|
||||
map (sourceUsGatherToRemoteGather . entityVal) <$>
|
||||
selectList [SourceUsGatherToRemoteTo ==. sendID] []
|
||||
deleteWhere [SourceUsGatherFromLocalGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherFromRemoteGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherToRemoteGather <-. gatherIDs]
|
||||
deleteWhere [SourceUsGatherId <-. gatherIDs]
|
||||
|
||||
-- Delete the whole Dest record
|
||||
case topic of
|
||||
Left (_, _, sendID) -> delete sendID
|
||||
Right (_, sendID) -> delete sendID
|
||||
origin <-
|
||||
requireEitherAlt
|
||||
(getKeyBy $ UniqueDestOriginUs destID)
|
||||
(getKeyBy $ UniqueDestOriginThem destID)
|
||||
"Neither us nor them"
|
||||
"Both us and them"
|
||||
deleteBy $ UniqueDestUsGestureLocal destID
|
||||
deleteBy $ UniqueDestUsGestureRemote destID
|
||||
case origin of
|
||||
Left usID -> delete usID
|
||||
Right themID -> do
|
||||
deleteBy $ UniqueDestThemAcceptLocal themID
|
||||
deleteBy $ UniqueDestThemAcceptRemote themID
|
||||
deleteBy $ UniqueDestThemGestureLocal themID
|
||||
deleteBy $ UniqueDestThemGestureRemote themID
|
||||
delete themID
|
||||
delete usAcceptID
|
||||
case topic of
|
||||
Left (l, j, _) -> delete j >> delete l
|
||||
Right (r, _) -> delete r
|
||||
delete holderID
|
||||
delete destID
|
||||
|
||||
-- Prepare forwarding Remove to my followers
|
||||
sieve <- lift $ do
|
||||
topicHash <- encodeKeyHashid projectID
|
||||
let topicByHash =
|
||||
LocalActorProject topicHash
|
||||
return $ makeRecipientSet [] [localActorFollowers topicByHash]
|
||||
|
||||
-- Prepare Accept activity
|
||||
accept@(actionAccept, _, _, _) <- prepareAccept parentDB
|
||||
let recipByKey = LocalActorProject projectID
|
||||
acceptID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now
|
||||
_luAccept <- updateOutboxItem' recipByKey acceptID actionAccept
|
||||
|
||||
return (projectActor project, sieve, acceptID, accept)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
|
||||
let topicByID = LocalActorProject projectID
|
||||
forwardActivity authorIdMsig body topicByID topicActorID sieve
|
||||
lift $
|
||||
sendActivity
|
||||
topicByID topicActorID localRecipsAccept
|
||||
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
|
||||
done "Deleted the Parent/Dest, forwarded Remove, sent Accept"
|
||||
|
||||
where
|
||||
|
||||
prepareAccept parentDB = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
|
||||
audRemover <- lift $ makeAudSenderOnly authorIdMsig
|
||||
audParent <-
|
||||
case parentDB of
|
||||
Left (Entity j _) -> do
|
||||
h <- encodeKeyHashid j
|
||||
return $ AudLocal [LocalActorProject h] [LocalStageProjectFollowers h]
|
||||
Right (ObjURI h lu, Entity _ ra) ->
|
||||
return $ AudRemote h [lu] (maybeToList $ remoteActorFollowers ra)
|
||||
audMe <-
|
||||
AudLocal [] . pure . LocalStageProjectFollowers <$>
|
||||
encodeKeyHashid projectID
|
||||
uRemove <- lift $ getActivityURI authorIdMsig
|
||||
|
||||
let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audRemover, audParent, audMe]
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
action = AP.Action
|
||||
{ AP.actionCapability = Nothing
|
||||
, AP.actionSummary = Nothing
|
||||
, AP.actionAudience = AP.Audience recips [] [] [] [] []
|
||||
, AP.actionFulfills = [uRemove]
|
||||
, AP.actionSpecific = AP.AcceptActivity AP.Accept
|
||||
{ AP.acceptObject = uRemove
|
||||
, AP.acceptResult = Nothing
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
removeChildPassive child = do
|
||||
|
||||
-- If child is local, find it in our DB
|
||||
-- If child is remote, HTTP GET it, verify it's an actor of Project
|
||||
-- type, and store in our DB (if it's already there, no need for HTTP)
|
||||
--
|
||||
-- NOTE: This is a blocking HTTP GET done right here in the handler,
|
||||
-- which is NOT a good idea. Ideally, it would be done async, and the
|
||||
-- handler result would be sent later in a separate (e.g. Accept) activity.
|
||||
-- But for the PoC level, the current situation will hopefully do.
|
||||
childDB <-
|
||||
bitraverse
|
||||
(\ j -> withDBExcept $ getEntityE j "Child not found in DB")
|
||||
(\ u@(ObjURI h lu) -> do
|
||||
instanceID <-
|
||||
lift $ withDB $ either entityKey id <$> insertBy' (Instance h)
|
||||
result <-
|
||||
ExceptT $ first (T.pack . displayException) <$>
|
||||
fetchRemoteActor' instanceID h lu
|
||||
case result of
|
||||
Left Nothing -> throwE "Child @id mismatch"
|
||||
Left (Just err) -> throwE $ T.pack $ displayException err
|
||||
Right Nothing -> throwE "Child isn't an actor"
|
||||
Right (Just actor) -> do
|
||||
case remoteActorType $ entityVal actor of
|
||||
AP.ActorTypeProject -> pure ()
|
||||
_ -> throwE "Remote child type isn't Project"
|
||||
return (u, actor)
|
||||
)
|
||||
child
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
(project, actorRecip) <- lift $ do
|
||||
p <- getJust projectID
|
||||
(p,) <$> getJust (projectActor p)
|
||||
|
||||
-- Verify it's an active child of mine
|
||||
sources <- lift $ case childDB of
|
||||
Left (Entity j _) ->
|
||||
fmap (map $ \ (s, h, d, E.Value a, E.Value t, E.Value i) -> (s, h, d, Left (a, t, i))) $
|
||||
E.select $ E.from $ \ (source `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` accept `E.InnerJoin` send) -> do
|
||||
E.on $ source E.^. SourceId E.==. send E.^. SourceUsSendDelegatorSource
|
||||
E.on $ topic E.^. SourceTopicProjectTopic E.==. accept E.^. SourceThemAcceptLocalTopic
|
||||
E.on $ holder E.^. SourceHolderProjectId E.==. topic E.^. SourceTopicProjectHolder
|
||||
E.on $ source E.^. SourceId E.==. holder E.^. SourceHolderProjectSource
|
||||
E.where_ $
|
||||
holder E.^. SourceHolderProjectProject E.==. E.val projectID E.&&.
|
||||
topic E.^. SourceTopicProjectChild E.==. E.val j
|
||||
return
|
||||
( source E.^. SourceId
|
||||
, holder E.^. SourceHolderProjectId
|
||||
, send
|
||||
, accept E.^. SourceThemAcceptLocalId
|
||||
, topic E.^. SourceTopicProjectTopic
|
||||
, topic E.^. SourceTopicProjectId
|
||||
)
|
||||
Right (_, Entity a _) ->
|
||||
fmap (map $ \ (s, h, d, E.Value a, E.Value t) -> (s, h, d, Right (a, t))) $
|
||||
E.select $ E.from $ \ (source `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` accept `E.InnerJoin` send) -> do
|
||||
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 E.&&.
|
||||
topic E.^. SourceTopicRemoteTopic E.==. E.val a
|
||||
return
|
||||
( source E.^. SourceId
|
||||
, holder E.^. SourceHolderProjectId
|
||||
, send
|
||||
, accept E.^. SourceThemAcceptRemoteId
|
||||
, topic E.^. SourceTopicRemoteId
|
||||
)
|
||||
(E.Value sourceID, E.Value holderID, Entity sendID (SourceUsSendDelegator _ grantID), topic) <-
|
||||
verifySingleE sources "No source" "Multiple sources"
|
||||
|
||||
maybeRemoveDB <- lift $ insertToInbox' now authorIdMsig body (actorInbox actorRecip) False
|
||||
lift $ for maybeRemoveDB $ \ (removeID, _) -> do
|
||||
|
||||
-- Record the removal attempt
|
||||
insert_ $ SourceRemove sendID removeID
|
||||
|
||||
-- Prepare forwarding Remove to my followers
|
||||
sieve <- lift $ do
|
||||
topicHash <- encodeKeyHashid projectID
|
||||
let topicByHash =
|
||||
LocalActorProject topicHash
|
||||
return $ makeRecipientSet [] [localActorFollowers topicByHash]
|
||||
|
||||
return (projectActor project, sieve)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (topicActorID, sieve) -> do
|
||||
let topicByID = LocalActorProject projectID
|
||||
forwardActivity authorIdMsig body topicByID topicActorID sieve
|
||||
done "Recorded removal attempt, forwarded Remove"
|
||||
|
||||
removeParentPassive parent = do
|
||||
|
||||
-- If parent is local, find it in our DB
|
||||
-- If parent is remote, HTTP GET it, verify it's an actor of Project
|
||||
-- type, and store in our DB (if it's already there, no need for HTTP)
|
||||
--
|
||||
-- NOTE: This is a blocking HTTP GET done right here in the handler,
|
||||
-- which is NOT a good idea. Ideally, it would be done async, and the
|
||||
-- handler result would be sent later in a separate (e.g. Accept) activity.
|
||||
-- But for the PoC level, the current situation will hopefully do.
|
||||
parentDB <-
|
||||
bitraverse
|
||||
(\ j -> withDBExcept $ getEntityE j "Parent not found in DB")
|
||||
(\ u@(ObjURI h lu) -> do
|
||||
instanceID <-
|
||||
lift $ withDB $ either entityKey id <$> insertBy' (Instance h)
|
||||
result <-
|
||||
ExceptT $ first (T.pack . displayException) <$>
|
||||
fetchRemoteActor' instanceID h lu
|
||||
case result of
|
||||
Left Nothing -> throwE "Parent @id mismatch"
|
||||
Left (Just err) -> throwE $ T.pack $ displayException err
|
||||
Right Nothing -> throwE "Parent isn't an actor"
|
||||
Right (Just actor) -> do
|
||||
case remoteActorType $ entityVal actor of
|
||||
AP.ActorTypeProject -> pure ()
|
||||
_ -> throwE "Remote parent type isn't Project"
|
||||
return (u, actor)
|
||||
)
|
||||
parent
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
(project, actorRecip) <- lift $ do
|
||||
p <- getJust projectID
|
||||
(p,) <$> getJust (projectActor p)
|
||||
|
||||
-- Verify it's an active parent of mine
|
||||
dests <- lift $ case parentDB of
|
||||
Left (Entity j _) ->
|
||||
fmap (map $ \ (d, h, a, E.Value l, E.Value t, E.Value s) -> (d, h, a, Left (l, t, s))) $
|
||||
E.select $ E.from $ \ (dest `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` send) -> do
|
||||
E.on $ topic E.^. DestTopicProjectTopic E.==. send E.^. DestThemSendDelegatorLocalTopic
|
||||
E.on $ holder E.^. DestHolderProjectId E.==. topic E.^. DestTopicProjectHolder
|
||||
E.on $ dest E.^. DestId E.==. holder E.^. DestHolderProjectDest
|
||||
E.where_ $
|
||||
holder E.^. DestHolderProjectProject E.==. E.val projectID E.&&.
|
||||
topic E.^. DestTopicProjectParent E.==. E.val j
|
||||
return
|
||||
( dest E.^. DestId
|
||||
, holder E.^. DestHolderProjectId
|
||||
, send E.^. DestThemSendDelegatorLocalDest
|
||||
, topic E.^. DestTopicProjectTopic
|
||||
, topic E.^. DestTopicProjectId
|
||||
, send E.^. DestThemSendDelegatorLocalId
|
||||
)
|
||||
Right (_, Entity a _) ->
|
||||
fmap (map $ \ (d, h, a, E.Value t, E.Value s) -> (d, h, a, Right (t, s))) $
|
||||
E.select $ E.from $ \ (dest `E.InnerJoin` holder `E.InnerJoin` topic `E.InnerJoin` send) -> do
|
||||
E.on $ topic E.^. DestTopicRemoteId E.==. send E.^. DestThemSendDelegatorRemoteTopic
|
||||
E.on $ dest E.^. DestId E.==. topic E.^. DestTopicRemoteDest
|
||||
E.on $ dest E.^. DestId E.==. holder E.^. DestHolderProjectDest
|
||||
E.where_ $
|
||||
holder E.^. DestHolderProjectProject E.==. E.val projectID E.&&.
|
||||
topic E.^. DestTopicRemoteTopic E.==. E.val a
|
||||
return
|
||||
( dest E.^. DestId
|
||||
, holder E.^. DestHolderProjectId
|
||||
, send E.^. DestThemSendDelegatorRemoteDest
|
||||
, topic E.^. DestTopicRemoteId
|
||||
, send E.^. DestThemSendDelegatorRemoteId
|
||||
)
|
||||
|
||||
(E.Value destID, E.Value holderID, E.Value usAcceptID, topic) <-
|
||||
verifySingleE dests "No dest" "Multiple dests"
|
||||
|
||||
maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
|
||||
lift $ for maybeRemoveDB $ \ _removeDB -> do
|
||||
|
||||
return ()
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just () ->
|
||||
done "Saw the removal attempt, just waiting for the Revoke"
|
||||
|
||||
-- Meaning: An actor is undoing some previous action
|
||||
-- Behavior:
|
||||
-- * If they're undoing their Following of me:
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2019, 2020, 2023 by fr33domlover <fr33domlover@riseup.net>.
|
||||
- Written in 2019, 2020, 2023, 2024 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
|
|
@ -15,6 +15,7 @@
|
|||
|
||||
module Vervis.Federation.Util
|
||||
( insertToInbox
|
||||
, insertToInbox'
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -38,6 +39,47 @@ import Vervis.Model
|
|||
|
||||
-- | Insert an activity delivered to us into our inbox. Return its
|
||||
-- database ID if the activity wasn't already in our inbox.
|
||||
insertToInbox'
|
||||
:: UTCTime
|
||||
-> Either
|
||||
(LocalActorBy Key, ActorId, OutboxItemId)
|
||||
(RemoteAuthor, LocalURI, Maybe ByteString)
|
||||
-> ActivityBody
|
||||
-> InboxId
|
||||
-> Bool
|
||||
-> ActDB
|
||||
(Maybe
|
||||
( InboxItemId
|
||||
, Either
|
||||
(LocalActorBy Key, ActorId, OutboxItemId)
|
||||
(RemoteAuthor, LocalURI, RemoteActivityId)
|
||||
)
|
||||
)
|
||||
insertToInbox' now (Left a@(_, _, outboxItemID)) _body inboxID unread = do
|
||||
inboxItemID <- insert $ InboxItem unread now
|
||||
maybeItem <- insertUnique $ InboxItemLocal inboxID outboxItemID inboxItemID
|
||||
case maybeItem of
|
||||
Nothing -> do
|
||||
delete inboxItemID
|
||||
return Nothing
|
||||
Just _ -> return $ Just (inboxItemID, Left a)
|
||||
insertToInbox' now (Right (author, luAct, _)) body inboxID unread = do
|
||||
let iidAuthor = remoteAuthorInstance author
|
||||
roid <-
|
||||
either entityKey id <$> insertBy' (RemoteObject iidAuthor luAct)
|
||||
ractid <- either entityKey id <$> insertBy' RemoteActivity
|
||||
{ remoteActivityIdent = roid
|
||||
, remoteActivityContent = persistJSONFromBL $ actbBL body
|
||||
, remoteActivityReceived = now
|
||||
}
|
||||
ibiid <- insert $ InboxItem unread now
|
||||
mibrid <- insertUnique $ InboxItemRemote inboxID ractid ibiid
|
||||
case mibrid of
|
||||
Nothing -> do
|
||||
delete ibiid
|
||||
return Nothing
|
||||
Just _ -> return $ Just (ibiid, Right (author, luAct, ractid))
|
||||
|
||||
insertToInbox
|
||||
:: UTCTime
|
||||
-> Either
|
||||
|
|
@ -53,27 +95,5 @@ insertToInbox
|
|||
(RemoteAuthor, LocalURI, RemoteActivityId)
|
||||
)
|
||||
)
|
||||
insertToInbox now (Left a@(_, _, outboxItemID)) _body inboxID unread = do
|
||||
inboxItemID <- insert $ InboxItem unread now
|
||||
maybeItem <- insertUnique $ InboxItemLocal inboxID outboxItemID inboxItemID
|
||||
case maybeItem of
|
||||
Nothing -> do
|
||||
delete inboxItemID
|
||||
return Nothing
|
||||
Just _ -> return $ Just $ Left a
|
||||
insertToInbox now (Right (author, luAct, _)) body inboxID unread = do
|
||||
let iidAuthor = remoteAuthorInstance author
|
||||
roid <-
|
||||
either entityKey id <$> insertBy' (RemoteObject iidAuthor luAct)
|
||||
ractid <- either entityKey id <$> insertBy' RemoteActivity
|
||||
{ remoteActivityIdent = roid
|
||||
, remoteActivityContent = persistJSONFromBL $ actbBL body
|
||||
, remoteActivityReceived = now
|
||||
}
|
||||
ibiid <- insert $ InboxItem unread now
|
||||
mibrid <- insertUnique $ InboxItemRemote inboxID ractid ibiid
|
||||
case mibrid of
|
||||
Nothing -> do
|
||||
delete ibiid
|
||||
return Nothing
|
||||
Just _ -> return $ Just $ Right (author, luAct, ractid)
|
||||
insertToInbox now act body inbox unread =
|
||||
fmap snd <$> insertToInbox' now act body inbox unread
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2016, 2018, 2019, 2020, 2021, 2022, 2023
|
||||
- Written in 2016, 2018, 2019, 2020, 2021, 2022, 2023, 2024
|
||||
- by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
|
|
@ -3212,6 +3212,8 @@ changes hLocal ctx =
|
|||
, addUnique' "SourceThemDelegateRemote" "" ["source", "grant"]
|
||||
-- 577
|
||||
, addEntities model_577_component_gather
|
||||
-- 578
|
||||
, addEntities model_578_source_remove
|
||||
]
|
||||
|
||||
migrateDB
|
||||
|
|
|
|||
|
|
@ -69,6 +69,7 @@ module Vervis.Migration.Entities
|
|||
, model_564_permit
|
||||
, model_570_source_dest
|
||||
, model_577_component_gather
|
||||
, model_578_source_remove
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -268,3 +269,6 @@ 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")
|
||||
|
||||
model_578_source_remove :: [Entity SqlBackend]
|
||||
model_578_source_remove = $(schema "578_2024-04-03_source_remove")
|
||||
|
|
|
|||
12
th/models
12
th/models
|
|
@ -1510,6 +1510,18 @@ SourceUsLeafToRemote
|
|||
|
||||
UniqueSourceUsLeafToRemote leaf
|
||||
|
||||
-------------------------------- Source remove -------------------------------
|
||||
|
||||
-- Witnesses there's a removal request from the child's side, and I'm waiting
|
||||
-- for the child project/team to Accept, which is when I'll do the removal on
|
||||
-- my side
|
||||
|
||||
SourceRemove
|
||||
send SourceUsSendDelegatorId
|
||||
activity InboxItemId
|
||||
|
||||
UniqueSourceRemove activity
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Inheritance - Giver tracking her receivers
|
||||
-- (Project tracking its parents)
|
||||
|
|
|
|||
Loading…
Reference in a new issue