module App.IPC (toIPC, fromIPC) where import Prelude (bind, discard, ($), (>>>)) import Effect (Effect) import Effect.Class (liftEffect) import Data.UInt (fromInt) 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 utf8ToArrayBuffer :: String -> Effect ArrayBuffer utf8ToArrayBuffer 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 -- 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 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 stringview <- Parsing.DataView.takeN length 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