S2S, DB: Store processing result in InboxItem record

This commit is contained in:
Pere Lev 2024-04-27 19:15:28 +03:00
parent d24492bf44
commit eef4c3f79a
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
11 changed files with 288 additions and 287 deletions

View file

@ -1087,9 +1087,9 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips
-- Deliver the Follow and Accept by simply manually inserting them to
-- loom and sender inboxes respectively
lift $ do
ibiidF <- insert $ InboxItem False now
ibiidF <- insert $ InboxItem False now "Vervis.API"
insert_ $ InboxItemLocal (actorInbox loomActor) obiidFollow ibiidF
ibiidA <- insert $ InboxItem False now
ibiidA <- insert $ InboxItem False now "Vervis.API"
insert_ $ InboxItemLocal (actorInbox senderActor) obiidAccept ibiidA
-- Return instructions for HTTP delivery to remote recipients
@ -1330,9 +1330,9 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r
-- Deliver the Follow and Accept by simply manually inserting them to
-- repo and sender inboxes respectively
lift $ do
ibiidF <- insert $ InboxItem False now
ibiidF <- insert $ InboxItem False now "Vervis.API"
insert_ $ InboxItemLocal (actorInbox repoActor) obiidFollow ibiidF
ibiidA <- insert $ InboxItem False now
ibiidA <- insert $ InboxItem False now "Vervis.API"
insert_ $ InboxItemLocal (actorInbox senderActor) obiidAccept ibiidA
-- Return instructions for HTTP delivery to remote recipients

View file

