IPC: final message format (typed messages) is implemented.

This commit is contained in:
Philippe Pittoli 2023-05-21 16:04:43 +02:00
parent faa258b54e
commit 0d99e00e93

View File

@ -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