Mailbox protocol boilerplate

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)
                     ]
 
 

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

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 =
+data MailBoxProto s e =
-  MailBoxProtoV1 (MailBoxProtoMessage e s)
+  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 ()