@ -127,7 +127,7 @@ actorFollow parseFollowee grabActor unread getFollowee getSieve makeLocalActor m
-- Insert the Follow to my inbox
maybeFollowDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) unread
for maybeFollowDB $ \ followDB -> do
for maybeFollowDB $ \ (inboxItemID, followDB) -> do
-- Find followee in DB
followerSetID <- getFollowee recipActor followee
@ -158,16 +158,16 @@ actorFollow parseFollowee grabActor unread getFollowee getSieve makeLocalActor m
_luAccept <- lift $ updateOutboxItem' (makeLocalActor recipID) acceptID actionAccept
sieve <- lift $ getSieve followee
return (recipActorID, acceptID, sieve, accept)
return (recipActorID, acceptID, sieve, accept, inboxItemID)
case maybeFollow of
Nothing -> done "I already have this activity in my inbox"
Just (actorID, acceptID, sieve, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (actorID, acceptID, sieve, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
forwardActivity authorIdMsig body (makeLocalActor recipID) actorID sieve
lift $ sendActivity
(makeLocalActor recipID) actorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done "Recorded Follow and published Accept"
doneDB inboxItemID "Recorded Follow and published Accept"
where
@ -458,7 +458,7 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a
verifyNothingE maybeEnabled "I already sent a Grant for this Invite/Join"
maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
for maybeAcceptDB $ \ acceptDB -> do
for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do
-- Record the Accept on the Collab
case (idsForAccept, acceptDB) of
@ -501,17 +501,17 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a
_luGrant <- lift $ updateOutboxItem' recipByKey grantID actionGrant
return (grantID, grant)
return (recipActorID, sieve, grantInfo)
return (recipActorID, sieve, grantInfo, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, sieve, (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant))) -> do
Just (recipActorID, sieve, (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)), inboxItemID) -> do
let recipByID = resourceToActor $ topicResource recipKey
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $ sendActivity
recipByID recipActorID localRecipsGrant
remoteRecipsGrant fwdHostsGrant grantID actionGrant
done "Forwarded the Accept and published a Grant"
doneDB inboxItemID "Forwarded the Accept and published a Grant"
prepareReact project inviter = do
encodeRouteHome <- getEncodeRouteHome
@ -638,9 +638,9 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a
stem
maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
for maybeAcceptDB $ \ acceptDB ->
for maybeAcceptDB $ \ (inboxItemID, acceptDB) ->
case idsForLater of
(inboxItemID,) <$> case idsForLater of
Left (originInviteID, seen, inviter) -> do
@ -683,14 +683,14 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just Nothing -> done "Done"
Just (Just (sieve, (reactID, (actionReact, localRecipsReact, remoteRecipsReact, fwdHostsReact)))) -> do
Just (inboxItemID, Nothing) -> doneDB inboxItemID "Done"
Just (inboxItemID, (Just (sieve, (reactID, (actionReact, localRecipsReact, remoteRecipsReact, fwdHostsReact))))) -> do
let recipByID = resourceToActor $ topicResource recipKey
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $ sendActivity
recipByID recipActorID localRecipsReact
remoteRecipsReact fwdHostsReact reactID actionReact
done "Forwarded the Accept and published an Accept"
doneDB inboxItemID "Forwarded the Accept and published an Accept"
topicReject
:: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
@ -803,7 +803,7 @@ topicReject grabResource topicResource now recipKey (Verse authorIdMsig body) re
throwE "Join is already approved"
maybeRejectDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
for maybeRejectDB $ \ rejectDB -> do
for maybeRejectDB $ \ (inboxItemID, rejectDB) -> do
-- Delete the whole Collab record
case idsForReject of
@ -834,17 +834,17 @@ topicReject grabResource topicResource now recipKey (Verse authorIdMsig body) re
_luNewReject <- lift $ updateOutboxItem' recipByKey newRejectID actionReject
return (newRejectID, newReject)
return (recipActorID, sieve, newRejectInfo)
return (recipActorID, sieve, newRejectInfo, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, sieve, (newRejectID, (action, localRecips, remoteRecips, fwdHosts))) -> do
Just (recipActorID, sieve, (newRejectID, (action, localRecips, remoteRecips, fwdHosts)), inboxItemID) -> do
let recipByID = resourceToActor $ topicResource recipKey
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $ sendActivity
recipByID recipActorID localRecips
remoteRecips fwdHosts newRejectID action
done "Forwarded the Reject and published my own Reject"
doneDB inboxItemID "Forwarded the Reject and published my own Reject"
where
@ -1133,7 +1133,7 @@ topicInvite grabResource topicComponent stemIdentCtor now topicKey (Verse author
checkExistingStems (topicComponent topicKey) projectDB
maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False
lift $ for maybeInviteDB $ \ inviteDB -> do
lift $ for maybeInviteDB $ \ (inboxItemID, inviteDB) -> do
-- Prepare forwarding Invite to my followers
sieve <- do
@ -1157,18 +1157,18 @@ topicInvite grabResource topicComponent stemIdentCtor now topicKey (Verse author
insertStem projectDB inviteDB
return Nothing
return (topicActorID, sieve, maybeAccept)
return (topicActorID, sieve, maybeAccept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, sieve, maybeAccept) -> do
Just (topicActorID, sieve, maybeAccept, inboxItemID) -> do
let topicByID = resourceToActor $ topicResource topicKey
forwardActivity authorIdMsig body topicByID topicActorID sieve
lift $ for_ maybeAccept $ \ (acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) ->
sendActivity
topicByID topicActorID localRecipsAccept remoteRecipsAccept
fwdHostsAccept acceptID actionAccept
done "Recorded and forwarded the Invite, sent an Accept if collab"
doneDB inboxItemID "Recorded and forwarded the Invite, sent an Accept if collab"
where
@ -1359,7 +1359,7 @@ topicRemove grabResource topicResource now topicKey (Verse authorIdMsig body) re
throwE "No other admins exist, can't remove"
maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False
lift $ for maybeRemoveDB $ \ _removeDB -> do
lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do
-- Delete the whole Collab record
deleteBy $ UniqueCollabDelegLocal enableID
@ -1406,17 +1406,17 @@ topicRemove grabResource topicResource now topicKey (Verse authorIdMsig body) re
revokeID <- insertEmptyOutboxItem' (actorOutbox topicActor) now
_luRevoke <- updateOutboxItem' recipByKey revokeID actionRevoke
return (topicActorID, sieve, revokeID, revoke)
return (topicActorID, sieve, revokeID, revoke, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke)) -> do
Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), inboxItemID) -> do
let topicByID = resourceToActor $ topicResource topicKey
forwardActivity authorIdMsig body topicByID topicActorID sieve
lift $ sendActivity
topicByID topicActorID localRecipsRevoke
remoteRecipsRevoke fwdHostsRevoke revokeID actionRevoke
done "Deleted the Grant/Collab, forwarded Remove, sent Revoke"
doneDB inboxItemID "Deleted the Grant/Collab, forwarded Remove, sent Revoke"
where
@ -1512,7 +1512,7 @@ topicJoin grabResource topicResource now topicKey (Verse authorIdMsig body) join
_ -> error "Multiple collabs found for target"
maybeJoinDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False
for maybeJoinDB $ \ joinDB -> do
for maybeJoinDB $ \ (inboxItemID, joinDB) -> do
-- Insert Collab record to DB
joinDB' <-
@ -1531,14 +1531,14 @@ topicJoin grabResource topicResource now topicKey (Verse authorIdMsig body) join
topicHash <- encodeKeyHashid topicKey
let topicByHash = resourceToActor $ topicResource topicHash
return $ makeRecipientSet [] [localActorFollowers topicByHash]
return (topicActorID, sieve)
return (topicActorID, sieve, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, sieve) -> do
Just (topicActorID, sieve, inboxItemID) -> do
let topicByID = resourceToActor $ topicResource topicKey
forwardActivity authorIdMsig body topicByID topicActorID sieve
done "Recorded and forwarded the Join"
doneDB inboxItemID "Recorded and forwarded the Join"
where
@ -1590,7 +1590,7 @@ topicCreateMe grabResource topicResource now recipKey (Verse authorIdMsig body)
_ -> throwE "Create author isn't why I believe my creator is - is this Create fake?"
maybeCreateDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
lift $ for maybeCreateDB $ \ _createDB -> do
lift $ for maybeCreateDB $ \ (inboxItemID, _createDB) -> do
-- Create a Collab record and exit just-been-created state
grantID <- insertEmptyOutboxItem' (actorOutbox recipActor) now
@ -1602,16 +1602,16 @@ topicCreateMe grabResource topicResource now recipKey (Verse authorIdMsig body)
let recipByKey = resourceToActor $ topicResource recipKey
_luGrant <- updateOutboxItem' recipByKey grantID actionGrant
return (recipActorID, grantID, grant)
return (recipActorID, grantID, grant, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) -> do
Just (recipActorID, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant), inboxItemID) -> do
let recipByID = resourceToActor $ topicResource recipKey
lift $ sendActivity
recipByID recipActorID localRecipsGrant
remoteRecipsGrant fwdHostsGrant grantID actionGrant
done "Created a Collab record and published a Grant"
doneDB inboxItemID "Created a Collab record and published a Grant"
where
@ -1760,7 +1760,7 @@ componentGrant grabResource topicComponent now recipKey (Verse authorIdMsig body
throwE "I already received a delegator-Grant for this Invite/Add"
maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
lift $ for maybeGrantDB $ \ grantDB -> do
lift $ for maybeGrantDB $ \ (inboxItemID, grantDB) -> do
-- Prepare forwarding to my followers
sieve <- do
@ -1784,17 +1784,17 @@ componentGrant grabResource topicComponent now recipKey (Verse authorIdMsig body
_luChain <- updateOutboxItem' recipByKey chainID actionChain
return chain
return (recipActorID, sieve, chainID, chain)
return (recipActorID, sieve, chainID, chain, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, sieve, chainID, (actionChain, localRecipsChain, remoteRecipsChain, fwdHostsChain)) -> do
Just (recipActorID, sieve, chainID, (actionChain, localRecipsChain, remoteRecipsChain, fwdHostsChain), inboxItemID) -> do
let recipByID = resourceToActor $ topicResource recipKey
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $ sendActivity
recipByID recipActorID localRecipsChain remoteRecipsChain
fwdHostsChain chainID actionChain
done "Recorded and forwarded the delegator-Grant, sent a delegation-starter Grant"
doneDB inboxItemID "Recorded and forwarded the delegator-Grant, sent a delegation-starter Grant"
where

View file

@ -199,7 +199,7 @@ deckAdd now deckID (Verse authorIdMsig body) add = do
-- Insert the Add to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actor) False
lift $ for mractid $ \ addDB -> do
lift $ for mractid $ \ (inboxItemID, addDB) -> do
-- Create a Stem record in DB
acceptID <- insertEmptyOutboxItem' (actorOutbox actor) now
@ -214,17 +214,17 @@ deckAdd now deckID (Verse authorIdMsig body) add = do
accept@(actionAccept, _, _, _) <- prepareAccept projectDB
_luAccept <- updateOutboxItem' (LocalActorDeck deckID) acceptID actionAccept
return (deckActor deck, sieve, acceptID, accept)
return (deckActor deck, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorDeck deckID) actorID sieve
lift $ sendActivity
(LocalActorDeck deckID) actorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done "Recorded and forwarded the Add, sent an Accept"
doneDB inboxItemID "Recorded and forwarded the Add, sent an Accept"
where
@ -382,7 +382,7 @@ deckOffer now deckID (Verse authorIdMsig body) (AP.Offer object uTarget) = do
-- Insert the Offer to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
for mractid $ \ offerDB -> do
for mractid $ \ (inboxItemID, offerDB) -> do
-- If a capability is provided, check it
for_ maybeCapability $ \ cap -> do
@ -418,17 +418,17 @@ deckOffer now deckID (Verse authorIdMsig body) (AP.Offer object uTarget) = do
let recipByKey = LocalActorDeck deckID
_luAccept <- lift $ updateOutboxItem' recipByKey acceptID actionAccept
return (deckActor deckRecip, sieve, acceptID, accept)
return (deckActor deckRecip, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (deckActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (deckActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorDeck deckID) deckActorID sieve
lift $ sendActivity
(LocalActorDeck deckID) deckActorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done "Opened a ticket and forwarded the Offer"
doneDB inboxItemID "Opened a ticket and forwarded the Offer"
where
@ -572,7 +572,7 @@ deckResolve now deckID (Verse authorIdMsig body) (AP.Resolve uObject) = do
-- Insert the Resolve to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
for mractid $ \ resolveDB -> do
for mractid $ \ (inboxItemID, resolveDB) -> do
{-
-- Verify the sender is authorized by the tracker to resolve a ticket
@ -600,17 +600,17 @@ deckResolve now deckID (Verse authorIdMsig body) (AP.Resolve uObject) = do
let recipByKey = LocalActorDeck deckID
_luAccept <- lift $ updateOutboxItem' recipByKey acceptID actionAccept
return (deckActor deckRecip, sieve, acceptID, accept)
return (deckActor deckRecip, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (deckActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (deckActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorDeck deckID) deckActorID sieve
lift $ sendActivity
(LocalActorDeck deckID) deckActorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done "Resolved ticket and forwarded the Resolve"
doneDB inboxItemID "Resolved ticket and forwarded the Resolve"
where
@ -913,7 +913,7 @@ deckUndo now recipDeckID (Verse authorIdMsig body) (AP.Undo uObject) = do
-- Insert the Undo to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
for mractid $ \ _undoDB -> do
for mractid $ \ (inboxItemID, _undoDB) -> do
maybeUndo <- runMaybeT $ do
@ -936,17 +936,17 @@ deckUndo now recipDeckID (Verse authorIdMsig body) (AP.Undo uObject) = do
accept@(actionAccept, _, _, _) <- lift $ lift $ prepareAccept audience
_luAccept <- lift $ updateOutboxItem' (LocalActorDeck recipDeckID) acceptID actionAccept
return (deckActor deckRecip, sieve, acceptID, accept)
return (deckActor deckRecip, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorDeck recipDeckID) actorID sieve
lift $ sendActivity
(LocalActorDeck recipDeckID) actorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done
doneDB inboxItemID
"Undid the Follow/Resolve, forwarded the Undo and published \
\Accept"

View file

@ -192,7 +192,7 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do
verifyNothingE maybeEnabled "I already sent a Grant for this Invite/Join"
maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
for maybeAcceptDB $ \ acceptDB -> do
for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do
(grantID, enableID) <- do
@ -235,18 +235,18 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do
_luGrant <- updateOutboxItem' recipByKey grantID actionGrant
return $ Just (grantID, grant)
return (recipActorID, sieve, maybeGrant)
return (recipActorID, sieve, maybeGrant, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, sieve, maybeGrant) -> do
Just (recipActorID, sieve, maybeGrant, inboxItemID) -> do
let recipByID = LocalActorGroup groupID
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $ for_ maybeGrant $ \ (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) ->
sendActivity
recipByID recipActorID localRecipsGrant
remoteRecipsGrant fwdHostsGrant grantID actionGrant
done "Forwarded the Accept and maybe published a Grant"
doneDB inboxItemID "Forwarded the Accept and maybe published a Grant"
where
@ -545,7 +545,7 @@ groupGrant now groupID (Verse authorIdMsig body) grant = do
verifyNothingE maybeDeleg "I already have a delegator-Grant from this collaborator"
maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
for maybeGrantDB $ \ grantDB -> do
for maybeGrantDB $ \ (inboxItemID, grantDB) -> do
-- Record the delegator-Grant in the Collab record
lift $ case (grantDB, bimap entityKey entityKey recip) of
@ -563,11 +563,11 @@ groupGrant now groupID (Verse authorIdMsig body) grant = do
-- delegation-extension Grant
extensions <- lift $ pure []
return (recipActorID, sieve, extensions)
return (recipActorID, sieve, extensions, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, sieve, extensions) -> do
Just (recipActorID, sieve, extensions, inboxItemID) -> do
let recipByID = LocalActorGroup groupID
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $ for_ extensions $
@ -575,7 +575,7 @@ groupGrant now groupID (Verse authorIdMsig body) grant = do
sendActivity
recipByID recipActorID localRecipsExt
remoteRecipsExt fwdHostsExt extID actionExt
done "Forwarded the delegator-Grant, updated DB"
doneDB inboxItemID "Forwarded the delegator-Grant, updated DB"
-- Meaning: An actor A invited actor B to a resource
-- Behavior:
@ -670,7 +670,7 @@ groupInvite now groupID (Verse authorIdMsig body) invite = do
_ -> error "Multiple collabs found for target"
maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False
lift $ for maybeInviteDB $ \ inviteDB -> do
lift $ for maybeInviteDB $ \ (inboxItemID, inviteDB) -> do
-- Insert Collab or Component record to DB
acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now
@ -685,17 +685,17 @@ groupInvite now groupID (Verse authorIdMsig body) invite = do
accept@(actionAccept, _, _, _) <- prepareAccept invitedDB
_luAccept <- updateOutboxItem' (LocalActorGroup groupID) acceptID actionAccept
return (topicActorID, sieve, acceptID, accept)
return (topicActorID, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (groupActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (groupActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorGroup groupID) groupActorID sieve
lift $ sendActivity
(LocalActorGroup groupID) groupActorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done "Recorded and forwarded the Invite, sent an Accept"
doneDB inboxItemID "Recorded and forwarded the Invite, sent an Accept"
where
@ -875,7 +875,7 @@ groupUndo now recipGroupID (Verse authorIdMsig body) (AP.Undo uObject) = do
-- Insert the Undo to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
for mractid $ \ _undoDB -> do
for mractid $ \ (inboxItemID, _undoDB) -> do
maybeUndo <- runMaybeT $ do
@ -897,17 +897,17 @@ groupUndo now recipGroupID (Verse authorIdMsig body) (AP.Undo uObject) = do
accept@(actionAccept, _, _, _) <- lift $ lift $ prepareAccept audience
_luAccept <- lift $ updateOutboxItem' (LocalActorGroup recipGroupID) acceptID actionAccept
return (groupActor groupRecip, sieve, acceptID, accept)
return (groupActor groupRecip, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorGroup recipGroupID) actorID sieve
lift $ sendActivity
(LocalActorGroup recipGroupID) actorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done
doneDB inboxItemID
"Undid the Follow, forwarded the Undo and published Accept"
where

View file

@ -268,7 +268,7 @@ loomOffer now loomID (Verse authorIdMsig body) (AP.Offer object uTarget) = do
-- Insert the Offer to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
for mractid $ \ offerDB -> do
for mractid $ \ (inboxItemID, offerDB) -> do
-- If a capability is provided, check it
for_ maybeCapability $ \ cap -> do
@ -312,18 +312,18 @@ loomOffer now loomID (Verse authorIdMsig body) (AP.Offer object uTarget) = do
let recipByKey = LocalActorLoom loomID
_luAccept <- lift $ updateOutboxItem' recipByKey acceptID actionAccept
return (loomActor loomRecip, sieve, acceptID, accept, maybePull)
return (loomActor loomRecip, sieve, acceptID, accept, maybePull, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (loomActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), maybePull) -> do
Just (loomActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), maybePull, inboxItemID) -> do
traverse_ generatePatches maybePull
forwardActivity
authorIdMsig body (LocalActorLoom loomID) loomActorID sieve
lift $ sendActivity
(LocalActorLoom loomID) loomActorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done "Opened a MR and forwarded the Offer"
doneDB inboxItemID "Opened a MR and forwarded the Offer"
where
@ -479,7 +479,7 @@ loomResolve now loomID (Verse authorIdMsig body) (AP.Resolve uObject) = do
-- Insert the Resolve to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
for mractid $ \ resolveDB -> do
for mractid $ \ (inboxItemID, resolveDB) -> do
-- Verify the sender is authorized by the tracker to resolve a ticket
verifyCapability'
@ -505,17 +505,17 @@ loomResolve now loomID (Verse authorIdMsig body) (AP.Resolve uObject) = do
let recipByKey = LocalActorLoom loomID
_luAccept <- lift $ updateOutboxItem' recipByKey acceptID actionAccept
return (loomActor loomRecip, sieve, acceptID, accept)
return (loomActor loomRecip, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (loomActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (loomActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorLoom loomID) loomActorID sieve
lift $ sendActivity
(LocalActorLoom loomID) loomActorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done "Resolved ticket and forwarded the Resolve"
doneDB inboxItemID "Resolved ticket and forwarded the Resolve"
where

View file

@ -110,12 +110,13 @@ personOffer now recipPersonID (Verse authorIdMsig body) (AP.Offer object uTarget
(p,) <$> getJust (personActor p)
maybeOfferDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
for maybeOfferDB $ \ _offerDB ->
return $ personActor personRecip
for maybeOfferDB $ \ (inboxItemID, _offerDB) ->
return (personActor personRecip, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just _actorID -> done "Inserted this Offer to my inbox"
Just (_actorID, inboxItemID) ->
doneDB inboxItemID "Inserted this Offer to my inbox"
-- Meaning: Someone has asked to resolve a ticket/MR
-- Behavior:
@ -136,12 +137,13 @@ personResolve now recipPersonID (Verse authorIdMsig body) (AP.Resolve uObject) =
(p,) <$> getJust (personActor p)
maybeResolveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
for maybeResolveDB $ \ _resolveDB ->
return $ personActor personRecip
for maybeResolveDB $ \ (inboxItemID, _resolveDB) ->
return (personActor personRecip, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just _actorID -> done "Inserted this Resolve to my inbox"
Just (_actorID, inboxItemID) ->
doneDB inboxItemID "Inserted this Resolve to my inbox"
------------------------------------------------------------------------------
-- Following
@ -203,7 +205,7 @@ personUndo now recipPersonID (Verse authorIdMsig body) (AP.Undo uObject) = do
-- Insert the Undo to person's inbox
maybeUndoDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
for maybeUndoDB $ \ undoDB -> do
for maybeUndoDB $ \ (inboxItemID, undoDB) -> (inboxItemID,) <$> do
maybeUndo <- runMaybeT $ do
@ -224,12 +226,14 @@ personUndo now recipPersonID (Verse authorIdMsig body) (AP.Undo uObject) = do
case maybeUndo of
Nothing -> done "I already have this activity in my inbox"
Just Nothing -> done "Unrelated to me, just inserted to inbox"
Just (Just (actorID, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept))) -> do
lift $ sendActivity
(LocalActorPerson recipPersonID) actorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done "Undid the Follow and published Accept"
Just (inboxItemID, result) ->
case result of
Nothing -> doneDB inboxItemID "Unrelated to me, just inserted to inbox"
Just (actorID, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
lift $ sendActivity
(LocalActorPerson recipPersonID) actorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
doneDB inboxItemID "Undid the Follow and published Accept"
where
@ -304,7 +308,7 @@ personAccept now recipPersonID (Verse authorIdMsig body) accept = do
(p,) <$> getJust (personActor p)
maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
for maybeAcceptDB $ \ acceptDB -> runMaybeT $ do
for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> fmap (inboxItemID,) $ runMaybeT $ do
-- Find the accepted activity in our DB
accepteeDB <- MaybeT $ getActivity acceptee
@ -315,16 +319,18 @@ personAccept now recipPersonID (Verse authorIdMsig body) accept = do
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just Nothing -> done "Not my Follow/Invite; Just inserted to my inbox"
Just (Just (Left ())) ->
done "Recorded this Accept on the Follow request I sent"
Just (Just (Right (actorID, sieve))) -> do
forwardActivity
authorIdMsig body (LocalActorPerson recipPersonID)
actorID sieve
done
"Recorded this Accept on the Invite I've had & \
\forwarded to my followers"
Just (inboxItemID, result) ->
case result of
Nothing -> doneDB inboxItemID "Not my Follow/Invite; Just inserted to my inbox"
Just (Left ()) ->
doneDB inboxItemID "Recorded this Accept on the Follow request I sent"
Just (Right (actorID, sieve)) -> do
forwardActivity
authorIdMsig body (LocalActorPerson recipPersonID)
actorID sieve
doneDB inboxItemID
"Recorded this Accept on the Invite I've had & \
\forwarded to my followers"
where
@ -452,7 +458,7 @@ personReject now recipPersonID (Verse authorIdMsig body) reject = do
(p,) <$> getJust (personActor p)
maybeRejectDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
for maybeRejectDB $ \ _rejectDB -> runMaybeT $ do
for maybeRejectDB $ \ (inboxItemID, _rejectDB) -> fmap (inboxItemID,) $ runMaybeT $ do
-- Find the rejected activity in our DB
rejecteeDB <- MaybeT $ getActivity rejectee
@ -461,9 +467,9 @@ personReject now recipPersonID (Verse authorIdMsig body) reject = do
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just Nothing -> done "Not my Follow; Just inserted to my inbox"
Just (Just ()) ->
done "Recorded this Reject on the Follow request I sent"
Just (inboxItemID, Nothing) -> doneDB inboxItemID "Not my Follow; Just inserted to my inbox"
Just (inboxItemID, Just ()) ->
doneDB inboxItemID "Recorded this Reject on the Follow request I sent"
where
@ -540,10 +546,9 @@ personCreateNote now recipPersonID (Verse authorIdMsig body) note = do
_ <- traverse (getMessageParent did) maybeParent
lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) True
done $
case mractid of
Nothing -> "I already have this activity in my inbox, doing nothing"
Just _ -> "Inserted Create{Note} to my inbox"
case mractid of
Nothing -> done "I already have this activity in my inbox, doing nothing"
Just (inboxItemID, _) -> doneDB inboxItemID "Inserted Create{Note} to my inbox"
where
checkContextParent (ObjURI hContext luContext) mparent = do
mdid <- lift $ runMaybeT $ do
@ -595,12 +600,12 @@ personAdd now recipPersonID (Verse authorIdMsig body) add = do
(p,) <$> getJust (personActor p)
maybeAddDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
for maybeAddDB $ \ _addDB ->
return $ personActor personRecip
for maybeAddDB $ \ (inboxItemID, _addDB) ->
return (personActor personRecip, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just _actorID -> done "Inserted this Add to my inbox"
Just (_actorID, inboxItemID) -> doneDB inboxItemID "Inserted this Add to my inbox"
-- Meaning: Someone invited someone to a resource
-- Behavior:
@ -670,7 +675,7 @@ personInvite now recipPersonID (Verse authorIdMsig body) invite = do
(p,) <$> getJust (personActor p)
maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
for maybeInviteDB $ \ inviteDB -> do
for maybeInviteDB $ \ (inboxItemID, inviteDB) -> do
maybePermit <- for maybeRoleAndResourceDB $ \ (role, resourceDB) -> do
@ -690,18 +695,18 @@ personInvite now recipPersonID (Verse authorIdMsig body) invite = do
return sieve
return (personActor personRecip, maybePermit)
return (personActor personRecip, maybePermit, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (actorID, maybePermit) ->
Just (actorID, maybePermit, inboxItemID) ->
case maybePermit of
Nothing -> done "I'm not the target; Inserted to inbox"
Nothing -> doneDB inboxItemID "I'm not the target; Inserted to inbox"
Just sieve -> do
forwardActivity
authorIdMsig body (LocalActorPerson recipPersonID)
actorID sieve
done
doneDB inboxItemID
"I'm the target; Inserted to inbox; Inserted Permit; \
\Forwarded to followers if addressed"
@ -746,18 +751,18 @@ personRemove now recipPersonID (Verse authorIdMsig body) remove = do
(p,) <$> getJust (personActor p)
maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
for maybeRemoveDB $ \ _removeDB ->
return $ personActor personRecip
for maybeRemoveDB $ \ (inboxItemID, _removeDB) ->
return (personActor personRecip, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just actorID -> do
Just (actorID, inboxItemID) -> do
let memberIsMe =
case memberOrComp of
Left (LocalActorPerson p) -> p == recipPersonID
_ -> False
if not memberIsMe
then done "I'm not the member; Inserted to inbox"
then doneDB inboxItemID "I'm not the member; Inserted to inbox"
else do
recipHash <- encodeKeyHashid recipPersonID
let sieve =
@ -767,7 +772,7 @@ personRemove now recipPersonID (Verse authorIdMsig body) remove = do
forwardActivity
authorIdMsig body (LocalActorPerson recipPersonID)
actorID sieve
done
doneDB inboxItemID
"I'm the member; Inserted to inbox; \
\Forwarded to followers if addressed"
@ -795,7 +800,7 @@ personJoin now recipPersonID (Verse authorIdMsig body) join = do
case maybeJoinID of
Nothing -> done "I already have this activity in my inbox"
Just _joinID -> done "Inserted to my inbox"
Just (inboxItemID, _joinID) -> doneDB inboxItemID "Inserted to my inbox"
-- Meaning: An actor published a Grant
-- Behavior:
@ -980,8 +985,9 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do
)
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
for mractid $ \ grantDB -> do
for mractid $ \ (inboxItemID, grantDB) ->
fmap (inboxItemID,) $
for maybePermit $
bitraverse
(\ (gestureID, topic) -> lift $ do
@ -1056,17 +1062,19 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just Nothing -> done "Inserted Grant to my inbox"
Just (Just (Left (recipActorID, sieve, maybeDeleg))) -> do
let recipByID = LocalActorPerson recipPersonID
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $ for_ maybeDeleg $ \ (delegID, (actionDeleg, localRecipsDeleg, remoteRecipsDeleg, fwdHostsDeleg)) ->
sendActivity
recipByID recipActorID localRecipsDeleg
remoteRecipsDeleg fwdHostsDeleg delegID actionDeleg
done "Forwarded the direct-Grant, updated Permit, maybe published delegator-Grant"
Just (Just (Right ())) ->
done "Got an extension-Grant, updated Permit"
Just (inboxItemID, result) ->
case result of
Nothing -> doneDB inboxItemID "Inserted Grant to my inbox"
Just (Left (recipActorID, sieve, maybeDeleg)) -> do
let recipByID = LocalActorPerson recipPersonID
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $ for_ maybeDeleg $ \ (delegID, (actionDeleg, localRecipsDeleg, remoteRecipsDeleg, fwdHostsDeleg)) ->
sendActivity
recipByID recipActorID localRecipsDeleg
remoteRecipsDeleg fwdHostsDeleg delegID actionDeleg
doneDB inboxItemID "Forwarded the direct-Grant, updated Permit, maybe published delegator-Grant"
Just (Right ()) ->
doneDB inboxItemID "Got an extension-Grant, updated Permit"
where
@ -1224,7 +1232,7 @@ personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke lus) = do
found
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True
lift $ for mractid $ \ _revokeDB ->
lift $ for mractid $ \ (inboxItemID, _revokeDB) -> fmap (inboxItemID,) $
-- Delete revoked records from DB
for grantsDB $ traverse_ $
bitraverse_
@ -1278,7 +1286,7 @@ personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke lus) = do
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just _ -> done "Deleted any relevant Permit/Extend records"
Just (inboxItemID, _) -> doneDB inboxItemID "Deleted any relevant Permit/Extend records"
where

View file

@ -544,7 +544,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
verifyNothingE maybeEnabled "I already sent a Grant for this Invite/Join"
maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
for maybeAcceptDB $ \ acceptDB -> do
for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do
-- Record the Accept and enable the Collab
(grantID, enableID) <- do
@ -583,18 +583,18 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
let recipByKey = LocalActorProject projectID
_luGrant <- lift $ updateOutboxItem' recipByKey grantID actionGrant
return (recipActorID, sieve, grantID, grant)
return (recipActorID, sieve, grantID, grant, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, sieve, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) -> do
Just (recipActorID, sieve, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant), inboxItemID) -> do
let recipByID = LocalActorProject projectID
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $
sendActivity
recipByID recipActorID localRecipsGrant
remoteRecipsGrant fwdHostsGrant grantID actionGrant
done "[Collab mode] Forwarded the Accept and published a Grant"
doneDB inboxItemID "[Collab mode] Forwarded the Accept and published a Grant"
addComp (componentID, ident, inviteOrAdd) = do
@ -651,7 +651,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
verifyNothingE maybeEnabled "I already sent a delegator-Grant for this Invite/Add"
maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
for maybeAcceptDB $ \ acceptDB -> do
for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do
maybeGrantData <-
case comp of
@ -712,18 +712,18 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
_luGrant <- updateOutboxItem' recipByKey grantID actionGrant
return (grantID, grant)
return (recipActorID, sieve, maybeGrant)
return (recipActorID, sieve, maybeGrant, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, sieve, maybeGrant) -> do
Just (recipActorID, sieve, maybeGrant, inboxItemID) -> do
let recipByID = LocalActorProject projectID
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $ for_ maybeGrant $ \ (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) ->
sendActivity
recipByID recipActorID localRecipsGrant
remoteRecipsGrant fwdHostsGrant grantID actionGrant
done "[Component mode] Forwarded the Accept and maybe published a Grant"
doneDB inboxItemID "[Component mode] Forwarded the Accept and maybe published a Grant"
addChildParent cp = do
@ -836,7 +836,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
(actorID,) <$> getJust actorID
maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
for maybeAcceptDB $ \ acceptDB -> do
for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do
idsForGrant <-
bitraverse
@ -956,18 +956,18 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
_luAccept <- updateOutboxItem' recipByKey acceptID actionAccept
return (acceptID, accept)
return (recipActorID, sieve, maybeAct)
return (recipActorID, sieve, maybeAct, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, sieve, maybeGrant) -> do
Just (recipActorID, sieve, maybeGrant, inboxItemID) -> do
let recipByID = LocalActorProject projectID
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $ for_ maybeGrant $ \ (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) ->
sendActivity
recipByID recipActorID localRecipsGrant
remoteRecipsGrant fwdHostsGrant grantID actionGrant
done "[Child/Parent mode] Forwarded the Accept and maybe published a Grant/Accept"
doneDB inboxItemID "[Child/Parent mode] Forwarded the Accept and maybe published a Grant/Accept"
prepareCollabGrant isInvite sender role = do
encodeRouteHome <- getEncodeRouteHome
@ -1186,7 +1186,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
(p,) <$> getJust (projectActor p)
maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for maybeAcceptDB $ \ acceptDB -> do
lift $ for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do
-- Grab extension-Grants that I'm about to revoke
gathers <- selectList [SourceUsGatherSource ==. sendID] []
@ -1283,11 +1283,11 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
_luExt <- updateOutboxItem' recipByKey extID actionExt
return (extID, ext)
return (projectActor project, sieve, revokeID, revoke, revokes)
return (projectActor project, sieve, revokeID, revoke, revokes, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), revokes) -> do
Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), revokes, inboxItemID) -> do
let topicByID = LocalActorProject projectID
forwardActivity authorIdMsig body topicByID topicActorID sieve
lift $ do
@ -1298,7 +1298,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
sendActivity
topicByID topicActorID localRecipsExt
remoteRecipsExt fwdHostsExt extID actionExt
done "[Remove-Child mode] Deleted the Child/Source, forwarded Accept, sent Revokes"
doneDB inboxItemID "[Remove-Child mode] Deleted the Child/Source, forwarded Accept, sent Revokes"
where
@ -1627,16 +1627,16 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
-- Insert the Add to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for mractid $ \ addDB -> do
lift $ for mractid $ \ (inboxItemID, addDB) -> do
-- Create a Component record in DB
insertComponent componentDB addDB
return $ projectActor project
return (projectActor project, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just actorID -> do
Just (actorID, inboxItemID) -> do
projectHash <- encodeKeyHashid projectID
let sieve =
makeRecipientSet
@ -1644,7 +1644,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
[LocalStageProjectFollowers projectHash]
forwardActivity
authorIdMsig body (LocalActorProject projectID) actorID sieve
done
doneDB inboxItemID
"Recorded a Component record; Inserted the Add to inbox; \
\Forwarded to followers if addressed"
@ -1767,7 +1767,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
-- Insert the Add to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for mractid $ \ addDB -> do
lift $ for mractid $ \ (inboxItemID, addDB) -> do
-- Create a Source record in DB
acceptID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now
@ -1782,17 +1782,17 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
accept@(actionAccept, _, _, _) <- prepareAccept childDB
_luAccept <- updateOutboxItem' (LocalActorProject projectID) acceptID actionAccept
return (projectActor project, sieve, acceptID, accept)
return (projectActor project, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorProject projectID) projectActorID sieve
lift $ sendActivity
(LocalActorProject projectID) projectActorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done "Recorded a child-project-in-progress, forwarded the Add, sent an Accept"
doneDB inboxItemID "Recorded a child-project-in-progress, forwarded the Add, sent an Accept"
where
@ -1877,7 +1877,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
-- Insert the Add to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for mractid $ \ addDB -> do
lift $ for mractid $ \ (inboxItemID, addDB) -> do
-- Create a Dest record in DB
acceptID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now
@ -1892,17 +1892,17 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
accept@(actionAccept, _, _, _) <- prepareAccept parentDB
_luAccept <- updateOutboxItem' (LocalActorProject projectID) acceptID actionAccept
return (projectActor project, sieve, acceptID, accept)
return (projectActor project, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorProject projectID) projectActorID sieve
lift $ sendActivity
(LocalActorProject projectID) projectActorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done "Recorded a parent-project-in-progress, forwarded the Add, sent an Accept"
doneDB inboxItemID "Recorded a parent-project-in-progress, forwarded the Add, sent an Accept"
where
@ -1972,7 +1972,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
-- Insert the Add to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for mractid $ \ addDB -> do
lift $ for mractid $ \ (inboxItemID, addDB) -> do
-- Create a Source record in DB
insertSource childDB' addDB
@ -1982,14 +1982,14 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
projectHash <- encodeKeyHashid projectID
return $ makeRecipientSet [] [LocalStageProjectFollowers projectHash]
return (projectActor project, sieve)
return (projectActor project, sieve, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (projectActorID, sieve) -> do
Just (projectActorID, sieve, inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorProject projectID) projectActorID sieve
done "Recorded a child-project-in-progress, forwarded the Add"
doneDB inboxItemID "Recorded a child-project-in-progress, forwarded the Add"
where
@ -2057,7 +2057,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
-- Insert the Add to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for mractid $ \ addDB -> do
lift $ for mractid $ \ (inboxItemID, addDB) -> do
-- Create a Dest record in DB
insertDest parentDB' addDB
@ -2067,14 +2067,14 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
projectHash <- encodeKeyHashid projectID
return $ makeRecipientSet [] [LocalStageProjectFollowers projectHash]
return (projectActor project, sieve)
return (projectActor project, sieve, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (projectActorID, sieve) -> do
Just (projectActorID, sieve, inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorProject projectID) projectActorID sieve
done "Recorded a parent-project-in-progress, forwarded the Add"
doneDB inboxItemID "Recorded a parent-project-in-progress, forwarded the Add"
where
@ -2359,7 +2359,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
verifyNothingE maybeDeleg "I already have a delegation-start Grant from this component"
maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
for maybeGrantDB $ \ grantDB -> do
for maybeGrantDB $ \ (inboxItemID, grantDB) -> do
-- Record the delegation in DB
lift $ case (grantDB, bimap fst fst ident) of
@ -2470,11 +2470,12 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
, sieve
, localExtensions ++ localExtensionsForParents
, remoteExtensions ++ remoteExtensionsForParents
, inboxItemID
)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, sieve, localExts, remoteExts) -> do
Just (recipActorID, sieve, localExts, remoteExts, inboxItemID) -> do
let recipByID = LocalActorProject projectID
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $ for_ (localExts ++ remoteExts) $
@ -2482,7 +2483,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
sendActivity
recipByID recipActorID localRecipsExt
remoteRecipsExt fwdHostsExt extID actionExt
done "Forwarded the start-Grant and published delegation extensions"
doneDB inboxItemID "Forwarded the start-Grant and published delegation extensions"
where
@ -2657,7 +2658,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
verifyNothingE maybeDeleg "I already have a delegator-Grant from this collaborator"
maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
for maybeGrantDB $ \ grantDB -> do
for maybeGrantDB $ \ (inboxItemID, grantDB) -> do
-- Record the delegator-Grant in the Collab record
(insertExt, insertLeaf, uDeleg) <-
@ -2800,11 +2801,11 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
return $ fromComponents ++ fromChildren
return (recipActorID, sieve, extensions)
return (recipActorID, sieve, extensions, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, sieve, extensions) -> do
Just (recipActorID, sieve, extensions, inboxItemID) -> do
let recipByID = LocalActorProject projectID
forwardActivity authorIdMsig body recipByID recipActorID sieve
lift $ for_ extensions $
@ -2812,7 +2813,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
sendActivity
recipByID recipActorID localRecipsExt
remoteRecipsExt fwdHostsExt extID actionExt
done "Forwarded the delegator-Grant, updated DB and published delegation extensions"
doneDB inboxItemID "Forwarded the delegator-Grant, updated DB and published delegation extensions"
where
@ -2964,7 +2965,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
topic
maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
for maybeGrantDB $ \ grantDB -> do
for maybeGrantDB $ \ (inboxItemID, grantDB) -> do
-- Record the delegation in DB
from <- case (grantDB, bimap (view _3) (view _3) topicWithAccept) of
@ -3090,18 +3091,19 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
( recipActorID
, localExtensions ++ localExtensionsForParents
, remoteExtensions ++ remoteExtensionsForParents
, inboxItemID
)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, localExts, remoteExts) -> do
Just (recipActorID, localExts, remoteExts, inboxItemID) -> do
let recipByID = LocalActorProject projectID
lift $ for_ (localExts ++ remoteExts) $
\ (extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt)) ->
sendActivity
recipByID recipActorID localRecipsExt
remoteRecipsExt fwdHostsExt extID actionExt
done "Sent extensions to collabs & parents"
doneDB inboxItemID "Sent extensions to collabs & parents"
where
@ -3303,7 +3305,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
(actorID,) <$> getJust actorID
maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
for maybeGrantDB $ \ grantDB -> do
for maybeGrantDB $ \ (inboxItemID, grantDB) -> do
-- Record the delegator-Grant in DB
to <- case (grantDB, bimap fst fst topic) of
@ -3439,18 +3441,19 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do
return
( recipActorID
, (startID, start) : localExtensions ++ remoteExtensions ++ fromChildren
, inboxItemID
)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (recipActorID, exts) -> do
Just (recipActorID, exts, inboxItemID) -> do
let recipByID = LocalActorProject projectID
lift $ for_ exts $
\ (extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt)) ->
sendActivity
recipByID recipActorID localRecipsExt
remoteRecipsExt fwdHostsExt extID actionExt
done "Sent start-Grant and extensions from components and children"
doneDB inboxItemID "Sent start-Grant and extensions from components and children"
where
@ -3717,7 +3720,7 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
Right component -> checkExistingComponents projectID component
maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False
lift $ for maybeInviteDB $ \ inviteDB -> do
lift $ for maybeInviteDB $ \ (inboxItemID, inviteDB) -> do
-- Insert Collab or Component record to DB
acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now
@ -3734,17 +3737,17 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
accept@(actionAccept, _, _, _) <- prepareAccept invitedDB
_luAccept <- updateOutboxItem' (LocalActorProject projectID) acceptID actionAccept
return (topicActorID, sieve, acceptID, accept)
return (topicActorID, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorProject projectID) projectActorID sieve
lift $ sendActivity
(LocalActorProject projectID) projectActorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done "Recorded and forwarded the Invite, sent an Accept"
doneDB inboxItemID "Recorded and forwarded the Invite, sent an Accept"
where
@ -4075,7 +4078,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
throwE "No other admins exist, can't remove"
maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False
lift $ for maybeRemoveDB $ \ _removeDB -> do
lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do
-- Delete the whole Collab record
deleteBy $ UniqueCollabDelegLocal enableID
@ -4123,17 +4126,17 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
revokeID <- insertEmptyOutboxItem' (actorOutbox topicActor) now
_luRevoke <- updateOutboxItem' recipByKey revokeID actionRevoke
return (topicActorID, sieve, revokeID, revoke)
return (topicActorID, sieve, revokeID, revoke, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke)) -> do
Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), inboxItemID) -> do
let topicByID = LocalActorProject projectID
forwardActivity authorIdMsig body topicByID topicActorID sieve
lift $ sendActivity
topicByID topicActorID localRecipsRevoke
remoteRecipsRevoke fwdHostsRevoke revokeID actionRevoke
done "Deleted the Grant/Collab, forwarded Remove, sent Revoke"
doneDB inboxItemID "Deleted the Grant/Collab, forwarded Remove, sent Revoke"
where
@ -4271,7 +4274,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
verifySingleE sources "No source" "Multiple sources"
maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for maybeRemoveDB $ \ _removeDB -> do
lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do
-- Grab extension-Grants that I'm about to revoke
gathers <- selectList [SourceUsGatherSource ==. sendID] []
@ -4364,11 +4367,11 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
_luExt <- updateOutboxItem' recipByKey extID actionExt
return (extID, ext)
return (projectActor project, sieve, revokeID, revoke, revokes)
return (projectActor project, sieve, revokeID, revoke, revokes, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), revokes) -> do
Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), revokes, inboxItemID) -> do
let topicByID = LocalActorProject projectID
forwardActivity authorIdMsig body topicByID topicActorID sieve
lift $ do
@ -4379,7 +4382,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
sendActivity
topicByID topicActorID localRecipsExt
remoteRecipsExt fwdHostsExt extID actionExt
done "Deleted the Child/Source, forwarded Remove, sent Revokes"
doneDB inboxItemID "Deleted the Child/Source, forwarded Remove, sent Revokes"
where
@ -4560,7 +4563,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
verifySingleE dests "No dest" "Multiple dests"
maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for maybeRemoveDB $ \ _removeDB -> do
lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do
-- Delete uses of this Dest from my Component records
deleteWhere [ComponentGatherParent ==. destStartID]
@ -4612,18 +4615,18 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
acceptID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now
_luAccept <- updateOutboxItem' recipByKey acceptID actionAccept
return (projectActor project, sieve, acceptID, accept)
return (projectActor project, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> 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"
doneDB inboxItemID "Deleted the Parent/Dest, forwarded Remove, sent Accept"
where
@ -4738,7 +4741,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
(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
maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for maybeRemoveDB $ \ (removeID, _) -> do
-- Record the removal attempt
@ -4751,14 +4754,14 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
LocalActorProject topicHash
return $ makeRecipientSet [] [localActorFollowers topicByHash]
return (projectActor project, sieve)
return (projectActor project, sieve, removeID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, sieve) -> do
Just (topicActorID, sieve, inboxItemID) -> do
let topicByID = LocalActorProject projectID
forwardActivity authorIdMsig body topicByID topicActorID sieve
done "Recorded removal attempt, forwarded Remove"
doneDB inboxItemID "Recorded removal attempt, forwarded Remove"
removeParentPassive parent = do
@ -4838,14 +4841,14 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do
verifySingleE dests "No dest" "Multiple dests"
maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for maybeRemoveDB $ \ _removeDB -> do
lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do
return ()
return inboxItemID
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just () ->
done "Saw the removal attempt, just waiting for the Revoke"
Just inboxItemID ->
doneDB inboxItemID "Saw the removal attempt, just waiting for the Revoke"
-- Meaning: An actor is revoking Grant activities
-- Behavior:
@ -4972,7 +4975,7 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus
(p,) <$> getJust (projectActor p)
maybeRevokeDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for maybeRevokeDB $ \ _revokeDB -> do
lift $ for maybeRevokeDB $ \ (inboxItemID, _revokeDB) -> do
maybeStartID <- getKeyBy $ UniqueDestUsStart usAcceptID
@ -5030,18 +5033,18 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus
acceptID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now
_luAccept <- updateOutboxItem' recipByKey acceptID actionAccept
return (projectActor project, sieve, acceptID, accept)
return (projectActor project, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> 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 Revoke, sent Accept"
doneDB inboxItemID "Deleted the Parent/Dest, forwarded Revoke, sent Accept"
where
@ -5088,7 +5091,7 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus
(p,) <$> getJust (projectActor p)
maybeRevokeDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
lift $ for maybeRevokeDB $ \ _revokeDB -> do
lift $ for maybeRevokeDB $ \ (inboxItemID, _revokeDB) -> do
-- Collect the extensions I'll need to revoke
gatherIDs <-
@ -5154,17 +5157,17 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus
_luExt <- updateOutboxItem' recipByKey extID actionExt
return (extID, ext)
return (projectActor project, revokes)
return (projectActor project, revokes, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, revokes) -> do
Just (topicActorID, revokes, inboxItemID) -> do
let topicByID = LocalActorProject projectID
lift $ for_ revokes $ \ (extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt)) ->
sendActivity
topicByID topicActorID localRecipsExt
remoteRecipsExt fwdHostsExt extID actionExt
done "Deleted the SourceThemDelegate* record, sent Revokes"
doneDB inboxItemID "Deleted the SourceThemDelegate* record, sent Revokes"
where
@ -5244,7 +5247,7 @@ projectUndo now recipProjectID (Verse authorIdMsig body) (AP.Undo uObject) = do
-- Insert the Undo to my inbox
mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False
for mractid $ \ _undoDB -> do
for mractid $ \ (inboxItemID, _undoDB) -> do
maybeUndo <- runMaybeT $ do
@ -5266,17 +5269,17 @@ projectUndo now recipProjectID (Verse authorIdMsig body) (AP.Undo uObject) = do
accept@(actionAccept, _, _, _) <- lift $ lift $ prepareAccept audience
_luAccept <- lift $ updateOutboxItem' (LocalActorProject recipProjectID) acceptID actionAccept
return (projectActor projectRecip, sieve, acceptID, accept)
return (projectActor projectRecip, sieve, acceptID, accept, inboxItemID)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do
Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do
forwardActivity
authorIdMsig body (LocalActorProject recipProjectID) actorID sieve
lift $ sendActivity
(LocalActorProject recipProjectID) actorID localRecipsAccept
remoteRecipsAccept fwdHostsAccept acceptID actionAccept
done
doneDB inboxItemID
"Undid the Follow, forwarded the Undo and published Accept"
where

View file

@ -15,7 +15,6 @@
module Vervis.Federation.Util
( insertToInbox
, insertToInbox'
)
where
@ -39,7 +38,7 @@ 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'
insertToInbox
:: UTCTime
-> Either
(LocalActorBy Key, ActorId, OutboxItemId)
@ -55,15 +54,15 @@ insertToInbox'
(RemoteAuthor, LocalURI, RemoteActivityId)
)
)
insertToInbox' now (Left a@(_, _, outboxItemID)) _body inboxID unread = do
inboxItemID <- insert $ InboxItem unread now
insertToInbox now (Left a@(_, _, outboxItemID)) _body inboxID unread = do
inboxItemID <- insert $ InboxItem unread now "No result yet"
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
insertToInbox now (Right (author, luAct, _)) body inboxID unread = do
let iidAuthor = remoteAuthorInstance author
roid <-
either entityKey id <$> insertBy' (RemoteObject iidAuthor luAct)
@ -72,28 +71,10 @@ insertToInbox' now (Right (author, luAct, _)) body inboxID unread = do
, remoteActivityContent = persistJSONFromBL $ actbBL body
, remoteActivityReceived = now
}
ibiid <- insert $ InboxItem unread now
ibiid <- insert $ InboxItem unread now "No result yet"
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
(LocalActorBy Key, ActorId, OutboxItemId)
(RemoteAuthor, LocalURI, Maybe ByteString)
-> ActivityBody
-> InboxId
-> Bool
-> ActDB
(Maybe
(Either
(LocalActorBy Key, ActorId, OutboxItemId)
(RemoteAuthor, LocalURI, RemoteActivityId)
)
)
insertToInbox now act body inbox unread =
fmap snd <$> insertToInbox' now act body inbox unread

