103 lines
4.0 KiB
Plaintext
103 lines
4.0 KiB
Plaintext
module App.IPC (toIPC, fromIPC, toTypedIPC, fromTypedIPC) where
|
|
|
|
{-
|
|
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, toInt, UInt)
|
|
import Data.Tuple (Tuple(..))
|
|
import Data.ArrayBuffer.ArrayBuffer as ArrayBuffer
|
|
import Data.ArrayBuffer.Types (ArrayBuffer, DataView)
|
|
import Data.ArrayBuffer.Builder as Builder
|
|
|
|
import Data.ArrayBuffer.Cast as Cast
|
|
|
|
import Control.Monad.Trans.Class (lift)
|
|
import Control.Monad.Except (ExceptT(ExceptT), withExceptT)
|
|
import Data.ArrayBuffer.Typed as Typed
|
|
import Data.ArrayBuffer.DataView as DataView
|
|
import Parsing.DataView as Parsing.DataView
|
|
import Parsing as Parsing
|
|
import Parsing (ParseError, ParserT, runParserT)
|
|
|
|
import Web.Encoding.TextEncoder as TextEncoder
|
|
import Web.Encoding.TextDecoder as TextDecoder
|
|
import Web.Encoding.UtfLabel as UtfLabel
|
|
|
|
import Data.Either (Either)
|
|
import Effect.Exception as Exception
|
|
|
|
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
|
|
|
|
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) + 1 -- 1 for message type
|
|
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.
|
|
fromIPC :: ArrayBuffer -> Effect (Either ParseError String)
|
|
fromIPC 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.anyUint32be
|
|
stringview <- Parsing.DataView.takeN (toInt length)
|
|
stringarray <- lift $ liftEffect $ Cast.toUint8Array stringview
|
|
hoistEffectParserT $ TextDecoder.decode stringarray textDecoder
|
|
|
|
-- 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.anyUint32be
|
|
-- Second parse a 8-bit unsigned integer representing the type of
|
|
-- the message to decode.
|
|
messageTypeNumber <- Parsing.DataView.anyUint8
|
|
stringview <- Parsing.DataView.takeN ((toInt length) - 1)
|
|
stringarray <- lift $ liftEffect $ Cast.toUint8Array stringview
|
|
hoistEffectParserT $ (Tuple messageTypeNumber) <$> TextDecoder.decode stringarray textDecoder
|