From 49e80c5ae9a37047ad8217c5b75d4089c23ed2dd Mon Sep 17 00:00:00 2001
From: voidlizard <dzuikov@gmail.com>
Date: Mon, 7 Oct 2024 06:39:48 +0300
Subject: [PATCH] Mailbox protocol boilerplate

---
 hbs2-peer/app/PeerMain.hs                |  2 ++
 hbs2-peer/lib/HBS2/Peer/Proto.hs         | 11 +++++++++
 hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs | 30 ++++++++++++++++++------
 3 files changed, 36 insertions(+), 7 deletions(-)

diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs
index 29686bd1..182f253c 100644
--- a/hbs2-peer/app/PeerMain.hs
+++ b/hbs2-peer/app/PeerMain.hs
@@ -28,6 +28,7 @@ import HBS2.Peer.Proto
 import HBS2.Peer.Proto.RefChan qualified as R
 import HBS2.Peer.Proto.RefChan.Adapter
 import HBS2.Net.Proto.Notify
+import HBS2.Peer.Proto.Mailbox
 import HBS2.OrDie
 import HBS2.Storage.Simple
 import HBS2.Storage.Operations.Missed
@@ -1117,6 +1118,7 @@ runPeer opts = Exception.handle (\e -> myException e
                     , makeResponse (refChanNotifyProto False refChanAdapter)
                     -- TODO: change-all-to-authorized
                     , makeResponse ((authorized . subscribed (SomeBrains brains)) lwwRefProtoA)
+                    , makeResponse (authorized mailboxProto)
                     ]
 
 
diff --git a/hbs2-peer/lib/HBS2/Peer/Proto.hs b/hbs2-peer/lib/HBS2/Peer/Proto.hs
index bba28dd4..f19e35c2 100644
--- a/hbs2-peer/lib/HBS2/Peer/Proto.hs
+++ b/hbs2-peer/lib/HBS2/Peer/Proto.hs
@@ -29,6 +29,7 @@ import HBS2.Peer.Proto.RefLog
 import HBS2.Peer.Proto.RefChan hiding (Notify)
 import HBS2.Peer.Proto.AnyRef
 import HBS2.Peer.Proto.LWWRef
+import HBS2.Peer.Proto.Mailbox
 
 import HBS2.Actors.Peer.Types
 import HBS2.Net.Messaging.Unix (UNIX)
@@ -155,6 +156,16 @@ instance HasProtocol L4Proto (LWWRefProto L4Proto) where
   encode = serialise
   requestPeriodLim = ReqLimPerMessage 1
 
+
+instance HasProtocol L4Proto (MailBoxProto HBS2Basic L4Proto) where
+  type instance ProtocolId (MailBoxProto HBS2Basic L4Proto) = 13001
+  type instance Encoded L4Proto = ByteString
+  decode = either (const Nothing) Just . deserialiseOrFail
+  encode = serialise
+
+  -- TODO: limit-request-period
+  requestPeriodLim = NoLimit -- ReqLimPerMessage 1
+
 instance Serialise (RefChanValidate UNIX) => HasProtocol UNIX (RefChanValidate UNIX) where
   type instance ProtocolId (RefChanValidate UNIX) = 0xFFFA0001
   type instance Encoded UNIX = ByteString
diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs b/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs
index 8780ea22..8ec413fc 100644
--- a/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs
+++ b/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs
@@ -44,7 +44,7 @@ data DeleteMessagesPayload s =
   }
   deriving stock (Generic)
 
-data MailBoxProtoMessage e s =
+data MailBoxProtoMessage s e =
     SendMessage     (Message s) -- already has signed box
   | CheckMailbox    (SignedBox (MailboxKey s) s)
   | MailboxStatus   (SignedBox (MailBoxStatusPayload s) s)
@@ -53,16 +53,32 @@ data MailBoxProtoMessage e s =
   | DeleteMessages  (SignedBox (DeleteMessagesPayload s) s)
   deriving stock (Generic)
 
-data MailBoxProto e s =
-  MailBoxProtoV1 (MailBoxProtoMessage e s)
+data MailBoxProto s e =
+  MailBoxProtoV1 { mailBoxProtoPayload :: MailBoxProtoMessage s e }
+  deriving stock (Generic)
 
 instance ForMailbox s => Serialise (MailBoxStatusPayload s)
 instance ForMailbox s => Serialise (SetPolicyPayload s)
 instance ForMailbox s => Serialise (GetPolicyPayload s)
 instance ForMailbox s => Serialise (DeleteMessagesPayload s)
-instance ForMailbox s => Serialise (MailBoxProtoMessage e s)
-
-
-
+instance ForMailbox s => Serialise (MailBoxProtoMessage s e)
+instance ForMailbox s => Serialise (MailBoxProto s e)
+
+mailboxProto :: forall e m p . ( MonadIO m
+                               , Response e p m
+                               , HasDeferred p e m
+                               , p ~ MailBoxProto (Encryption e) e
+                               )
+             => MailBoxProto (Encryption e) e
+             ->  m ()
+
+mailboxProto mess = do
+  -- common stuff
+
+  case mailBoxProtoPayload mess of
+    SendMessage{} -> none
+    _ -> none
+
+  pure ()