View file

@ -3242,21 +3242,21 @@ changes hLocal ctx =
, addFieldRefRequiredEmpty "SourceUsGather" "destNew" "DestUsStart"
-- 586
, removeField "SourceUsGather" "dest"
-- 586
, renameField "SourceUsGather" "destNew" "dest"
-- 587
, removeEntity "SourceUsGatherToLocal"
, renameField "SourceUsGather" "destNew" "dest"
-- 588
, removeEntity "SourceUsGatherToRemote"
, removeEntity "SourceUsGatherToLocal"
-- 589
, removeEntity "ComponentGatherLocal"
, removeEntity "SourceUsGatherToRemote"
-- 590
, removeEntity "ComponentGatherRemote"
, removeEntity "ComponentGatherLocal"
-- 591
, addEntities model_591_component_gather
, removeEntity "ComponentGatherRemote"
-- 592
, addEntities model_592_permit_extend
, addEntities model_591_component_gather
-- 593
, addEntities model_592_permit_extend
-- 594
, addFieldRefRequired''
"PermitTopicExtendLocal"
(do permitID <- do
@ -3291,7 +3291,7 @@ changes hLocal ctx =
)
"permitNew"
"PermitTopicExtend"
-- 594
-- 595
, addFieldRefRequired''
"PermitTopicExtendRemote"
(do let doc = persistJSONObjectFromDoc $ Doc hLocal emptyActivity
@ -3326,25 +3326,25 @@ changes hLocal ctx =
)
"permitNew"
"PermitTopicExtend"
-- 595
, removeField "PermitTopicExtendLocal" "permit"
-- 596
, removeField "PermitTopicExtendRemote" "permit"
, removeField "PermitTopicExtendLocal" "permit"
-- 597
, renameField "PermitTopicExtendLocal" "permitNew" "permit"
, removeField "PermitTopicExtendRemote" "permit"
-- 598
, renameField "PermitTopicExtendRemote" "permitNew" "permit"
, renameField "PermitTopicExtendLocal" "permitNew" "permit"
-- 599
, addUnique' "PermitTopicExtendLocal" "" ["permit"]
, renameField "PermitTopicExtendRemote" "permitNew" "permit"
-- 600
, addUnique' "PermitTopicExtendRemote" "" ["permit"]
, addUnique' "PermitTopicExtendLocal" "" ["permit"]
-- 601
, addEntities model_601_permit_extend_resource
, addUnique' "PermitTopicExtendRemote" "" ["permit"]
-- 602
, addFieldPrimRequired "PermitTopicExtend" ("RoleAdmin" :: String) "role"
, addEntities model_601_permit_extend_resource
-- 603
, addEntities model_603_resource
, addFieldPrimRequired "PermitTopicExtend" ("RoleAdmin" :: String) "role"
-- 604
, addEntities model_603_resource
-- 605
, addFieldRefRequired''
"Repo"
(do inboxID <- insert Inbox604
@ -3368,7 +3368,7 @@ changes hLocal ctx =
)
"resource"
"Resource"
-- 605
-- 606
, addFieldRefRequired''
"Deck"
(do inboxID <- insert Inbox604
@ -3392,7 +3392,7 @@ changes hLocal ctx =
)
"resource"
"Resource"
-- 606
-- 607
, addFieldRefRequired''
"Loom"
(do inboxID <- insert Inbox604
@ -3416,7 +3416,7 @@ changes hLocal ctx =
)
"resource"
"Resource"
-- 607
-- 608
, addFieldRefRequired''
"Project"
(do inboxID <- insert Inbox604
@ -3440,7 +3440,7 @@ changes hLocal ctx =
)
"resource"
"Resource"
-- 608
-- 609
, addFieldRefRequired''
"Group"
(do inboxID <- insert Inbox604
@ -3464,7 +3464,7 @@ changes hLocal ctx =
)
"resource"
"Resource"
-- 609
-- 610
, addFieldRefRequired''
"PermitTopicExtendResourceLocal"
(do inboxID <- insert Inbox604
@ -3488,9 +3488,9 @@ changes hLocal ctx =
)
"resource"
"Resource"
-- 610
, removeField "PermitTopicExtendResourceLocal" "actor"
-- 611
, removeField "PermitTopicExtendResourceLocal" "actor"
-- 612
, addFieldRefRequired''
"PermitTopicLocal"
(do inboxID <- insert Inbox611
@ -3536,17 +3536,17 @@ changes hLocal ctx =
)
"topic"
"Resource"
-- 612
, removeEntity "PermitTopicRepo"
-- 613
, removeEntity "PermitTopicDeck"
, removeEntity "PermitTopicRepo"
-- 614
, removeEntity "PermitTopicLoom"
, removeEntity "PermitTopicDeck"
-- 615
, removeEntity "PermitTopicProject"
, removeEntity "PermitTopicLoom"
-- 616
, removeEntity "PermitTopicGroup"
, removeEntity "PermitTopicProject"
-- 617
, removeEntity "PermitTopicGroup"
-- 618
, addFieldRefRequired''
"Collab"
(do inboxID <- insert Inbox611
@ -3592,16 +3592,18 @@ changes hLocal ctx =
)
"topic"
"Resource"
-- 618
, removeEntity "CollabTopicRepo"
-- 619
, removeEntity "CollabTopicDeck"
, removeEntity "CollabTopicRepo"
-- 620
, removeEntity "CollabTopicLoom"
, removeEntity "CollabTopicDeck"
-- 621
, removeEntity "CollabTopicProject"
, removeEntity "CollabTopicLoom"
-- 622
, removeEntity "CollabTopicProject"
-- 623
, removeEntity "CollabTopicGroup"
-- 624
, addFieldPrimRequired "InboxItem" T.empty "result"
]
migrateDB

View file

@ -37,6 +37,7 @@ module Vervis.Persist.Actor
, getRemoteActor
, getRemoteActorM
, getRemoteActorE
, doneDB
)
where
@ -315,3 +316,8 @@ getRemoteActorM (ObjURI h lu) = do
getRemoteActorE u e = do
ma <- lift $ getRemoteActor u
fromMaybeE ma e
doneDB :: InboxItemId -> Text -> VA.ActE (Text, VA.Act (), Next)
doneDB itemID msg = do
lift $ VA.withDB $ update itemID [InboxItemResult =. msg]
done msg

View file

@ -85,6 +85,7 @@ Inbox
InboxItem
unread Bool
received UTCTime
result Text
InboxItemLocal
inbox InboxId