From 0d99e00e93346b86d8b4418c67bda07545482110 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Sun, 21 May 2023 16:04:43 +0200
Subject: [PATCH] IPC: final message format (typed messages) is implemented.

---
 src/App/IPC.purs | 77 +++++++++++++++++++++++++++++++++++-------------
 1 file changed, 56 insertions(+), 21 deletions(-)

diff --git a/src/App/IPC.purs b/src/App/IPC.purs
index efaead7..c8373f3 100644
--- a/src/App/IPC.purs
+++ b/src/App/IPC.purs
@@ -1,11 +1,25 @@
-module App.IPC (toIPC, fromIPC) where
+module App.IPC (toIPC, fromIPC, toTypedIPC, fromTypedIPC) where
 
-import Prelude (bind, discard, ($), (>>>))
+{-
+  This file contains raw serialization and deserialization of IPC messages.
+  An IPC message can contain either the payload length followed by the content,
+  or a 'type number' can be added between those values.
+
+  [payload length in bytes][payload]
+  [payload length in bytes][message type][payload]
+
+  The message type informs what format should be expected.
+  For example: an authentication attempt, a page request, etc.
+  Actual message formats can be found in the App.Messages folder.
+-}
+
+import Prelude (bind, (<$>), discard, ($), (>>>))
 
 import Effect (Effect)
 import Effect.Class (liftEffect)
 
-import Data.UInt (fromInt)
+import Data.UInt (fromInt, UInt)
+import Data.Tuple (Tuple(..))
 import Data.ArrayBuffer.ArrayBuffer as ArrayBuffer
 import Data.ArrayBuffer.Types (ArrayBuffer, DataView)
 import Data.ArrayBuffer.Builder as Builder
@@ -27,25 +41,38 @@ import Web.Encoding.UtfLabel as UtfLabel
 import Data.Either (Either)
 import Effect.Exception as Exception
 
-utf8ToArrayBuffer :: String -> Effect ArrayBuffer
-utf8ToArrayBuffer s = Builder.execPutM do
+hoistEffectParserT
+  :: forall a
+   . Effect a
+  -> ParserT DataView Effect a
+hoistEffectParserT
+  = Exception.try
+  >>> ExceptT
+  >>> withExceptT Exception.message
+  >>> Parsing.liftExceptT
+
+toIPC :: String -> Effect ArrayBuffer
+toIPC s = Builder.execPutM do
   textEncoder <- liftEffect TextEncoder.new
   let stringbuf = Typed.buffer $ TextEncoder.encode s textEncoder
   -- Put a 32-bit big-endian length for the utf8 string, in bytes.
   Builder.putUint32be $ fromInt $ ArrayBuffer.byteLength stringbuf
   Builder.putArrayBuffer stringbuf
 
-toIPC :: String -> Effect ArrayBuffer
-toIPC = utf8ToArrayBuffer
-
-fromIPC :: ArrayBuffer -> Effect (Either ParseError String)
-fromIPC = arrayBufferToUtf8
+toTypedIPC :: UInt -> String -> Effect ArrayBuffer
+toTypedIPC n s = Builder.execPutM do
+  textEncoder <- liftEffect TextEncoder.new
+  let stringbuf = Typed.buffer $ TextEncoder.encode s textEncoder
+  -- Put a 32-bit big-endian length for the utf8 string, in bytes.
+  Builder.putUint32be $ fromInt $ ArrayBuffer.byteLength stringbuf
+  Builder.putUint8 n
+  Builder.putArrayBuffer stringbuf
 
 -- TODO: this code doesn't verify the actual length of the message.
 -- An inconsistent length would be an error sign, message should be discarded
 -- and the connection should be closed.
-arrayBufferToUtf8 :: ArrayBuffer -> Effect (Either ParseError String)
-arrayBufferToUtf8 arrayBuffer = do
+fromIPC :: ArrayBuffer -> Effect (Either ParseError String)
+fromIPC arrayBuffer = do
   textDecoder <- TextDecoder.new UtfLabel.utf8
   let dataView = DataView.whole arrayBuffer
   runParserT dataView do
@@ -56,12 +83,20 @@ arrayBufferToUtf8 arrayBuffer = do
     stringarray <- lift $ liftEffect $ Cast.toUint8Array stringview
     hoistEffectParserT $ TextDecoder.decode stringarray textDecoder
 
-hoistEffectParserT
-  :: forall a
-   . Effect a
-  -> ParserT DataView Effect a
-hoistEffectParserT
-  = Exception.try
-  >>> ExceptT
-  >>> withExceptT Exception.message
-  >>> Parsing.liftExceptT
+-- TODO: this code doesn't verify the actual length of the message.
+-- An inconsistent length would be an error sign, message should be discarded
+-- and the connection should be closed.
+fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
+fromTypedIPC arraybuffer = do
+  textDecoder <- TextDecoder.new UtfLabel.utf8
+  let dataView = DataView.whole arraybuffer
+  runParserT dataView do
+    -- First parse a 32-bit big-endian length prefix for the length
+    -- of the UTF-8 string in bytes.
+    length <- Parsing.DataView.anyInt32be
+    -- Second parse a 8-bit unsigned integer representing the type of
+    -- the message to decode.
+    messageTypeNumber <- Parsing.DataView.anyUint8
+    stringview <- Parsing.DataView.takeN length
+    stringarray <- lift $ liftEffect $ Cast.toUint8Array stringview
+    hoistEffectParserT $ (Tuple messageTypeNumber) <$> TextDecoder.decode stringarray textDecoder