From 549a64a6c05ca7e87f1e2f675cc4ba788db7d8c3 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Thu, 10 Oct 2024 13:20:15 +0300 Subject: [PATCH] wip --- hbs2-peer/app/MailboxProtoWorker.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/hbs2-peer/app/MailboxProtoWorker.hs b/hbs2-peer/app/MailboxProtoWorker.hs index d4e96bb3..6c79c6e5 100644 --- a/hbs2-peer/app/MailboxProtoWorker.hs +++ b/hbs2-peer/app/MailboxProtoWorker.hs @@ -32,6 +32,7 @@ import PeerTypes import DBPipe.SQLite import Control.Monad.Trans.Cont +import Control.Monad.Trans.Maybe import Data.Maybe import UnliftIO import Control.Concurrent.STM qualified as STM @@ -160,15 +161,13 @@ mailboxProtoWorker readConf me@MailboxProtoWorker{..} = do inq <- ContT $ withAsync (mailboxInQ dbe) - sendq <- ContT $ withAsync $ mailboxSendQ - bs <- ContT $ withAsync do forever do pause @'Seconds 10 debug $ "I'm" <+> yellow "mailboxProtoWorker" - void $ waitAnyCancel [bs,pipe,inq,sendq] + void $ waitAnyCancel [bs,pipe,inq] `catch` \( e :: MailboxProtoException ) -> do err $ red "mailbox protocol worker terminated" <+> viaShow e @@ -178,11 +177,6 @@ mailboxProtoWorker readConf me@MailboxProtoWorker{..} = do where - mailboxSendQ = do - forever do - pause @'Seconds 10 - debug $ yellow "send mail loop" - mailboxInQ dbe = do forever do pause @'Seconds 10 @@ -198,8 +192,14 @@ mailboxProtoWorker readConf me@MailboxProtoWorker{..} = do -- TODO: process-with-policy - for_ (messageRecipients s) $ \rcpt -> do + for_ (messageRecipients s) $ \rcpt -> void $ runMaybeT do mbox <- getMailboxType_ @s dbe rcpt + >>= toMPlus + + case mbox of + MailboxHub -> debug $ blue "HUB" <+> pretty (AsBase58 rcpt) <+> "WRITE MESSAGE" + MailboxRelay -> debug $ blue "RELAY"<+> pretty (AsBase58 rcpt) <+> "WRITE MESSAGE" + pure () mailboxStateEvolve :: forall e s m . ( MonadIO m