forge/Vervis
1
0
Fork 0
Code Pull requests Activity

S2S, DB: Store processing result in InboxItem record

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/Vervis/API.hs
View file

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

74
src/Vervis/Actor/Common.hs
View file

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

32
src/Vervis/Actor/Deck.hs
View file

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

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

16
src/Vervis/Actor/Loom.hs
View file

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

98
src/Vervis/Actor/Person.hs
View file

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

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

29
src/Vervis/Federation/Util.hs
View file

@ -15,7 +15,6 @@
module Vervis.Federation.Util module Vervis.Federation.Util
( insertToInbox ( insertToInbox
, insertToInbox'
) )
where where
@ -39,7 +38,7 @@ import Vervis.Model
-- | Insert an activity delivered to us into our inbox. Return its -- | Insert an activity delivered to us into our inbox. Return its
-- database ID if the activity wasn't already in our inbox. -- database ID if the activity wasn't already in our inbox.
insertToInbox' insertToInbox
:: UTCTime :: UTCTime
-> Either -> Either
(LocalActorBy Key, ActorId, OutboxItemId) (LocalActorBy Key, ActorId, OutboxItemId)
@ -55,15 +54,15 @@ insertToInbox'
(RemoteAuthor, LocalURI, RemoteActivityId) (RemoteAuthor, LocalURI, RemoteActivityId)
) )
) )
insertToInbox' now (Left a@(_, _, outboxItemID)) _body inboxID unread = do insertToInbox now (Left a@(_, _, outboxItemID)) _body inboxID unread = do
inboxItemID <- insert $ InboxItem unread now inboxItemID <- insert $ InboxItem unread now "No result yet"
maybeItem <- insertUnique $ InboxItemLocal inboxID outboxItemID inboxItemID maybeItem <- insertUnique $ InboxItemLocal inboxID outboxItemID inboxItemID
case maybeItem of case maybeItem of
Nothing -> do Nothing -> do
delete inboxItemID delete inboxItemID
return Nothing return Nothing
Just _ -> return $ Just (inboxItemID, Left a) 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 let iidAuthor = remoteAuthorInstance author
roid <- roid <-
either entityKey id <$> insertBy' (RemoteObject iidAuthor luAct) either entityKey id <$> insertBy' (RemoteObject iidAuthor luAct)
@ -72,28 +71,10 @@ insertToInbox' now (Right (author, luAct, _)) body inboxID unread = do
, remoteActivityContent = persistJSONFromBL $ actbBL body , remoteActivityContent = persistJSONFromBL $ actbBL body
, remoteActivityReceived = now , remoteActivityReceived = now
} }
ibiid <- insert $ InboxItem unread now ibiid <- insert $ InboxItem unread now "No result yet"
mibrid <- insertUnique $ InboxItemRemote inboxID ractid ibiid mibrid <- insertUnique $ InboxItemRemote inboxID ractid ibiid
case mibrid of case mibrid of
Nothing -> do Nothing -> do
delete ibiid delete ibiid
return Nothing return Nothing
Just _ -> return $ Just (ibiid, Right (author, luAct, ractid)) 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

76
src/Vervis/Migration.hs
View file

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

6
src/Vervis/Persist/Actor.hs
View file

@ -37,6 +37,7 @@ module Vervis.Persist.Actor
, getRemoteActor , getRemoteActor
, getRemoteActorM , getRemoteActorM
, getRemoteActorE , getRemoteActorE
, doneDB
) )
where where
@ -315,3 +316,8 @@ getRemoteActorM (ObjURI h lu) = do
getRemoteActorE u e = do getRemoteActorE u e = do
ma <- lift $ getRemoteActor u ma <- lift $ getRemoteActor u
fromMaybeE ma e 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

1
th/models
View file

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