From ef623b8f1c04afe4f9df4e45774feee7e4a5a6af Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sat, 20 May 2023 13:50:11 +0200 Subject: [PATCH] Add an example of Websockets with ArrayBuffer. --- drop/WebSocketsWithArrayBufferStuff.purs | 189 +++++++++++++++++++++++ 1 file changed, 189 insertions(+) create mode 100644 drop/WebSocketsWithArrayBufferStuff.purs diff --git a/drop/WebSocketsWithArrayBufferStuff.purs b/drop/WebSocketsWithArrayBufferStuff.purs new file mode 100644 index 0000000..5af78f0 --- /dev/null +++ b/drop/WebSocketsWithArrayBufferStuff.purs @@ -0,0 +1,189 @@ +module Main where + +import Prelude + +import Control.Monad.Except (runExcept) +import Data.Array as Array +import Data.ArrayBuffer.DataView as DataView +import Data.ArrayBuffer.Types (ArrayBuffer, ArrayView, DataView, Int32) +import Data.Bifunctor (lmap) +import Data.Either (Either(Left, Right)) +import Data.Maybe (Maybe(Just)) +import Data.String as String +import Data.Traversable (traverse_) +import Effect (Effect) +import Effect.Class.Console as Console +import Foreign (Foreign) +import Foreign as F +import Halogen.Subscription as HS +import Web.Event.Event (Event) +import Web.Event.Event as Event +import Web.Event.EventTarget (EventTarget) +import Web.Event.EventTarget as EventTarget +import Web.Socket.BinaryType (BinaryType(ArrayBuffer)) +import Web.Socket.Event.CloseEvent (CloseEvent) +import Web.Socket.Event.CloseEvent as CloseEvent +import Web.Socket.Event.EventTypes as EventTypes +import Web.Socket.Event.MessageEvent as MessageEvent +import Web.Socket.WebSocket (WebSocket) +import Web.Socket.WebSocket as WS + +import Data.ArrayBuffer.Builder (execPut, putUint32be) + +-------------------------------------------------------------------------------- +-- Types + +data WebSocketEvent + = WSMessage Foreign + | WSClose CloseEvent + | WSOpen Event + | WSError Event + +-------------------------------------------------------------------------------- +-- Program entrypoint + +main :: Effect Unit +main = do + Console.log "1. Let's start the application!" + websocketProgram "ws://127.0.0.1:8080" + +-------------------------------------------------------------------------------- +-- Here is where you edit in what you want to happen in this program +-- in response to each type of `WebSocketEvent`. + +websocketProgram :: String -> Effect Unit +websocketProgram url = do + + Console.log "2. Let's start the application!" + webSocket <- WS.create url [] + + void $ HS.subscribe (webSocketEmitter webSocket) case _ of + + WSOpen _event -> do + Console.log "Open event" + WS.setBinaryType webSocket ArrayBuffer + -- Console.log "WS set to binary, let's send something!" + -- sendArrayBuffer webSocket + + WSMessage foreign' -> do + Console.log "Message event" + case foreignToDataView foreign' of + Left errs -> + Console.error errs + Right dataView -> do + Console.log "Do something with this DataView!" + let + byteOffset = 0 + number = DataView.getInt32be dataView byteOffset + Console.log "Received number is: " <> show number + -- DataView.getInt32be dataView byteOffset >>= traverse_ \int32 -> + -- Console.log $ mkMessage byteOffset int32 + + WSClose _closeEvent -> do + Console.log "Close event" + + WSError _event -> do + Console.log "Error event" + +mkMessage :: Int -> Int -> String +mkMessage byteOffset i32 = + "The Int32 at ByteOffset " <> show byteOffset <> " was " <> show i32 + +-------------------------------------------------------------------------------- +-- A unified emitter (of the 4 websocket event types) that we subscribe to once +-- as you see in `webSocketProgram` above. +webSocketEmitter + :: WebSocket + -> HS.Emitter WebSocketEvent +webSocketEmitter webSocket = + HS.makeEmitter \pushWsEvent -> do + messageId <- HS.subscribe messageEmitter (pushWsEvent <<< WSMessage) + closeId <- HS.subscribe closeEmitter (pushWsEvent <<< WSClose) + openId <- HS.subscribe openEmitter (pushWsEvent <<< WSOpen) + errorId <- HS.subscribe errorEmitter (pushWsEvent <<< WSError) + + pure do + HS.unsubscribe messageId + HS.unsubscribe closeId + HS.unsubscribe openId + HS.unsubscribe errorId + + where + target :: EventTarget + target = WS.toEventTarget webSocket + + fromMessageEvent :: Event -> Maybe Foreign + fromMessageEvent event = do + messageEvent <- MessageEvent.fromEvent event + pure $ MessageEvent.data_ messageEvent + + messageEmitter = mkEventListener EventTypes.onMessage target fromMessageEvent + closeEmitter = mkEventListener EventTypes.onClose target CloseEvent.fromEvent + openEmitter = mkEventListener EventTypes.onOpen target Just + errorEmitter = mkEventListener EventTypes.onError target Just + +-------------------------------------------------------------------------------- +-- If the websocket is sending you back array buffers, this might be used to +-- assist you in decoding those array buffers from the MessageEvent's data. + +foreignToArrayBuffer :: Foreign -> Either String ArrayBuffer +foreignToArrayBuffer + = lmap renderForeignErrors + <<< runExcept + <<< F.unsafeReadTagged "ArrayBuffer" + where + renderForeignErrors :: F.MultipleErrors -> String + renderForeignErrors = + String.joinWith "; " <<< Array.fromFoldable <<< map F.renderForeignError + +arrayBufferToDataView :: ArrayBuffer -> DataView +arrayBufferToDataView = DataView.whole + +foreignToDataView :: Foreign -> Either String DataView +foreignToDataView = map arrayBufferToDataView <<< foreignToArrayBuffer + +{- + +From monoidmusician's link to the `Data.ArrayBuffer.DataView` module: + + -- Fetch big-endian int32 value at a certain index in a DataView. + DataView.getInt32be :: DataView -> ByteOffset -> Effect (Maybe Int) + + -- Store big-endian int32 value at a certain index in a DataView. + DataView.setInt32be :: DataView -> ByteOffset -> Int -> Effect Boolean + +Using `DataView.getInt32be` on the `DataView` obtained above should be like +this JS example in the MDN docs: + + https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/binaryType#examples + +-} + + +-------------------------------------------------------------------------------- +-- The module `Web.Socket.WebSocket` in the `purescript-web-socket` package does +-- have these two functions below if you want to send just an `ArrayBuffer` or +-- `ArrayView` alone. + +sendArrayBuffer :: WebSocket -> ArrayBuffer -> Effect Unit +sendArrayBuffer = WS.sendArrayBuffer + +sendArrayBufferView :: WebSocket -> ArrayView Int32 -> Effect Unit +sendArrayBufferView = WS.sendArrayBufferView + +-------------------------------------------------------------------------------- +-- Taken directly from `Halogen.Query.Event.eventListener`. I find it's nicer +-- to use and re-use this (...than working directly with `addEventListener`, +-- `removeEventListener`, etc. each time). +mkEventListener + :: forall a + . Event.EventType + -> EventTarget.EventTarget + -> (Event.Event -> Maybe a) + -> HS.Emitter a +mkEventListener eventType target f = + HS.makeEmitter \push -> do + listener <- EventTarget.eventListener \ev -> traverse_ push (f ev) + EventTarget.addEventListener eventType listener false target + pure do + EventTarget.removeEventListener eventType listener false target