From c31c2c04c6b0badc813af56a01aea0ef127668fe Mon Sep 17 00:00:00 2001
From: voidlizard <dzuikov@gmail.com>
Date: Wed, 9 Oct 2024 06:36:55 +0300
Subject: [PATCH] wip, mailbox SendMessage skeleton

---
 hbs2-peer/app/MailboxProtoWorker.hs      | 34 +++++++++++++++---------
 hbs2-peer/app/PeerMain.hs                |  2 +-
 hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs |  1 +
 3 files changed, 24 insertions(+), 13 deletions(-)

diff --git a/hbs2-peer/app/MailboxProtoWorker.hs b/hbs2-peer/app/MailboxProtoWorker.hs
index 7d7b945b..5e13ab15 100644
--- a/hbs2-peer/app/MailboxProtoWorker.hs
+++ b/hbs2-peer/app/MailboxProtoWorker.hs
@@ -25,24 +25,36 @@ import PeerTypes
 
 import Control.Monad
 import UnliftIO
+-- import Control.Concurrent.STM.TBQueue
 import Lens.Micro.Platform
 
 {- HLINT ignore "Functor law" -}
 
-data MailboxProtoWorker e =
+data MailboxProtoWorker (s :: CryptoScheme) e =
   MailboxProtoWorker
-  {
+  { mpwStorage            :: AnyStorage
+  , inMessageQueue        :: TBQueue (Message s, MessageContent s)
+  , inMessageQueueDropped :: TVar Int
   }
 
-instance IsMailboxProtoAdapter 'HBS2Basic (MailboxProtoWorker e) where
-  mailboxGetStorage = const $ error "OOPSIE"
+instance (s ~ HBS2Basic) => IsMailboxProtoAdapter s (MailboxProtoWorker s e) where
+  mailboxGetStorage = pure . mpwStorage
 
-  mailboxAcceptMessage _ _ _ = do
-    error "DOOPSIE"
+  mailboxAcceptMessage MailboxProtoWorker{..} m c = do
+    atomically do
+      full <- isFullTBQueue inMessageQueue
+      if full then do
+        modifyTVar inMessageQueueDropped succ
+      else do
+        writeTBQueue inMessageQueue (m,c)
 
-createMailboxProtoWorker :: forall e m . MonadIO m => m (MailboxProtoWorker e)
-createMailboxProtoWorker = do
-  pure MailboxProtoWorker
+createMailboxProtoWorker :: forall e m . MonadIO m => AnyStorage -> m (MailboxProtoWorker (Encryption e) e)
+createMailboxProtoWorker sto = do
+  -- FIXME: queue-size-hardcode
+  --   $class: hardcode
+  inQ        <- newTBQueueIO 1000
+  inDroppped <- newTVarIO 0
+  pure $ MailboxProtoWorker sto inQ inDroppped
 
 mailboxProtoWorker :: forall e s m . ( MonadIO m
                                      , MonadUnliftIO m
@@ -54,7 +66,7 @@ mailboxProtoWorker :: forall e s m . ( MonadIO m
                                      , s ~ Encryption e
                                      , IsRefPubKey s
                                      )
-             => MailboxProtoWorker e
+             => MailboxProtoWorker s e
              -> m ()
 
 mailboxProtoWorker me = do
@@ -71,5 +83,3 @@ mailboxProtoWorker me = do
 --     gossip (LWWRefProto1 @e (LWWProtoGet (LWWRefKey ref)))
 
 
-
-
diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs
index 3c05e13c..ef69b51c 100644
--- a/hbs2-peer/app/PeerMain.hs
+++ b/hbs2-peer/app/PeerMain.hs
@@ -1106,7 +1106,7 @@ runPeer opts = Exception.handle (\e -> myException e
 
                 peerThread "lwwRefWorker" (lwwRefWorker @e conf (SomeBrains brains))
 
-                mbw <- createMailboxProtoWorker @e
+                mbw <- createMailboxProtoWorker @e (AnyStorage s)
                 peerThread "mailboxProtoWorker" (mailboxProtoWorker mbw)
 
                 liftIO $ withPeerM penv do
diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs b/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs
index 9252e472..241ad00d 100644
--- a/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs
+++ b/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs
@@ -134,6 +134,7 @@ mailboxProto adapter mess = do
           gossip mess
           mailboxAcceptMessage adapter msg content
           -- TODO: expire-block-and-collect-garbage
+          --   $class: leak
           void $ putBlock sto routed
 
     CheckMailbox{} -> do