diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 532c1b0..6ec33fc 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -1087,9 +1087,9 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips -- Deliver the Follow and Accept by simply manually inserting them to -- loom and sender inboxes respectively lift $ do - ibiidF <- insert $ InboxItem False now + ibiidF <- insert $ InboxItem False now "Vervis.API" insert_ $ InboxItemLocal (actorInbox loomActor) obiidFollow ibiidF - ibiidA <- insert $ InboxItem False now + ibiidA <- insert $ InboxItem False now "Vervis.API" insert_ $ InboxItemLocal (actorInbox senderActor) obiidAccept ibiidA -- Return instructions for HTTP delivery to remote recipients @@ -1330,9 +1330,9 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r -- Deliver the Follow and Accept by simply manually inserting them to -- repo and sender inboxes respectively lift $ do - ibiidF <- insert $ InboxItem False now + ibiidF <- insert $ InboxItem False now "Vervis.API" insert_ $ InboxItemLocal (actorInbox repoActor) obiidFollow ibiidF - ibiidA <- insert $ InboxItem False now + ibiidA <- insert $ InboxItem False now "Vervis.API" insert_ $ InboxItemLocal (actorInbox senderActor) obiidAccept ibiidA -- Return instructions for HTTP delivery to remote recipients diff --git a/src/Vervis/Actor/Common.hs b/src/Vervis/Actor/Common.hs index 9da1354..522a7c3 100644 --- a/src/Vervis/Actor/Common.hs +++ b/src/Vervis/Actor/Common.hs @@ -127,7 +127,7 @@ actorFollow parseFollowee grabActor unread getFollowee getSieve makeLocalActor m -- Insert the Follow to my inbox maybeFollowDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) unread - for maybeFollowDB $ \ followDB -> do + for maybeFollowDB $ \ (inboxItemID, followDB) -> do -- Find followee in DB followerSetID <- getFollowee recipActor followee @@ -158,16 +158,16 @@ actorFollow parseFollowee grabActor unread getFollowee getSieve makeLocalActor m _luAccept <- lift $ updateOutboxItem' (makeLocalActor recipID) acceptID actionAccept sieve <- lift $ getSieve followee - return (recipActorID, acceptID, sieve, accept) + return (recipActorID, acceptID, sieve, accept, inboxItemID) case maybeFollow of Nothing -> done "I already have this activity in my inbox" - Just (actorID, acceptID, sieve, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (actorID, acceptID, sieve, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do forwardActivity authorIdMsig body (makeLocalActor recipID) actorID sieve lift $ sendActivity (makeLocalActor recipID) actorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Recorded Follow and published Accept" + doneDB inboxItemID "Recorded Follow and published Accept" where @@ -458,7 +458,7 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a verifyNothingE maybeEnabled "I already sent a Grant for this Invite/Join" maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - for maybeAcceptDB $ \ acceptDB -> do + for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do -- Record the Accept on the Collab case (idsForAccept, acceptDB) of @@ -501,17 +501,17 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a _luGrant <- lift $ updateOutboxItem' recipByKey grantID actionGrant return (grantID, grant) - return (recipActorID, sieve, grantInfo) + return (recipActorID, sieve, grantInfo, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, sieve, (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant))) -> do + Just (recipActorID, sieve, (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)), inboxItemID) -> do let recipByID = resourceToActor $ topicResource recipKey forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ sendActivity recipByID recipActorID localRecipsGrant remoteRecipsGrant fwdHostsGrant grantID actionGrant - done "Forwarded the Accept and published a Grant" + doneDB inboxItemID "Forwarded the Accept and published a Grant" prepareReact project inviter = do encodeRouteHome <- getEncodeRouteHome @@ -638,9 +638,9 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a stem maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - for maybeAcceptDB $ \ acceptDB -> + for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> - case idsForLater of + (inboxItemID,) <$> case idsForLater of Left (originInviteID, seen, inviter) -> do @@ -683,14 +683,14 @@ topicAccept grabResource topicComponent now recipKey (Verse authorIdMsig body) a case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just Nothing -> done "Done" - Just (Just (sieve, (reactID, (actionReact, localRecipsReact, remoteRecipsReact, fwdHostsReact)))) -> do + Just (inboxItemID, Nothing) -> doneDB inboxItemID "Done" + Just (inboxItemID, (Just (sieve, (reactID, (actionReact, localRecipsReact, remoteRecipsReact, fwdHostsReact))))) -> do let recipByID = resourceToActor $ topicResource recipKey forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ sendActivity recipByID recipActorID localRecipsReact remoteRecipsReact fwdHostsReact reactID actionReact - done "Forwarded the Accept and published an Accept" + doneDB inboxItemID "Forwarded the Accept and published an Accept" topicReject :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic) @@ -803,7 +803,7 @@ topicReject grabResource topicResource now recipKey (Verse authorIdMsig body) re throwE "Join is already approved" maybeRejectDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - for maybeRejectDB $ \ rejectDB -> do + for maybeRejectDB $ \ (inboxItemID, rejectDB) -> do -- Delete the whole Collab record case idsForReject of @@ -834,17 +834,17 @@ topicReject grabResource topicResource now recipKey (Verse authorIdMsig body) re _luNewReject <- lift $ updateOutboxItem' recipByKey newRejectID actionReject return (newRejectID, newReject) - return (recipActorID, sieve, newRejectInfo) + return (recipActorID, sieve, newRejectInfo, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, sieve, (newRejectID, (action, localRecips, remoteRecips, fwdHosts))) -> do + Just (recipActorID, sieve, (newRejectID, (action, localRecips, remoteRecips, fwdHosts)), inboxItemID) -> do let recipByID = resourceToActor $ topicResource recipKey forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ sendActivity recipByID recipActorID localRecips remoteRecips fwdHosts newRejectID action - done "Forwarded the Reject and published my own Reject" + doneDB inboxItemID "Forwarded the Reject and published my own Reject" where @@ -1133,7 +1133,7 @@ topicInvite grabResource topicComponent stemIdentCtor now topicKey (Verse author checkExistingStems (topicComponent topicKey) projectDB maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False - lift $ for maybeInviteDB $ \ inviteDB -> do + lift $ for maybeInviteDB $ \ (inboxItemID, inviteDB) -> do -- Prepare forwarding Invite to my followers sieve <- do @@ -1157,18 +1157,18 @@ topicInvite grabResource topicComponent stemIdentCtor now topicKey (Verse author insertStem projectDB inviteDB return Nothing - return (topicActorID, sieve, maybeAccept) + return (topicActorID, sieve, maybeAccept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (topicActorID, sieve, maybeAccept) -> do + Just (topicActorID, sieve, maybeAccept, inboxItemID) -> do let topicByID = resourceToActor $ topicResource topicKey forwardActivity authorIdMsig body topicByID topicActorID sieve lift $ for_ maybeAccept $ \ (acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> sendActivity topicByID topicActorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Recorded and forwarded the Invite, sent an Accept if collab" + doneDB inboxItemID "Recorded and forwarded the Invite, sent an Accept if collab" where @@ -1359,7 +1359,7 @@ topicRemove grabResource topicResource now topicKey (Verse authorIdMsig body) re throwE "No other admins exist, can't remove" maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False - lift $ for maybeRemoveDB $ \ _removeDB -> do + lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do -- Delete the whole Collab record deleteBy $ UniqueCollabDelegLocal enableID @@ -1406,17 +1406,17 @@ topicRemove grabResource topicResource now topicKey (Verse authorIdMsig body) re revokeID <- insertEmptyOutboxItem' (actorOutbox topicActor) now _luRevoke <- updateOutboxItem' recipByKey revokeID actionRevoke - return (topicActorID, sieve, revokeID, revoke) + return (topicActorID, sieve, revokeID, revoke, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke)) -> do + Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), inboxItemID) -> do let topicByID = resourceToActor $ topicResource topicKey forwardActivity authorIdMsig body topicByID topicActorID sieve lift $ sendActivity topicByID topicActorID localRecipsRevoke remoteRecipsRevoke fwdHostsRevoke revokeID actionRevoke - done "Deleted the Grant/Collab, forwarded Remove, sent Revoke" + doneDB inboxItemID "Deleted the Grant/Collab, forwarded Remove, sent Revoke" where @@ -1512,7 +1512,7 @@ topicJoin grabResource topicResource now topicKey (Verse authorIdMsig body) join _ -> error "Multiple collabs found for target" maybeJoinDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False - for maybeJoinDB $ \ joinDB -> do + for maybeJoinDB $ \ (inboxItemID, joinDB) -> do -- Insert Collab record to DB joinDB' <- @@ -1531,14 +1531,14 @@ topicJoin grabResource topicResource now topicKey (Verse authorIdMsig body) join topicHash <- encodeKeyHashid topicKey let topicByHash = resourceToActor $ topicResource topicHash return $ makeRecipientSet [] [localActorFollowers topicByHash] - return (topicActorID, sieve) + return (topicActorID, sieve, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (topicActorID, sieve) -> do + Just (topicActorID, sieve, inboxItemID) -> do let topicByID = resourceToActor $ topicResource topicKey forwardActivity authorIdMsig body topicByID topicActorID sieve - done "Recorded and forwarded the Join" + doneDB inboxItemID "Recorded and forwarded the Join" where @@ -1590,7 +1590,7 @@ topicCreateMe grabResource topicResource now recipKey (Verse authorIdMsig body) _ -> throwE "Create author isn't why I believe my creator is - is this Create fake?" maybeCreateDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - lift $ for maybeCreateDB $ \ _createDB -> do + lift $ for maybeCreateDB $ \ (inboxItemID, _createDB) -> do -- Create a Collab record and exit just-been-created state grantID <- insertEmptyOutboxItem' (actorOutbox recipActor) now @@ -1602,16 +1602,16 @@ topicCreateMe grabResource topicResource now recipKey (Verse authorIdMsig body) let recipByKey = resourceToActor $ topicResource recipKey _luGrant <- updateOutboxItem' recipByKey grantID actionGrant - return (recipActorID, grantID, grant) + return (recipActorID, grantID, grant, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) -> do + Just (recipActorID, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant), inboxItemID) -> do let recipByID = resourceToActor $ topicResource recipKey lift $ sendActivity recipByID recipActorID localRecipsGrant remoteRecipsGrant fwdHostsGrant grantID actionGrant - done "Created a Collab record and published a Grant" + doneDB inboxItemID "Created a Collab record and published a Grant" where @@ -1760,7 +1760,7 @@ componentGrant grabResource topicComponent now recipKey (Verse authorIdMsig body throwE "I already received a delegator-Grant for this Invite/Add" maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - lift $ for maybeGrantDB $ \ grantDB -> do + lift $ for maybeGrantDB $ \ (inboxItemID, grantDB) -> do -- Prepare forwarding to my followers sieve <- do @@ -1784,17 +1784,17 @@ componentGrant grabResource topicComponent now recipKey (Verse authorIdMsig body _luChain <- updateOutboxItem' recipByKey chainID actionChain return chain - return (recipActorID, sieve, chainID, chain) + return (recipActorID, sieve, chainID, chain, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, sieve, chainID, (actionChain, localRecipsChain, remoteRecipsChain, fwdHostsChain)) -> do + Just (recipActorID, sieve, chainID, (actionChain, localRecipsChain, remoteRecipsChain, fwdHostsChain), inboxItemID) -> do let recipByID = resourceToActor $ topicResource recipKey forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ sendActivity recipByID recipActorID localRecipsChain remoteRecipsChain fwdHostsChain chainID actionChain - done "Recorded and forwarded the delegator-Grant, sent a delegation-starter Grant" + doneDB inboxItemID "Recorded and forwarded the delegator-Grant, sent a delegation-starter Grant" where diff --git a/src/Vervis/Actor/Deck.hs b/src/Vervis/Actor/Deck.hs index 7293747..969e23c 100644 --- a/src/Vervis/Actor/Deck.hs +++ b/src/Vervis/Actor/Deck.hs @@ -199,7 +199,7 @@ deckAdd now deckID (Verse authorIdMsig body) add = do -- Insert the Add to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actor) False - lift $ for mractid $ \ addDB -> do + lift $ for mractid $ \ (inboxItemID, addDB) -> do -- Create a Stem record in DB acceptID <- insertEmptyOutboxItem' (actorOutbox actor) now @@ -214,17 +214,17 @@ deckAdd now deckID (Verse authorIdMsig body) add = do accept@(actionAccept, _, _, _) <- prepareAccept projectDB _luAccept <- updateOutboxItem' (LocalActorDeck deckID) acceptID actionAccept - return (deckActor deck, sieve, acceptID, accept) + return (deckActor deck, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorDeck deckID) actorID sieve lift $ sendActivity (LocalActorDeck deckID) actorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Recorded and forwarded the Add, sent an Accept" + doneDB inboxItemID "Recorded and forwarded the Add, sent an Accept" where @@ -382,7 +382,7 @@ deckOffer now deckID (Verse authorIdMsig body) (AP.Offer object uTarget) = do -- Insert the Offer to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - for mractid $ \ offerDB -> do + for mractid $ \ (inboxItemID, offerDB) -> do -- If a capability is provided, check it for_ maybeCapability $ \ cap -> do @@ -418,17 +418,17 @@ deckOffer now deckID (Verse authorIdMsig body) (AP.Offer object uTarget) = do let recipByKey = LocalActorDeck deckID _luAccept <- lift $ updateOutboxItem' recipByKey acceptID actionAccept - return (deckActor deckRecip, sieve, acceptID, accept) + return (deckActor deckRecip, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (deckActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (deckActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorDeck deckID) deckActorID sieve lift $ sendActivity (LocalActorDeck deckID) deckActorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Opened a ticket and forwarded the Offer" + doneDB inboxItemID "Opened a ticket and forwarded the Offer" where @@ -572,7 +572,7 @@ deckResolve now deckID (Verse authorIdMsig body) (AP.Resolve uObject) = do -- Insert the Resolve to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - for mractid $ \ resolveDB -> do + for mractid $ \ (inboxItemID, resolveDB) -> do {- -- Verify the sender is authorized by the tracker to resolve a ticket @@ -600,17 +600,17 @@ deckResolve now deckID (Verse authorIdMsig body) (AP.Resolve uObject) = do let recipByKey = LocalActorDeck deckID _luAccept <- lift $ updateOutboxItem' recipByKey acceptID actionAccept - return (deckActor deckRecip, sieve, acceptID, accept) + return (deckActor deckRecip, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (deckActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (deckActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorDeck deckID) deckActorID sieve lift $ sendActivity (LocalActorDeck deckID) deckActorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Resolved ticket and forwarded the Resolve" + doneDB inboxItemID "Resolved ticket and forwarded the Resolve" where @@ -913,7 +913,7 @@ deckUndo now recipDeckID (Verse authorIdMsig body) (AP.Undo uObject) = do -- Insert the Undo to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - for mractid $ \ _undoDB -> do + for mractid $ \ (inboxItemID, _undoDB) -> do maybeUndo <- runMaybeT $ do @@ -936,17 +936,17 @@ deckUndo now recipDeckID (Verse authorIdMsig body) (AP.Undo uObject) = do accept@(actionAccept, _, _, _) <- lift $ lift $ prepareAccept audience _luAccept <- lift $ updateOutboxItem' (LocalActorDeck recipDeckID) acceptID actionAccept - return (deckActor deckRecip, sieve, acceptID, accept) + return (deckActor deckRecip, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorDeck recipDeckID) actorID sieve lift $ sendActivity (LocalActorDeck recipDeckID) actorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done + doneDB inboxItemID "Undid the Follow/Resolve, forwarded the Undo and published \ \Accept" diff --git a/src/Vervis/Actor/Group.hs b/src/Vervis/Actor/Group.hs index c47453e..166dffe 100644 --- a/src/Vervis/Actor/Group.hs +++ b/src/Vervis/Actor/Group.hs @@ -192,7 +192,7 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do verifyNothingE maybeEnabled "I already sent a Grant for this Invite/Join" maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - for maybeAcceptDB $ \ acceptDB -> do + for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do (grantID, enableID) <- do @@ -235,18 +235,18 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do _luGrant <- updateOutboxItem' recipByKey grantID actionGrant return $ Just (grantID, grant) - return (recipActorID, sieve, maybeGrant) + return (recipActorID, sieve, maybeGrant, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, sieve, maybeGrant) -> do + Just (recipActorID, sieve, maybeGrant, inboxItemID) -> do let recipByID = LocalActorGroup groupID forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ for_ maybeGrant $ \ (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) -> sendActivity recipByID recipActorID localRecipsGrant remoteRecipsGrant fwdHostsGrant grantID actionGrant - done "Forwarded the Accept and maybe published a Grant" + doneDB inboxItemID "Forwarded the Accept and maybe published a Grant" where @@ -545,7 +545,7 @@ groupGrant now groupID (Verse authorIdMsig body) grant = do verifyNothingE maybeDeleg "I already have a delegator-Grant from this collaborator" maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - for maybeGrantDB $ \ grantDB -> do + for maybeGrantDB $ \ (inboxItemID, grantDB) -> do -- Record the delegator-Grant in the Collab record lift $ case (grantDB, bimap entityKey entityKey recip) of @@ -563,11 +563,11 @@ groupGrant now groupID (Verse authorIdMsig body) grant = do -- delegation-extension Grant extensions <- lift $ pure [] - return (recipActorID, sieve, extensions) + return (recipActorID, sieve, extensions, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, sieve, extensions) -> do + Just (recipActorID, sieve, extensions, inboxItemID) -> do let recipByID = LocalActorGroup groupID forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ for_ extensions $ @@ -575,7 +575,7 @@ groupGrant now groupID (Verse authorIdMsig body) grant = do sendActivity recipByID recipActorID localRecipsExt remoteRecipsExt fwdHostsExt extID actionExt - done "Forwarded the delegator-Grant, updated DB" + doneDB inboxItemID "Forwarded the delegator-Grant, updated DB" -- Meaning: An actor A invited actor B to a resource -- Behavior: @@ -670,7 +670,7 @@ groupInvite now groupID (Verse authorIdMsig body) invite = do _ -> error "Multiple collabs found for target" maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False - lift $ for maybeInviteDB $ \ inviteDB -> do + lift $ for maybeInviteDB $ \ (inboxItemID, inviteDB) -> do -- Insert Collab or Component record to DB acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now @@ -685,17 +685,17 @@ groupInvite now groupID (Verse authorIdMsig body) invite = do accept@(actionAccept, _, _, _) <- prepareAccept invitedDB _luAccept <- updateOutboxItem' (LocalActorGroup groupID) acceptID actionAccept - return (topicActorID, sieve, acceptID, accept) + return (topicActorID, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (groupActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (groupActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorGroup groupID) groupActorID sieve lift $ sendActivity (LocalActorGroup groupID) groupActorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Recorded and forwarded the Invite, sent an Accept" + doneDB inboxItemID "Recorded and forwarded the Invite, sent an Accept" where @@ -875,7 +875,7 @@ groupUndo now recipGroupID (Verse authorIdMsig body) (AP.Undo uObject) = do -- Insert the Undo to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - for mractid $ \ _undoDB -> do + for mractid $ \ (inboxItemID, _undoDB) -> do maybeUndo <- runMaybeT $ do @@ -897,17 +897,17 @@ groupUndo now recipGroupID (Verse authorIdMsig body) (AP.Undo uObject) = do accept@(actionAccept, _, _, _) <- lift $ lift $ prepareAccept audience _luAccept <- lift $ updateOutboxItem' (LocalActorGroup recipGroupID) acceptID actionAccept - return (groupActor groupRecip, sieve, acceptID, accept) + return (groupActor groupRecip, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorGroup recipGroupID) actorID sieve lift $ sendActivity (LocalActorGroup recipGroupID) actorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done + doneDB inboxItemID "Undid the Follow, forwarded the Undo and published Accept" where diff --git a/src/Vervis/Actor/Loom.hs b/src/Vervis/Actor/Loom.hs index fce0af8..045a098 100644 --- a/src/Vervis/Actor/Loom.hs +++ b/src/Vervis/Actor/Loom.hs @@ -268,7 +268,7 @@ loomOffer now loomID (Verse authorIdMsig body) (AP.Offer object uTarget) = do -- Insert the Offer to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - for mractid $ \ offerDB -> do + for mractid $ \ (inboxItemID, offerDB) -> do -- If a capability is provided, check it for_ maybeCapability $ \ cap -> do @@ -312,18 +312,18 @@ loomOffer now loomID (Verse authorIdMsig body) (AP.Offer object uTarget) = do let recipByKey = LocalActorLoom loomID _luAccept <- lift $ updateOutboxItem' recipByKey acceptID actionAccept - return (loomActor loomRecip, sieve, acceptID, accept, maybePull) + return (loomActor loomRecip, sieve, acceptID, accept, maybePull, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (loomActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), maybePull) -> do + Just (loomActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), maybePull, inboxItemID) -> do traverse_ generatePatches maybePull forwardActivity authorIdMsig body (LocalActorLoom loomID) loomActorID sieve lift $ sendActivity (LocalActorLoom loomID) loomActorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Opened a MR and forwarded the Offer" + doneDB inboxItemID "Opened a MR and forwarded the Offer" where @@ -479,7 +479,7 @@ loomResolve now loomID (Verse authorIdMsig body) (AP.Resolve uObject) = do -- Insert the Resolve to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - for mractid $ \ resolveDB -> do + for mractid $ \ (inboxItemID, resolveDB) -> do -- Verify the sender is authorized by the tracker to resolve a ticket verifyCapability' @@ -505,17 +505,17 @@ loomResolve now loomID (Verse authorIdMsig body) (AP.Resolve uObject) = do let recipByKey = LocalActorLoom loomID _luAccept <- lift $ updateOutboxItem' recipByKey acceptID actionAccept - return (loomActor loomRecip, sieve, acceptID, accept) + return (loomActor loomRecip, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (loomActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (loomActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorLoom loomID) loomActorID sieve lift $ sendActivity (LocalActorLoom loomID) loomActorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Resolved ticket and forwarded the Resolve" + doneDB inboxItemID "Resolved ticket and forwarded the Resolve" where diff --git a/src/Vervis/Actor/Person.hs b/src/Vervis/Actor/Person.hs index a7608b1..4f23def 100644 --- a/src/Vervis/Actor/Person.hs +++ b/src/Vervis/Actor/Person.hs @@ -110,12 +110,13 @@ personOffer now recipPersonID (Verse authorIdMsig body) (AP.Offer object uTarget (p,) <$> getJust (personActor p) maybeOfferDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True - for maybeOfferDB $ \ _offerDB -> - return $ personActor personRecip + for maybeOfferDB $ \ (inboxItemID, _offerDB) -> + return (personActor personRecip, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just _actorID -> done "Inserted this Offer to my inbox" + Just (_actorID, inboxItemID) -> + doneDB inboxItemID "Inserted this Offer to my inbox" -- Meaning: Someone has asked to resolve a ticket/MR -- Behavior: @@ -136,12 +137,13 @@ personResolve now recipPersonID (Verse authorIdMsig body) (AP.Resolve uObject) = (p,) <$> getJust (personActor p) maybeResolveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True - for maybeResolveDB $ \ _resolveDB -> - return $ personActor personRecip + for maybeResolveDB $ \ (inboxItemID, _resolveDB) -> + return (personActor personRecip, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just _actorID -> done "Inserted this Resolve to my inbox" + Just (_actorID, inboxItemID) -> + doneDB inboxItemID "Inserted this Resolve to my inbox" ------------------------------------------------------------------------------ -- Following @@ -203,7 +205,7 @@ personUndo now recipPersonID (Verse authorIdMsig body) (AP.Undo uObject) = do -- Insert the Undo to person's inbox maybeUndoDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - for maybeUndoDB $ \ undoDB -> do + for maybeUndoDB $ \ (inboxItemID, undoDB) -> (inboxItemID,) <$> do maybeUndo <- runMaybeT $ do @@ -224,12 +226,14 @@ personUndo now recipPersonID (Verse authorIdMsig body) (AP.Undo uObject) = do case maybeUndo of Nothing -> done "I already have this activity in my inbox" - Just Nothing -> done "Unrelated to me, just inserted to inbox" - Just (Just (actorID, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept))) -> do - lift $ sendActivity - (LocalActorPerson recipPersonID) actorID localRecipsAccept - remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Undid the Follow and published Accept" + Just (inboxItemID, result) -> + case result of + Nothing -> doneDB inboxItemID "Unrelated to me, just inserted to inbox" + Just (actorID, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + lift $ sendActivity + (LocalActorPerson recipPersonID) actorID localRecipsAccept + remoteRecipsAccept fwdHostsAccept acceptID actionAccept + doneDB inboxItemID "Undid the Follow and published Accept" where @@ -304,7 +308,7 @@ personAccept now recipPersonID (Verse authorIdMsig body) accept = do (p,) <$> getJust (personActor p) maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True - for maybeAcceptDB $ \ acceptDB -> runMaybeT $ do + for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> fmap (inboxItemID,) $ runMaybeT $ do -- Find the accepted activity in our DB accepteeDB <- MaybeT $ getActivity acceptee @@ -315,16 +319,18 @@ personAccept now recipPersonID (Verse authorIdMsig body) accept = do case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just Nothing -> done "Not my Follow/Invite; Just inserted to my inbox" - Just (Just (Left ())) -> - done "Recorded this Accept on the Follow request I sent" - Just (Just (Right (actorID, sieve))) -> do - forwardActivity - authorIdMsig body (LocalActorPerson recipPersonID) - actorID sieve - done - "Recorded this Accept on the Invite I've had & \ - \forwarded to my followers" + Just (inboxItemID, result) -> + case result of + Nothing -> doneDB inboxItemID "Not my Follow/Invite; Just inserted to my inbox" + Just (Left ()) -> + doneDB inboxItemID "Recorded this Accept on the Follow request I sent" + Just (Right (actorID, sieve)) -> do + forwardActivity + authorIdMsig body (LocalActorPerson recipPersonID) + actorID sieve + doneDB inboxItemID + "Recorded this Accept on the Invite I've had & \ + \forwarded to my followers" where @@ -452,7 +458,7 @@ personReject now recipPersonID (Verse authorIdMsig body) reject = do (p,) <$> getJust (personActor p) maybeRejectDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True - for maybeRejectDB $ \ _rejectDB -> runMaybeT $ do + for maybeRejectDB $ \ (inboxItemID, _rejectDB) -> fmap (inboxItemID,) $ runMaybeT $ do -- Find the rejected activity in our DB rejecteeDB <- MaybeT $ getActivity rejectee @@ -461,9 +467,9 @@ personReject now recipPersonID (Verse authorIdMsig body) reject = do case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just Nothing -> done "Not my Follow; Just inserted to my inbox" - Just (Just ()) -> - done "Recorded this Reject on the Follow request I sent" + Just (inboxItemID, Nothing) -> doneDB inboxItemID "Not my Follow; Just inserted to my inbox" + Just (inboxItemID, Just ()) -> + doneDB inboxItemID "Recorded this Reject on the Follow request I sent" where @@ -540,10 +546,9 @@ personCreateNote now recipPersonID (Verse authorIdMsig body) note = do _ <- traverse (getMessageParent did) maybeParent lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) True - done $ - case mractid of - Nothing -> "I already have this activity in my inbox, doing nothing" - Just _ -> "Inserted Create{Note} to my inbox" + case mractid of + Nothing -> done "I already have this activity in my inbox, doing nothing" + Just (inboxItemID, _) -> doneDB inboxItemID "Inserted Create{Note} to my inbox" where checkContextParent (ObjURI hContext luContext) mparent = do mdid <- lift $ runMaybeT $ do @@ -595,12 +600,12 @@ personAdd now recipPersonID (Verse authorIdMsig body) add = do (p,) <$> getJust (personActor p) maybeAddDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True - for maybeAddDB $ \ _addDB -> - return $ personActor personRecip + for maybeAddDB $ \ (inboxItemID, _addDB) -> + return (personActor personRecip, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just _actorID -> done "Inserted this Add to my inbox" + Just (_actorID, inboxItemID) -> doneDB inboxItemID "Inserted this Add to my inbox" -- Meaning: Someone invited someone to a resource -- Behavior: @@ -670,7 +675,7 @@ personInvite now recipPersonID (Verse authorIdMsig body) invite = do (p,) <$> getJust (personActor p) maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True - for maybeInviteDB $ \ inviteDB -> do + for maybeInviteDB $ \ (inboxItemID, inviteDB) -> do maybePermit <- for maybeRoleAndResourceDB $ \ (role, resourceDB) -> do @@ -690,18 +695,18 @@ personInvite now recipPersonID (Verse authorIdMsig body) invite = do return sieve - return (personActor personRecip, maybePermit) + return (personActor personRecip, maybePermit, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (actorID, maybePermit) -> + Just (actorID, maybePermit, inboxItemID) -> case maybePermit of - Nothing -> done "I'm not the target; Inserted to inbox" + Nothing -> doneDB inboxItemID "I'm not the target; Inserted to inbox" Just sieve -> do forwardActivity authorIdMsig body (LocalActorPerson recipPersonID) actorID sieve - done + doneDB inboxItemID "I'm the target; Inserted to inbox; Inserted Permit; \ \Forwarded to followers if addressed" @@ -746,18 +751,18 @@ personRemove now recipPersonID (Verse authorIdMsig body) remove = do (p,) <$> getJust (personActor p) maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True - for maybeRemoveDB $ \ _removeDB -> - return $ personActor personRecip + for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> + return (personActor personRecip, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just actorID -> do + Just (actorID, inboxItemID) -> do let memberIsMe = case memberOrComp of Left (LocalActorPerson p) -> p == recipPersonID _ -> False if not memberIsMe - then done "I'm not the member; Inserted to inbox" + then doneDB inboxItemID "I'm not the member; Inserted to inbox" else do recipHash <- encodeKeyHashid recipPersonID let sieve = @@ -767,7 +772,7 @@ personRemove now recipPersonID (Verse authorIdMsig body) remove = do forwardActivity authorIdMsig body (LocalActorPerson recipPersonID) actorID sieve - done + doneDB inboxItemID "I'm the member; Inserted to inbox; \ \Forwarded to followers if addressed" @@ -795,7 +800,7 @@ personJoin now recipPersonID (Verse authorIdMsig body) join = do case maybeJoinID of Nothing -> done "I already have this activity in my inbox" - Just _joinID -> done "Inserted to my inbox" + Just (inboxItemID, _joinID) -> doneDB inboxItemID "Inserted to my inbox" -- Meaning: An actor published a Grant -- Behavior: @@ -980,8 +985,9 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do ) mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True - for mractid $ \ grantDB -> do + for mractid $ \ (inboxItemID, grantDB) -> + fmap (inboxItemID,) $ for maybePermit $ bitraverse (\ (gestureID, topic) -> lift $ do @@ -1056,17 +1062,19 @@ personGrant now recipPersonID (Verse authorIdMsig body) grant = do case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just Nothing -> done "Inserted Grant to my inbox" - Just (Just (Left (recipActorID, sieve, maybeDeleg))) -> do - let recipByID = LocalActorPerson recipPersonID - forwardActivity authorIdMsig body recipByID recipActorID sieve - lift $ for_ maybeDeleg $ \ (delegID, (actionDeleg, localRecipsDeleg, remoteRecipsDeleg, fwdHostsDeleg)) -> - sendActivity - recipByID recipActorID localRecipsDeleg - remoteRecipsDeleg fwdHostsDeleg delegID actionDeleg - done "Forwarded the direct-Grant, updated Permit, maybe published delegator-Grant" - Just (Just (Right ())) -> - done "Got an extension-Grant, updated Permit" + Just (inboxItemID, result) -> + case result of + Nothing -> doneDB inboxItemID "Inserted Grant to my inbox" + Just (Left (recipActorID, sieve, maybeDeleg)) -> do + let recipByID = LocalActorPerson recipPersonID + forwardActivity authorIdMsig body recipByID recipActorID sieve + lift $ for_ maybeDeleg $ \ (delegID, (actionDeleg, localRecipsDeleg, remoteRecipsDeleg, fwdHostsDeleg)) -> + sendActivity + recipByID recipActorID localRecipsDeleg + remoteRecipsDeleg fwdHostsDeleg delegID actionDeleg + doneDB inboxItemID "Forwarded the direct-Grant, updated Permit, maybe published delegator-Grant" + Just (Right ()) -> + doneDB inboxItemID "Got an extension-Grant, updated Permit" where @@ -1224,7 +1232,7 @@ personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke lus) = do found mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) True - lift $ for mractid $ \ _revokeDB -> + lift $ for mractid $ \ (inboxItemID, _revokeDB) -> fmap (inboxItemID,) $ -- Delete revoked records from DB for grantsDB $ traverse_ $ bitraverse_ @@ -1278,7 +1286,7 @@ personRevoke now recipPersonID (Verse authorIdMsig body) (AP.Revoke lus) = do case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just _ -> done "Deleted any relevant Permit/Extend records" + Just (inboxItemID, _) -> doneDB inboxItemID "Deleted any relevant Permit/Extend records" where diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs index c89d944..51aaa72 100644 --- a/src/Vervis/Actor/Project.hs +++ b/src/Vervis/Actor/Project.hs @@ -544,7 +544,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do verifyNothingE maybeEnabled "I already sent a Grant for this Invite/Join" maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - for maybeAcceptDB $ \ acceptDB -> do + for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do -- Record the Accept and enable the Collab (grantID, enableID) <- do @@ -583,18 +583,18 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do let recipByKey = LocalActorProject projectID _luGrant <- lift $ updateOutboxItem' recipByKey grantID actionGrant - return (recipActorID, sieve, grantID, grant) + return (recipActorID, sieve, grantID, grant, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, sieve, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) -> do + Just (recipActorID, sieve, grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant), inboxItemID) -> do let recipByID = LocalActorProject projectID forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ sendActivity recipByID recipActorID localRecipsGrant remoteRecipsGrant fwdHostsGrant grantID actionGrant - done "[Collab mode] Forwarded the Accept and published a Grant" + doneDB inboxItemID "[Collab mode] Forwarded the Accept and published a Grant" addComp (componentID, ident, inviteOrAdd) = do @@ -651,7 +651,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do verifyNothingE maybeEnabled "I already sent a delegator-Grant for this Invite/Add" maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - for maybeAcceptDB $ \ acceptDB -> do + for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do maybeGrantData <- case comp of @@ -712,18 +712,18 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do _luGrant <- updateOutboxItem' recipByKey grantID actionGrant return (grantID, grant) - return (recipActorID, sieve, maybeGrant) + return (recipActorID, sieve, maybeGrant, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, sieve, maybeGrant) -> do + Just (recipActorID, sieve, maybeGrant, inboxItemID) -> do let recipByID = LocalActorProject projectID forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ for_ maybeGrant $ \ (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) -> sendActivity recipByID recipActorID localRecipsGrant remoteRecipsGrant fwdHostsGrant grantID actionGrant - done "[Component mode] Forwarded the Accept and maybe published a Grant" + doneDB inboxItemID "[Component mode] Forwarded the Accept and maybe published a Grant" addChildParent cp = do @@ -836,7 +836,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do (actorID,) <$> getJust actorID maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - for maybeAcceptDB $ \ acceptDB -> do + for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do idsForGrant <- bitraverse @@ -956,18 +956,18 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do _luAccept <- updateOutboxItem' recipByKey acceptID actionAccept return (acceptID, accept) - return (recipActorID, sieve, maybeAct) + return (recipActorID, sieve, maybeAct, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, sieve, maybeGrant) -> do + Just (recipActorID, sieve, maybeGrant, inboxItemID) -> do let recipByID = LocalActorProject projectID forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ for_ maybeGrant $ \ (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) -> sendActivity recipByID recipActorID localRecipsGrant remoteRecipsGrant fwdHostsGrant grantID actionGrant - done "[Child/Parent mode] Forwarded the Accept and maybe published a Grant/Accept" + doneDB inboxItemID "[Child/Parent mode] Forwarded the Accept and maybe published a Grant/Accept" prepareCollabGrant isInvite sender role = do encodeRouteHome <- getEncodeRouteHome @@ -1186,7 +1186,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do (p,) <$> getJust (projectActor p) maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - lift $ for maybeAcceptDB $ \ acceptDB -> do + lift $ for maybeAcceptDB $ \ (inboxItemID, acceptDB) -> do -- Grab extension-Grants that I'm about to revoke gathers <- selectList [SourceUsGatherSource ==. sendID] [] @@ -1283,11 +1283,11 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do _luExt <- updateOutboxItem' recipByKey extID actionExt return (extID, ext) - return (projectActor project, sieve, revokeID, revoke, revokes) + return (projectActor project, sieve, revokeID, revoke, revokes, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), revokes) -> do + Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), revokes, inboxItemID) -> do let topicByID = LocalActorProject projectID forwardActivity authorIdMsig body topicByID topicActorID sieve lift $ do @@ -1298,7 +1298,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do sendActivity topicByID topicActorID localRecipsExt remoteRecipsExt fwdHostsExt extID actionExt - done "[Remove-Child mode] Deleted the Child/Source, forwarded Accept, sent Revokes" + doneDB inboxItemID "[Remove-Child mode] Deleted the Child/Source, forwarded Accept, sent Revokes" where @@ -1627,16 +1627,16 @@ projectAdd now projectID (Verse authorIdMsig body) add = do -- Insert the Add to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - lift $ for mractid $ \ addDB -> do + lift $ for mractid $ \ (inboxItemID, addDB) -> do -- Create a Component record in DB insertComponent componentDB addDB - return $ projectActor project + return (projectActor project, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just actorID -> do + Just (actorID, inboxItemID) -> do projectHash <- encodeKeyHashid projectID let sieve = makeRecipientSet @@ -1644,7 +1644,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do [LocalStageProjectFollowers projectHash] forwardActivity authorIdMsig body (LocalActorProject projectID) actorID sieve - done + doneDB inboxItemID "Recorded a Component record; Inserted the Add to inbox; \ \Forwarded to followers if addressed" @@ -1767,7 +1767,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do -- Insert the Add to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - lift $ for mractid $ \ addDB -> do + lift $ for mractid $ \ (inboxItemID, addDB) -> do -- Create a Source record in DB acceptID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now @@ -1782,17 +1782,17 @@ projectAdd now projectID (Verse authorIdMsig body) add = do accept@(actionAccept, _, _, _) <- prepareAccept childDB _luAccept <- updateOutboxItem' (LocalActorProject projectID) acceptID actionAccept - return (projectActor project, sieve, acceptID, accept) + return (projectActor project, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorProject projectID) projectActorID sieve lift $ sendActivity (LocalActorProject projectID) projectActorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Recorded a child-project-in-progress, forwarded the Add, sent an Accept" + doneDB inboxItemID "Recorded a child-project-in-progress, forwarded the Add, sent an Accept" where @@ -1877,7 +1877,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do -- Insert the Add to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - lift $ for mractid $ \ addDB -> do + lift $ for mractid $ \ (inboxItemID, addDB) -> do -- Create a Dest record in DB acceptID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now @@ -1892,17 +1892,17 @@ projectAdd now projectID (Verse authorIdMsig body) add = do accept@(actionAccept, _, _, _) <- prepareAccept parentDB _luAccept <- updateOutboxItem' (LocalActorProject projectID) acceptID actionAccept - return (projectActor project, sieve, acceptID, accept) + return (projectActor project, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorProject projectID) projectActorID sieve lift $ sendActivity (LocalActorProject projectID) projectActorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Recorded a parent-project-in-progress, forwarded the Add, sent an Accept" + doneDB inboxItemID "Recorded a parent-project-in-progress, forwarded the Add, sent an Accept" where @@ -1972,7 +1972,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do -- Insert the Add to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - lift $ for mractid $ \ addDB -> do + lift $ for mractid $ \ (inboxItemID, addDB) -> do -- Create a Source record in DB insertSource childDB' addDB @@ -1982,14 +1982,14 @@ projectAdd now projectID (Verse authorIdMsig body) add = do projectHash <- encodeKeyHashid projectID return $ makeRecipientSet [] [LocalStageProjectFollowers projectHash] - return (projectActor project, sieve) + return (projectActor project, sieve, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (projectActorID, sieve) -> do + Just (projectActorID, sieve, inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorProject projectID) projectActorID sieve - done "Recorded a child-project-in-progress, forwarded the Add" + doneDB inboxItemID "Recorded a child-project-in-progress, forwarded the Add" where @@ -2057,7 +2057,7 @@ projectAdd now projectID (Verse authorIdMsig body) add = do -- Insert the Add to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - lift $ for mractid $ \ addDB -> do + lift $ for mractid $ \ (inboxItemID, addDB) -> do -- Create a Dest record in DB insertDest parentDB' addDB @@ -2067,14 +2067,14 @@ projectAdd now projectID (Verse authorIdMsig body) add = do projectHash <- encodeKeyHashid projectID return $ makeRecipientSet [] [LocalStageProjectFollowers projectHash] - return (projectActor project, sieve) + return (projectActor project, sieve, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (projectActorID, sieve) -> do + Just (projectActorID, sieve, inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorProject projectID) projectActorID sieve - done "Recorded a parent-project-in-progress, forwarded the Add" + doneDB inboxItemID "Recorded a parent-project-in-progress, forwarded the Add" where @@ -2359,7 +2359,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do verifyNothingE maybeDeleg "I already have a delegation-start Grant from this component" maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - for maybeGrantDB $ \ grantDB -> do + for maybeGrantDB $ \ (inboxItemID, grantDB) -> do -- Record the delegation in DB lift $ case (grantDB, bimap fst fst ident) of @@ -2470,11 +2470,12 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do , sieve , localExtensions ++ localExtensionsForParents , remoteExtensions ++ remoteExtensionsForParents + , inboxItemID ) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, sieve, localExts, remoteExts) -> do + Just (recipActorID, sieve, localExts, remoteExts, inboxItemID) -> do let recipByID = LocalActorProject projectID forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ for_ (localExts ++ remoteExts) $ @@ -2482,7 +2483,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do sendActivity recipByID recipActorID localRecipsExt remoteRecipsExt fwdHostsExt extID actionExt - done "Forwarded the start-Grant and published delegation extensions" + doneDB inboxItemID "Forwarded the start-Grant and published delegation extensions" where @@ -2657,7 +2658,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do verifyNothingE maybeDeleg "I already have a delegator-Grant from this collaborator" maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - for maybeGrantDB $ \ grantDB -> do + for maybeGrantDB $ \ (inboxItemID, grantDB) -> do -- Record the delegator-Grant in the Collab record (insertExt, insertLeaf, uDeleg) <- @@ -2800,11 +2801,11 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do return $ fromComponents ++ fromChildren - return (recipActorID, sieve, extensions) + return (recipActorID, sieve, extensions, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, sieve, extensions) -> do + Just (recipActorID, sieve, extensions, inboxItemID) -> do let recipByID = LocalActorProject projectID forwardActivity authorIdMsig body recipByID recipActorID sieve lift $ for_ extensions $ @@ -2812,7 +2813,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do sendActivity recipByID recipActorID localRecipsExt remoteRecipsExt fwdHostsExt extID actionExt - done "Forwarded the delegator-Grant, updated DB and published delegation extensions" + doneDB inboxItemID "Forwarded the delegator-Grant, updated DB and published delegation extensions" where @@ -2964,7 +2965,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do topic maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - for maybeGrantDB $ \ grantDB -> do + for maybeGrantDB $ \ (inboxItemID, grantDB) -> do -- Record the delegation in DB from <- case (grantDB, bimap (view _3) (view _3) topicWithAccept) of @@ -3090,18 +3091,19 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do ( recipActorID , localExtensions ++ localExtensionsForParents , remoteExtensions ++ remoteExtensionsForParents + , inboxItemID ) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, localExts, remoteExts) -> do + Just (recipActorID, localExts, remoteExts, inboxItemID) -> do let recipByID = LocalActorProject projectID lift $ for_ (localExts ++ remoteExts) $ \ (extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt)) -> sendActivity recipByID recipActorID localRecipsExt remoteRecipsExt fwdHostsExt extID actionExt - done "Sent extensions to collabs & parents" + doneDB inboxItemID "Sent extensions to collabs & parents" where @@ -3303,7 +3305,7 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do (actorID,) <$> getJust actorID maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False - for maybeGrantDB $ \ grantDB -> do + for maybeGrantDB $ \ (inboxItemID, grantDB) -> do -- Record the delegator-Grant in DB to <- case (grantDB, bimap fst fst topic) of @@ -3439,18 +3441,19 @@ projectGrant now projectID (Verse authorIdMsig body) grant = do return ( recipActorID , (startID, start) : localExtensions ++ remoteExtensions ++ fromChildren + , inboxItemID ) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (recipActorID, exts) -> do + Just (recipActorID, exts, inboxItemID) -> do let recipByID = LocalActorProject projectID lift $ for_ exts $ \ (extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt)) -> sendActivity recipByID recipActorID localRecipsExt remoteRecipsExt fwdHostsExt extID actionExt - done "Sent start-Grant and extensions from components and children" + doneDB inboxItemID "Sent start-Grant and extensions from components and children" where @@ -3717,7 +3720,7 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do Right component -> checkExistingComponents projectID component maybeInviteDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False - lift $ for maybeInviteDB $ \ inviteDB -> do + lift $ for maybeInviteDB $ \ (inboxItemID, inviteDB) -> do -- Insert Collab or Component record to DB acceptID <- insertEmptyOutboxItem' (actorOutbox topicActor) now @@ -3734,17 +3737,17 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do accept@(actionAccept, _, _, _) <- prepareAccept invitedDB _luAccept <- updateOutboxItem' (LocalActorProject projectID) acceptID actionAccept - return (topicActorID, sieve, acceptID, accept) + return (topicActorID, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (projectActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorProject projectID) projectActorID sieve lift $ sendActivity (LocalActorProject projectID) projectActorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Recorded and forwarded the Invite, sent an Accept" + doneDB inboxItemID "Recorded and forwarded the Invite, sent an Accept" where @@ -4075,7 +4078,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do throwE "No other admins exist, can't remove" maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox topicActor) False - lift $ for maybeRemoveDB $ \ _removeDB -> do + lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do -- Delete the whole Collab record deleteBy $ UniqueCollabDelegLocal enableID @@ -4123,17 +4126,17 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do revokeID <- insertEmptyOutboxItem' (actorOutbox topicActor) now _luRevoke <- updateOutboxItem' recipByKey revokeID actionRevoke - return (topicActorID, sieve, revokeID, revoke) + return (topicActorID, sieve, revokeID, revoke, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke)) -> do + Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), inboxItemID) -> do let topicByID = LocalActorProject projectID forwardActivity authorIdMsig body topicByID topicActorID sieve lift $ sendActivity topicByID topicActorID localRecipsRevoke remoteRecipsRevoke fwdHostsRevoke revokeID actionRevoke - done "Deleted the Grant/Collab, forwarded Remove, sent Revoke" + doneDB inboxItemID "Deleted the Grant/Collab, forwarded Remove, sent Revoke" where @@ -4271,7 +4274,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do verifySingleE sources "No source" "Multiple sources" maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - lift $ for maybeRemoveDB $ \ _removeDB -> do + lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do -- Grab extension-Grants that I'm about to revoke gathers <- selectList [SourceUsGatherSource ==. sendID] [] @@ -4364,11 +4367,11 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do _luExt <- updateOutboxItem' recipByKey extID actionExt return (extID, ext) - return (projectActor project, sieve, revokeID, revoke, revokes) + return (projectActor project, sieve, revokeID, revoke, revokes, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), revokes) -> do + Just (topicActorID, sieve, revokeID, (actionRevoke, localRecipsRevoke, remoteRecipsRevoke, fwdHostsRevoke), revokes, inboxItemID) -> do let topicByID = LocalActorProject projectID forwardActivity authorIdMsig body topicByID topicActorID sieve lift $ do @@ -4379,7 +4382,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do sendActivity topicByID topicActorID localRecipsExt remoteRecipsExt fwdHostsExt extID actionExt - done "Deleted the Child/Source, forwarded Remove, sent Revokes" + doneDB inboxItemID "Deleted the Child/Source, forwarded Remove, sent Revokes" where @@ -4560,7 +4563,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do verifySingleE dests "No dest" "Multiple dests" maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - lift $ for maybeRemoveDB $ \ _removeDB -> do + lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do -- Delete uses of this Dest from my Component records deleteWhere [ComponentGatherParent ==. destStartID] @@ -4612,18 +4615,18 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do acceptID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now _luAccept <- updateOutboxItem' recipByKey acceptID actionAccept - return (projectActor project, sieve, acceptID, accept) + return (projectActor project, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do let topicByID = LocalActorProject projectID forwardActivity authorIdMsig body topicByID topicActorID sieve lift $ sendActivity topicByID topicActorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Deleted the Parent/Dest, forwarded Remove, sent Accept" + doneDB inboxItemID "Deleted the Parent/Dest, forwarded Remove, sent Accept" where @@ -4738,7 +4741,7 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do (E.Value sourceID, E.Value holderID, Entity sendID (SourceUsSendDelegator _ grantID), topic) <- verifySingleE sources "No source" "Multiple sources" - maybeRemoveDB <- lift $ insertToInbox' now authorIdMsig body (actorInbox actorRecip) False + maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False lift $ for maybeRemoveDB $ \ (removeID, _) -> do -- Record the removal attempt @@ -4751,14 +4754,14 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do LocalActorProject topicHash return $ makeRecipientSet [] [localActorFollowers topicByHash] - return (projectActor project, sieve) + return (projectActor project, sieve, removeID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (topicActorID, sieve) -> do + Just (topicActorID, sieve, inboxItemID) -> do let topicByID = LocalActorProject projectID forwardActivity authorIdMsig body topicByID topicActorID sieve - done "Recorded removal attempt, forwarded Remove" + doneDB inboxItemID "Recorded removal attempt, forwarded Remove" removeParentPassive parent = do @@ -4838,14 +4841,14 @@ projectRemove now projectID (Verse authorIdMsig body) remove = do verifySingleE dests "No dest" "Multiple dests" maybeRemoveDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - lift $ for maybeRemoveDB $ \ _removeDB -> do + lift $ for maybeRemoveDB $ \ (inboxItemID, _removeDB) -> do - return () + return inboxItemID case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just () -> - done "Saw the removal attempt, just waiting for the Revoke" + Just inboxItemID -> + doneDB inboxItemID "Saw the removal attempt, just waiting for the Revoke" -- Meaning: An actor is revoking Grant activities -- Behavior: @@ -4972,7 +4975,7 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus (p,) <$> getJust (projectActor p) maybeRevokeDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - lift $ for maybeRevokeDB $ \ _revokeDB -> do + lift $ for maybeRevokeDB $ \ (inboxItemID, _revokeDB) -> do maybeStartID <- getKeyBy $ UniqueDestUsStart usAcceptID @@ -5030,18 +5033,18 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus acceptID <- insertEmptyOutboxItem' (actorOutbox actorRecip) now _luAccept <- updateOutboxItem' recipByKey acceptID actionAccept - return (projectActor project, sieve, acceptID, accept) + return (projectActor project, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (topicActorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do let topicByID = LocalActorProject projectID forwardActivity authorIdMsig body topicByID topicActorID sieve lift $ sendActivity topicByID topicActorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done "Deleted the Parent/Dest, forwarded Revoke, sent Accept" + doneDB inboxItemID "Deleted the Parent/Dest, forwarded Revoke, sent Accept" where @@ -5088,7 +5091,7 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus (p,) <$> getJust (projectActor p) maybeRevokeDB <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - lift $ for maybeRevokeDB $ \ _revokeDB -> do + lift $ for maybeRevokeDB $ \ (inboxItemID, _revokeDB) -> do -- Collect the extensions I'll need to revoke gatherIDs <- @@ -5154,17 +5157,17 @@ projectRevoke now projectID (Verse authorIdMsig body) (AP.Revoke (luFirst :| lus _luExt <- updateOutboxItem' recipByKey extID actionExt return (extID, ext) - return (projectActor project, revokes) + return (projectActor project, revokes, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (topicActorID, revokes) -> do + Just (topicActorID, revokes, inboxItemID) -> do let topicByID = LocalActorProject projectID lift $ for_ revokes $ \ (extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt)) -> sendActivity topicByID topicActorID localRecipsExt remoteRecipsExt fwdHostsExt extID actionExt - done "Deleted the SourceThemDelegate* record, sent Revokes" + doneDB inboxItemID "Deleted the SourceThemDelegate* record, sent Revokes" where @@ -5244,7 +5247,7 @@ projectUndo now recipProjectID (Verse authorIdMsig body) (AP.Undo uObject) = do -- Insert the Undo to my inbox mractid <- lift $ insertToInbox now authorIdMsig body (actorInbox actorRecip) False - for mractid $ \ _undoDB -> do + for mractid $ \ (inboxItemID, _undoDB) -> do maybeUndo <- runMaybeT $ do @@ -5266,17 +5269,17 @@ projectUndo now recipProjectID (Verse authorIdMsig body) (AP.Undo uObject) = do accept@(actionAccept, _, _, _) <- lift $ lift $ prepareAccept audience _luAccept <- lift $ updateOutboxItem' (LocalActorProject recipProjectID) acceptID actionAccept - return (projectActor projectRecip, sieve, acceptID, accept) + return (projectActor projectRecip, sieve, acceptID, accept, inboxItemID) case maybeNew of Nothing -> done "I already have this activity in my inbox" - Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept)) -> do + Just (actorID, sieve, acceptID, (actionAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept), inboxItemID) -> do forwardActivity authorIdMsig body (LocalActorProject recipProjectID) actorID sieve lift $ sendActivity (LocalActorProject recipProjectID) actorID localRecipsAccept remoteRecipsAccept fwdHostsAccept acceptID actionAccept - done + doneDB inboxItemID "Undid the Follow, forwarded the Undo and published Accept" where diff --git a/src/Vervis/Federation/Util.hs b/src/Vervis/Federation/Util.hs index 954b032..8394ca6 100644 --- a/src/Vervis/Federation/Util.hs +++ b/src/Vervis/Federation/Util.hs @@ -15,7 +15,6 @@ module Vervis.Federation.Util ( insertToInbox - , insertToInbox' ) where @@ -39,7 +38,7 @@ import Vervis.Model -- | Insert an activity delivered to us into our inbox. Return its -- database ID if the activity wasn't already in our inbox. -insertToInbox' +insertToInbox :: UTCTime -> Either (LocalActorBy Key, ActorId, OutboxItemId) @@ -55,15 +54,15 @@ insertToInbox' (RemoteAuthor, LocalURI, RemoteActivityId) ) ) -insertToInbox' now (Left a@(_, _, outboxItemID)) _body inboxID unread = do - inboxItemID <- insert $ InboxItem unread now +insertToInbox now (Left a@(_, _, outboxItemID)) _body inboxID unread = do + inboxItemID <- insert $ InboxItem unread now "No result yet" maybeItem <- insertUnique $ InboxItemLocal inboxID outboxItemID inboxItemID case maybeItem of Nothing -> do delete inboxItemID return Nothing Just _ -> return $ Just (inboxItemID, Left a) -insertToInbox' now (Right (author, luAct, _)) body inboxID unread = do +insertToInbox now (Right (author, luAct, _)) body inboxID unread = do let iidAuthor = remoteAuthorInstance author roid <- either entityKey id <$> insertBy' (RemoteObject iidAuthor luAct) @@ -72,28 +71,10 @@ insertToInbox' now (Right (author, luAct, _)) body inboxID unread = do , remoteActivityContent = persistJSONFromBL $ actbBL body , remoteActivityReceived = now } - ibiid <- insert $ InboxItem unread now + ibiid <- insert $ InboxItem unread now "No result yet" mibrid <- insertUnique $ InboxItemRemote inboxID ractid ibiid case mibrid of Nothing -> do delete ibiid return Nothing Just _ -> return $ Just (ibiid, Right (author, luAct, ractid)) - -insertToInbox - :: UTCTime - -> Either - (LocalActorBy Key, ActorId, OutboxItemId) - (RemoteAuthor, LocalURI, Maybe ByteString) - -> ActivityBody - -> InboxId - -> Bool - -> ActDB - (Maybe - (Either - (LocalActorBy Key, ActorId, OutboxItemId) - (RemoteAuthor, LocalURI, RemoteActivityId) - ) - ) -insertToInbox now act body inbox unread = - fmap snd <$> insertToInbox' now act body inbox unread diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index f19f8a5..c183bf1 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -3242,21 +3242,21 @@ changes hLocal ctx = , addFieldRefRequiredEmpty "SourceUsGather" "destNew" "DestUsStart" -- 586 , removeField "SourceUsGather" "dest" - -- 586 - , renameField "SourceUsGather" "destNew" "dest" -- 587 - , removeEntity "SourceUsGatherToLocal" + , renameField "SourceUsGather" "destNew" "dest" -- 588 - , removeEntity "SourceUsGatherToRemote" + , removeEntity "SourceUsGatherToLocal" -- 589 - , removeEntity "ComponentGatherLocal" + , removeEntity "SourceUsGatherToRemote" -- 590 - , removeEntity "ComponentGatherRemote" + , removeEntity "ComponentGatherLocal" -- 591 - , addEntities model_591_component_gather + , removeEntity "ComponentGatherRemote" -- 592 - , addEntities model_592_permit_extend + , addEntities model_591_component_gather -- 593 + , addEntities model_592_permit_extend + -- 594 , addFieldRefRequired'' "PermitTopicExtendLocal" (do permitID <- do @@ -3291,7 +3291,7 @@ changes hLocal ctx = ) "permitNew" "PermitTopicExtend" - -- 594 + -- 595 , addFieldRefRequired'' "PermitTopicExtendRemote" (do let doc = persistJSONObjectFromDoc $ Doc hLocal emptyActivity @@ -3326,25 +3326,25 @@ changes hLocal ctx = ) "permitNew" "PermitTopicExtend" - -- 595 - , removeField "PermitTopicExtendLocal" "permit" -- 596 - , removeField "PermitTopicExtendRemote" "permit" + , removeField "PermitTopicExtendLocal" "permit" -- 597 - , renameField "PermitTopicExtendLocal" "permitNew" "permit" + , removeField "PermitTopicExtendRemote" "permit" -- 598 - , renameField "PermitTopicExtendRemote" "permitNew" "permit" + , renameField "PermitTopicExtendLocal" "permitNew" "permit" -- 599 - , addUnique' "PermitTopicExtendLocal" "" ["permit"] + , renameField "PermitTopicExtendRemote" "permitNew" "permit" -- 600 - , addUnique' "PermitTopicExtendRemote" "" ["permit"] + , addUnique' "PermitTopicExtendLocal" "" ["permit"] -- 601 - , addEntities model_601_permit_extend_resource + , addUnique' "PermitTopicExtendRemote" "" ["permit"] -- 602 - , addFieldPrimRequired "PermitTopicExtend" ("RoleAdmin" :: String) "role" + , addEntities model_601_permit_extend_resource -- 603 - , addEntities model_603_resource + , addFieldPrimRequired "PermitTopicExtend" ("RoleAdmin" :: String) "role" -- 604 + , addEntities model_603_resource + -- 605 , addFieldRefRequired'' "Repo" (do inboxID <- insert Inbox604 @@ -3368,7 +3368,7 @@ changes hLocal ctx = ) "resource" "Resource" - -- 605 + -- 606 , addFieldRefRequired'' "Deck" (do inboxID <- insert Inbox604 @@ -3392,7 +3392,7 @@ changes hLocal ctx = ) "resource" "Resource" - -- 606 + -- 607 , addFieldRefRequired'' "Loom" (do inboxID <- insert Inbox604 @@ -3416,7 +3416,7 @@ changes hLocal ctx = ) "resource" "Resource" - -- 607 + -- 608 , addFieldRefRequired'' "Project" (do inboxID <- insert Inbox604 @@ -3440,7 +3440,7 @@ changes hLocal ctx = ) "resource" "Resource" - -- 608 + -- 609 , addFieldRefRequired'' "Group" (do inboxID <- insert Inbox604 @@ -3464,7 +3464,7 @@ changes hLocal ctx = ) "resource" "Resource" - -- 609 + -- 610 , addFieldRefRequired'' "PermitTopicExtendResourceLocal" (do inboxID <- insert Inbox604 @@ -3488,9 +3488,9 @@ changes hLocal ctx = ) "resource" "Resource" - -- 610 - , removeField "PermitTopicExtendResourceLocal" "actor" -- 611 + , removeField "PermitTopicExtendResourceLocal" "actor" + -- 612 , addFieldRefRequired'' "PermitTopicLocal" (do inboxID <- insert Inbox611 @@ -3536,17 +3536,17 @@ changes hLocal ctx = ) "topic" "Resource" - -- 612 - , removeEntity "PermitTopicRepo" -- 613 - , removeEntity "PermitTopicDeck" + , removeEntity "PermitTopicRepo" -- 614 - , removeEntity "PermitTopicLoom" + , removeEntity "PermitTopicDeck" -- 615 - , removeEntity "PermitTopicProject" + , removeEntity "PermitTopicLoom" -- 616 - , removeEntity "PermitTopicGroup" + , removeEntity "PermitTopicProject" -- 617 + , removeEntity "PermitTopicGroup" + -- 618 , addFieldRefRequired'' "Collab" (do inboxID <- insert Inbox611 @@ -3592,16 +3592,18 @@ changes hLocal ctx = ) "topic" "Resource" - -- 618 - , removeEntity "CollabTopicRepo" -- 619 - , removeEntity "CollabTopicDeck" + , removeEntity "CollabTopicRepo" -- 620 - , removeEntity "CollabTopicLoom" + , removeEntity "CollabTopicDeck" -- 621 - , removeEntity "CollabTopicProject" + , removeEntity "CollabTopicLoom" -- 622 + , removeEntity "CollabTopicProject" + -- 623 , removeEntity "CollabTopicGroup" + -- 624 + , addFieldPrimRequired "InboxItem" T.empty "result" ] migrateDB diff --git a/src/Vervis/Persist/Actor.hs b/src/Vervis/Persist/Actor.hs index b01de1b..3f2d8df 100644 --- a/src/Vervis/Persist/Actor.hs +++ b/src/Vervis/Persist/Actor.hs @@ -37,6 +37,7 @@ module Vervis.Persist.Actor , getRemoteActor , getRemoteActorM , getRemoteActorE + , doneDB ) where @@ -315,3 +316,8 @@ getRemoteActorM (ObjURI h lu) = do getRemoteActorE u e = do ma <- lift $ getRemoteActor u fromMaybeE ma e + +doneDB :: InboxItemId -> Text -> VA.ActE (Text, VA.Act (), Next) +doneDB itemID msg = do + lift $ VA.withDB $ update itemID [InboxItemResult =. msg] + done msg diff --git a/th/models b/th/models index b2acdbf..1c3c06d 100644 --- a/th/models +++ b/th/models @@ -85,6 +85,7 @@ Inbox InboxItem unread Bool received UTCTime + result Text InboxItemLocal inbox InboxId