blob: 273be85fb7fc381e96ee4f69f6d02e480e21bd6e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
module WebSocket (
Connection,
startClient,
sendMessage,
receiveMessage,
) where
import Control.Concurrent.Chan
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe
import Data.Word
import Foreign.Marshal.Alloc
import Foreign.Ptr
import GHC.Wasm.Prim
import JavaScript qualified as JS
data Connection = Connection
{ connJS :: JSVal
, connInQueue :: Chan ByteString
}
startClient :: String -> Int -> String -> (Connection -> IO ()) -> IO ()
startClient addr port path fun = do
connJS <- js_initWebSocket (toJSString $ "ws://" <> addr <> ":" <> show port <> "/" <> path)
connInQueue <- newChan
let conn = Connection {..}
onOpen <- JS.asEventListener $ \_ -> do
fun conn
onMessage <- JS.asEventListener $ \ev -> do
bytes <- js_get_data ev
len <- js_get_byteLength bytes
ptr <- mallocBytes len
js_copyBytes ptr bytes
bs <- unsafePackCStringFinalizer ptr len (free ptr)
writeChan connInQueue bs
JS.addEventListener connJS (toJSString "open") onOpen
JS.addEventListener connJS (toJSString "message") onMessage
sendMessage :: Connection -> ByteString -> IO ()
sendMessage Connection {..} bs = do
unsafeUseAsCStringLen bs $ \( ptr, len ) -> do
js_send connJS (castPtr ptr) len
receiveMessage :: Connection -> IO ByteString
receiveMessage Connection {..} = do
readChan connInQueue
foreign import javascript unsafe "const ws = new WebSocket($1); ws.binaryType = 'arraybuffer'; return ws"
js_initWebSocket :: JSString -> IO JSVal
foreign import javascript unsafe "$1.send(new Uint8Array(globalThis.wasi_memory.buffer, $2, $3))"
js_send :: JSVal -> Ptr Word8 -> Int -> IO ()
foreign import javascript unsafe "$1.data"
js_get_data :: JSVal -> IO JSVal
foreign import javascript unsafe "$1.byteLength"
js_get_byteLength :: JSVal -> IO Int
foreign import javascript unsafe "new Uint8Array(globalThis.wasi_memory.buffer, $1, $2.byteLength).set(new Uint8Array($2))"
js_copyBytes :: Ptr Word8 -> JSVal -> IO ()
|