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

master
Philippe Pittoli 2023-05-21 16:04:43 +02:00
parent faa258b54e
commit 0d99e00e93
1 changed files with 56 additions and 21 deletions

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 (Effect)
import Effect.Class (liftEffect) 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.ArrayBuffer as ArrayBuffer
import Data.ArrayBuffer.Types (ArrayBuffer, DataView) import Data.ArrayBuffer.Types (ArrayBuffer, DataView)
import Data.ArrayBuffer.Builder as Builder import Data.ArrayBuffer.Builder as Builder
@ -27,25 +41,38 @@ import Web.Encoding.UtfLabel as UtfLabel
import Data.Either (Either) import Data.Either (Either)
import Effect.Exception as Exception import Effect.Exception as Exception
utf8ToArrayBuffer :: String -> Effect ArrayBuffer hoistEffectParserT
utf8ToArrayBuffer s = Builder.execPutM do :: 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 textEncoder <- liftEffect TextEncoder.new
let stringbuf = Typed.buffer $ TextEncoder.encode s textEncoder let stringbuf = Typed.buffer $ TextEncoder.encode s textEncoder
-- Put a 32-bit big-endian length for the utf8 string, in bytes. -- Put a 32-bit big-endian length for the utf8 string, in bytes.
Builder.putUint32be $ fromInt $ ArrayBuffer.byteLength stringbuf Builder.putUint32be $ fromInt $ ArrayBuffer.byteLength stringbuf
Builder.putArrayBuffer stringbuf Builder.putArrayBuffer stringbuf
toIPC :: String -> Effect ArrayBuffer toTypedIPC :: UInt -> String -> Effect ArrayBuffer
toIPC = utf8ToArrayBuffer toTypedIPC n s = Builder.execPutM do
textEncoder <- liftEffect TextEncoder.new
fromIPC :: ArrayBuffer -> Effect (Either ParseError String) let stringbuf = Typed.buffer $ TextEncoder.encode s textEncoder
fromIPC = arrayBufferToUtf8 -- 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. -- TODO: this code doesn't verify the actual length of the message.
-- An inconsistent length would be an error sign, message should be discarded -- An inconsistent length would be an error sign, message should be discarded
-- and the connection should be closed. -- and the connection should be closed.
arrayBufferToUtf8 :: ArrayBuffer -> Effect (Either ParseError String) fromIPC :: ArrayBuffer -> Effect (Either ParseError String)
arrayBufferToUtf8 arrayBuffer = do fromIPC arrayBuffer = do
textDecoder <- TextDecoder.new UtfLabel.utf8 textDecoder <- TextDecoder.new UtfLabel.utf8
let dataView = DataView.whole arrayBuffer let dataView = DataView.whole arrayBuffer
runParserT dataView do runParserT dataView do
@ -56,12 +83,20 @@ arrayBufferToUtf8 arrayBuffer = do
stringarray <- lift $ liftEffect $ Cast.toUint8Array stringview stringarray <- lift $ liftEffect $ Cast.toUint8Array stringview
hoistEffectParserT $ TextDecoder.decode stringarray textDecoder hoistEffectParserT $ TextDecoder.decode stringarray textDecoder
hoistEffectParserT -- TODO: this code doesn't verify the actual length of the message.
:: forall a -- An inconsistent length would be an error sign, message should be discarded
. Effect a -- and the connection should be closed.
-> ParserT DataView Effect a fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
hoistEffectParserT fromTypedIPC arraybuffer = do
= Exception.try textDecoder <- TextDecoder.new UtfLabel.utf8
>>> ExceptT let dataView = DataView.whole arraybuffer
>>> withExceptT Exception.message runParserT dataView do
>>> Parsing.liftExceptT -- 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