diff --git a/src/Vervis/Actor/Person/Client.hs b/src/Vervis/Actor/Person/Client.hs index dc8275e..607e1d3 100644 --- a/src/Vervis/Actor/Person/Client.hs +++ b/src/Vervis/Actor/Person/Client.hs @@ -67,6 +67,7 @@ import Vervis.Data.Actor import Vervis.Data.Collab import Vervis.Data.Discussion import Vervis.Data.Follow +import Vervis.Data.Ticket import Vervis.FedURI import Vervis.Fetch import Vervis.Foundation @@ -782,6 +783,87 @@ clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost fwdHosts inviteID action return inviteID +-- Meaning: The human wants to open a ticket/MR/dependency +-- Behavior: +-- * Basics checks on the provided ticket/MR (dependency not allowed) +-- * Verify the Offer target is addressed in the Offer +-- * Insert Invite to my inbox +-- * Asynchrnously deliver to: +-- * Target tracker + followers +-- * My followers +clientOffer + :: UTCTime + -> PersonId + -> ClientMsg + -> AP.Offer URIMode + -> ActE OutboxItemId +clientOffer now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) (AP.Offer object uTarget) = do + + -- Check input + ticket <- + case object of + AP.OfferTicket t -> pure t + _ -> throwE "Unsupported Offer.object type" + h <- asksEnv stageInstanceHost + WorkItemOffer {..} <- checkOfferTicket h ticket uTarget + unless (wioAuthor == Left personMeID) $ + throwE "Offering a Ticket attributed to someone else" + + -- Verify the tracker is addressed by the Offer + -- Verify it exists in DB if local + case wioRest of + TAM_Task deckID -> do + _ <- withDBExcept $ getE deckID "No such local deck" + verifyComponentAddressed localRecips $ ComponentDeck deckID + TAM_Merge loomID _ -> do + _ <- withDBExcept $ getE loomID "No such local loom" + verifyComponentAddressed localRecips $ ComponentLoom loomID + TAM_Remote u _ -> verifyRemoteAddressed remoteRecips u + + (actorMeID, localRecipsFinal, offerID) <- withDBExcept $ do + + -- Grab me from DB + (personMe, actorMe) <- lift $ do + p <- getJust personMeID + (p,) <$> getJust (personActor p) + + -- Insert the Offer activity to my outbox + offerID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now + _luOffer <- lift $ updateOutboxItem' (LocalActorPerson personMeID) offerID action + + -- Prepare local recipients for Invite delivery + sieve <- lift $ do + tracker <- + case wioRest of + TAM_Task deckID -> Left . Left <$> encodeKeyHashid deckID + TAM_Merge loomID _ -> Left . Right <$> encodeKeyHashid loomID + TAM_Remote u _ -> pure $ Right u + senderHash <- encodeKeyHashid personMeID + let sieveActors = catMaybes + [ case tracker of + Left (Left d) -> Just $ LocalActorDeck d + Left (Right l) -> Just $ LocalActorLoom l + Right _ -> Nothing + ] + sieveStages = catMaybes + [ Just $ LocalStagePersonFollowers senderHash + , case tracker of + Left (Left d) -> Just $ LocalStageDeckFollowers d + Left (Right l) -> Just $ LocalStageLoomFollowers l + Right _ -> Nothing + ] + return $ makeRecipientSet sieveActors sieveStages + return + ( personActor personMe + , localRecipSieve sieve False localRecips + , offerID + ) + + lift $ sendActivity + (LocalActorPerson personMeID) actorMeID localRecipsFinal remoteRecips + fwdHosts offerID action + return offerID + -- Meaning: The human wants to remove someone A from a resource R -- Behavior: -- * Some basic sanity checks @@ -923,5 +1005,6 @@ clientBehavior now personID msg = AP.AddActivity add -> clientAdd now personID msg add AP.CreateActivity create -> clientCreate now personID msg create AP.InviteActivity invite -> clientInvite now personID msg invite + AP.OfferActivity offer -> clientOffer now personID msg offer AP.RemoveActivity remove -> clientRemove now personID msg remove _ -> throwE "Unsupported activity type for C2S"