-1
bench/client/dune
-1
bench/client/dune
-1
bench/dream/dune
-1
bench/dream/dune
-7
bench/hcs/dune
-7
bench/hcs/dune
···
1
1
(executable
2
2
(name bench_server)
3
-
(public_name bench-hcs)
4
3
(libraries hcs eio_main yojson climate))
5
4
6
5
(executable
7
6
(name bench_server_fast)
8
-
(public_name bench-hcs-fast)
9
7
(libraries hcs eio_main yojson climate))
10
8
11
9
(executable
12
10
(name bench_server_h2)
13
-
(public_name bench-hcs-h2)
14
11
(libraries hcs eio_main yojson climate bigstringaf))
15
12
16
13
(executable
17
14
(name bench_server_unified)
18
-
(public_name bench-hcs-unified)
19
15
(libraries hcs eio_main yojson climate bigstringaf))
20
16
21
17
(executable
22
18
(name bench_pubsub)
23
-
(public_name bench-pubsub)
24
19
(libraries hcs eio_main climate unix))
25
20
26
21
(executable
27
22
(name bench_channel)
28
-
(public_name bench-channel)
29
23
(libraries hcs climate unix))
30
24
31
25
(executable
32
26
(name bench_buffers)
33
-
(public_name bench-buffers)
34
27
(libraries hcs cstruct bigstringaf unix))
-1
bench/piaf/dune
-1
bench/piaf/dune
-1
bin/las/dune
-1
bin/las/dune
+1
-1
dune-project
+1
-1
dune-project
+1
-1
hcs.opam
+1
-1
hcs.opam
···
1
1
# This file is generated by dune, edit dune-project instead
2
2
opam-version: "2.0"
3
-
version: "0.1.0"
3
+
version: "0.1.1"
4
4
synopsis: "Eio based HTTP client/server library for OCaml 5+"
5
5
description:
6
6
"HCS is a HTTP client/server library for OCaml 5+ supporting HTTP/1.1, HTTP/2, and WebSocket. Built on Eio."
+13
-12
lib/server.ml
+13
-12
lib/server.ml
···
481
481
end
482
482
| `Yield -> H1.Server_connection.yield_reader conn read_loop
483
483
| `Close -> shutdown := true
484
-
| `Upgrade -> shutdown := true
484
+
| `Upgrade -> ()
485
485
in
486
486
487
487
let rec write_loop () =
488
-
if not !shutdown then
489
-
match H1.Server_connection.next_write_operation conn with
490
-
| `Write iovecs ->
491
-
let write_result = writev flow iovecs in
492
-
H1.Server_connection.report_write_result conn write_result;
493
-
write_loop ()
494
-
| `Yield ->
488
+
match H1.Server_connection.next_write_operation conn with
489
+
| `Write iovecs ->
490
+
let write_result = writev flow iovecs in
491
+
H1.Server_connection.report_write_result conn write_result;
492
+
write_loop ()
493
+
| `Yield ->
494
+
if not !shutdown then begin
495
495
let continue = Eio.Promise.create () in
496
496
H1.Server_connection.yield_writer conn (fun () ->
497
497
Eio.Promise.resolve (snd continue) ());
498
498
Eio.Promise.await (fst continue);
499
499
write_loop ()
500
-
| `Close _ ->
501
-
shutdown := true;
502
-
shutdown_flow flow `Send
503
-
| `Upgrade -> shutdown := true
500
+
end
501
+
| `Close _ ->
502
+
shutdown := true;
503
+
shutdown_flow flow `Send
504
+
| `Upgrade -> ()
504
505
in
505
506
506
507
Fiber.both read_loop write_loop;
+5
test/dune
+5
test/dune
+126
test/test_websocket.ml
+126
test/test_websocket.ml
···
1
+
let () =
2
+
Eio_main.run @@ fun env ->
3
+
let net = Eio.Stdenv.net env in
4
+
let clock = Eio.Stdenv.clock env in
5
+
let port = 19283 in
6
+
7
+
Eio.Switch.run @@ fun sw ->
8
+
Eio.Fiber.fork ~sw (fun () ->
9
+
let config =
10
+
Hcs.Server.{ websocket_config with port; gc_tuning = None }
11
+
in
12
+
13
+
let handler req =
14
+
Hcs.Server.respond ~status:`OK ("HTTP: " ^ req.Hcs.Server.target)
15
+
in
16
+
17
+
let ws_handler ws =
18
+
let rec loop () =
19
+
match Hcs.Websocket.recv_message ws with
20
+
| Error Hcs.Websocket.Connection_closed -> ()
21
+
| Error _ -> ()
22
+
| Ok (_, msg) -> (
23
+
match Hcs.Websocket.send_text ws ("echo: " ^ msg) with
24
+
| Ok () -> loop ()
25
+
| Error _ -> ())
26
+
in
27
+
loop ()
28
+
in
29
+
30
+
Hcs.Server.run ~sw ~net ~config ~ws_handler handler);
31
+
32
+
Eio.Time.sleep clock 0.2;
33
+
34
+
Eio.traceln "Test 1: HTTP request...";
35
+
(match
36
+
Hcs.Client.get ~sw ~net ~clock
37
+
("http://127.0.0.1:" ^ string_of_int port ^ "/hello")
38
+
with
39
+
| Ok resp ->
40
+
let body = resp.Hcs.Client.body in
41
+
if body = "HTTP: /hello" then Eio.traceln " PASS: HTTP response correct"
42
+
else Eio.traceln " FAIL: Expected 'HTTP: /hello', got '%s'" body
43
+
| Error _ -> Eio.traceln " FAIL: HTTP error");
44
+
45
+
Eio.traceln "Test 2: WebSocket on / path...";
46
+
(match
47
+
Hcs.Websocket.connect ~sw ~net
48
+
("ws://127.0.0.1:" ^ string_of_int port ^ "/")
49
+
with
50
+
| Ok ws ->
51
+
(match Hcs.Websocket.send_text ws "hello from client" with
52
+
| Ok () -> (
53
+
match Hcs.Websocket.recv_message ws with
54
+
| Ok (_, msg) ->
55
+
if msg = "echo: hello from client" then
56
+
Eio.traceln " PASS: WebSocket echo correct"
57
+
else
58
+
Eio.traceln
59
+
" FAIL: Expected 'echo: hello from client', got '%s'" msg
60
+
| Error e ->
61
+
Eio.traceln " FAIL: recv error: %s"
62
+
(match e with
63
+
| Hcs.Websocket.Connection_closed -> "closed"
64
+
| Hcs.Websocket.Protocol_error s -> "protocol: " ^ s
65
+
| Hcs.Websocket.Io_error s -> "io: " ^ s))
66
+
| Error _ -> Eio.traceln " FAIL: send error");
67
+
Hcs.Websocket.close ws
68
+
| Error e ->
69
+
Eio.traceln " FAIL: WebSocket connect error: %s"
70
+
(match e with
71
+
| Hcs.Websocket.Connection_closed -> "closed"
72
+
| Hcs.Websocket.Protocol_error s -> "protocol: " ^ s
73
+
| Hcs.Websocket.Io_error s -> "io: " ^ s));
74
+
75
+
Eio.traceln "Test 3: WebSocket on /ws/chat path...";
76
+
(match
77
+
Hcs.Websocket.connect ~sw ~net
78
+
("ws://127.0.0.1:" ^ string_of_int port ^ "/ws/chat")
79
+
with
80
+
| Ok ws ->
81
+
(match Hcs.Websocket.send_text ws "test message" with
82
+
| Ok () -> (
83
+
match Hcs.Websocket.recv_message ws with
84
+
| Ok (_, msg) ->
85
+
if msg = "echo: test message" then
86
+
Eio.traceln " PASS: WebSocket on path works"
87
+
else Eio.traceln " FAIL: Wrong response: '%s'" msg
88
+
| Error _ -> Eio.traceln " FAIL: recv error")
89
+
| Error _ -> Eio.traceln " FAIL: send error");
90
+
Hcs.Websocket.close ws
91
+
| Error e ->
92
+
Eio.traceln " FAIL: WebSocket connect error: %s"
93
+
(match e with
94
+
| Hcs.Websocket.Connection_closed -> "closed"
95
+
| Hcs.Websocket.Protocol_error s -> "protocol: " ^ s
96
+
| Hcs.Websocket.Io_error s -> "io: " ^ s));
97
+
98
+
Eio.traceln "Test 4: Multiple messages...";
99
+
(match
100
+
Hcs.Websocket.connect ~sw ~net
101
+
("ws://127.0.0.1:" ^ string_of_int port ^ "/")
102
+
with
103
+
| Ok ws ->
104
+
let all_ok = ref true in
105
+
for i = 1 to 5 do
106
+
let msg = "message " ^ string_of_int i in
107
+
match Hcs.Websocket.send_text ws msg with
108
+
| Ok () -> (
109
+
match Hcs.Websocket.recv_message ws with
110
+
| Ok (_, resp) ->
111
+
if resp <> "echo: " ^ msg then begin
112
+
Eio.traceln " FAIL: Wrong response for message %d" i;
113
+
all_ok := false
114
+
end
115
+
| Error _ ->
116
+
Eio.traceln " FAIL: recv error on message %d" i;
117
+
all_ok := false)
118
+
| Error _ ->
119
+
Eio.traceln " FAIL: send error on message %d" i;
120
+
all_ok := false
121
+
done;
122
+
if !all_ok then Eio.traceln " PASS: All 5 messages echoed correctly";
123
+
Hcs.Websocket.close ws
124
+
| Error _ -> Eio.traceln " FAIL: Connect error");
125
+
126
+
Eio.traceln "Tests complete."