diff --git a/src/Vervis/Actor/Person/Client.hs b/src/Vervis/Actor/Person/Client.hs index ddd7442..dc8275e 100644 --- a/src/Vervis/Actor/Person/Client.hs +++ b/src/Vervis/Actor/Person/Client.hs @@ -136,6 +136,40 @@ verifyRemoteAddressed remoteRecips u = lus <- lookup h remoteRecips guard $ lu `elem` lus +-- Meaning: The human is approving or accepting something +-- Behavior: +-- * Insert to my inbox +-- * Deliver without filtering +clientAccept + :: UTCTime + -> PersonId + -> ClientMsg + -> AP.Accept URIMode + -> ActE OutboxItemId +clientAccept now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) accept = do + + (actorMeID, localRecipsFinal, acceptID) <- withDBExcept $ do + + -- Grab me from DB + (personMe, actorMe) <- lift $ do + p <- getJust personMeID + (p,) <$> getJust (personActor p) + + -- Insert the Accept activity to my outbox + acceptID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now + _luAccept <- lift $ updateOutboxItem' (LocalActorPerson personMeID) acceptID action + + return + ( personActor personMe + , localRecips + , acceptID + ) + + lift $ sendActivity + (LocalActorPerson personMeID) actorMeID localRecipsFinal remoteRecips + fwdHosts acceptID action + return acceptID + -- Meaning: The human wants to add component C to project P -- Behavior: -- * Some basic sanity checks @@ -885,6 +919,7 @@ clientBehavior :: UTCTime -> PersonId -> ClientMsg -> ActE (Text, Act (), Next) clientBehavior now personID msg = done . T.pack . show =<< case AP.actionSpecific $ cmAction msg of + AP.AcceptActivity accept -> clientAccept now personID msg accept AP.AddActivity add -> clientAdd now personID msg add AP.CreateActivity create -> clientCreate now personID msg create AP.InviteActivity invite -> clientInvite now personID msg invite