WebSocket frame codec (RFC 6455)
irmin: add Sync module, worktree.ml, cmd_push
- Sync: TRANSPORT module type (fetch/push) + resolver type for
conflict resolution strategies (Fail, Ours, Theirs, Custom)
- Worktree: checkout, status, commit against the filesystem with
.irmin/index tracking (mtime+size fast path, hash on change)
- cmd_push: push local branch to remote Git repo (fast-forward only,
CAS on remote ref)
- Export Irmin.Sync in irmin.ml/mli
+620
+19
dune-project
+19
dune-project
···
1
+
(lang dune 3.17)
2
+
(name websocket)
3
+
4
+
(generate_opam_files true)
5
+
6
+
(license ISC)
7
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
8
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
10
+
(package
11
+
(name websocket)
12
+
(synopsis "WebSocket frame codec (RFC 6455)")
13
+
(description
14
+
"Encode and decode WebSocket frames. Handles masking, fragmentation,
15
+
ping/pong, and close frames. Does not handle the HTTP upgrade handshake.")
16
+
(depends
17
+
(ocaml (>= 5.2))
18
+
(fmt (>= 0.9))
19
+
(alcotest :with-test)))
+1
fuzz/fuzz.ml
+1
fuzz/fuzz.ml
···
1
+
let () = Alcobar.run "websocket" [ Fuzz_websocket.suite ]
+67
fuzz/fuzz_websocket.ml
+67
fuzz/fuzz_websocket.ml
···
1
+
(** Fuzz tests for WebSocket frame codec. *)
2
+
3
+
open Alcobar
4
+
5
+
let opcode =
6
+
choose
7
+
[
8
+
const Websocket.Continuation;
9
+
const Websocket.Text;
10
+
const Websocket.Binary;
11
+
const Websocket.Close;
12
+
const Websocket.Ping;
13
+
const Websocket.Pong;
14
+
]
15
+
16
+
(* Decode never crashes on arbitrary input *)
17
+
let test_decode_no_crash data =
18
+
let _ = Websocket.decode data in
19
+
check true
20
+
21
+
(* Unmasked encode→decode roundtrip preserves content *)
22
+
let test_unmasked_roundtrip fin op payload =
23
+
let frame = { Websocket.fin; opcode = op; payload } in
24
+
let encoded = Websocket.encode ~mask:false frame in
25
+
match Websocket.decode encoded with
26
+
| Ok (decoded, rest) ->
27
+
check_eq ~pp:Fmt.bool decoded.fin fin;
28
+
check_eq ~pp:Fmt.string decoded.payload payload;
29
+
check_eq ~pp:Fmt.string rest ""
30
+
| Error `Need_more -> fail "unexpected Need_more"
31
+
| Error (`Invalid msg) -> fail msg
32
+
33
+
(* Masked encode→decode roundtrip preserves content *)
34
+
let test_masked_roundtrip fin op payload =
35
+
let frame = { Websocket.fin; opcode = op; payload } in
36
+
let encoded = Websocket.encode ~mask:true frame in
37
+
match Websocket.decode encoded with
38
+
| Ok (decoded, _) ->
39
+
check_eq ~pp:Fmt.bool decoded.fin fin;
40
+
check_eq ~pp:Fmt.string decoded.payload payload
41
+
| Error `Need_more -> fail "unexpected Need_more"
42
+
| Error (`Invalid msg) -> fail msg
43
+
44
+
(* Concatenated frames decode independently *)
45
+
let test_concat_roundtrip p1 p2 =
46
+
let f1 = Websocket.text p1 in
47
+
let f2 = Websocket.binary p2 in
48
+
let buf = Websocket.encode ~mask:false f1 ^ Websocket.encode ~mask:false f2 in
49
+
match Websocket.decode buf with
50
+
| Ok (d1, rest) -> (
51
+
check_eq ~pp:Fmt.string d1.payload p1;
52
+
match Websocket.decode rest with
53
+
| Ok (d2, rest2) ->
54
+
check_eq ~pp:Fmt.string d2.payload p2;
55
+
check_eq ~pp:Fmt.string rest2 ""
56
+
| Error _ -> fail "second decode failed")
57
+
| Error _ -> fail "first decode failed"
58
+
59
+
let suite =
60
+
( "websocket",
61
+
[
62
+
test_case "decode no crash" [ bytes ] test_decode_no_crash;
63
+
test_case "unmasked roundtrip" [ bool; opcode; bytes ]
64
+
test_unmasked_roundtrip;
65
+
test_case "masked roundtrip" [ bool; opcode; bytes ] test_masked_roundtrip;
66
+
test_case "concat roundtrip" [ bytes; bytes ] test_concat_roundtrip;
67
+
] )
+4
fuzz/fuzz_websocket.mli
+4
fuzz/fuzz_websocket.mli
+145
lib/websocket.ml
+145
lib/websocket.ml
···
1
+
(* WebSocket frame codec — RFC 6455 §5 *)
2
+
3
+
type opcode = Continuation | Text | Binary | Close | Ping | Pong
4
+
5
+
let pp_opcode ppf = function
6
+
| Continuation -> Fmt.string ppf "continuation"
7
+
| Text -> Fmt.string ppf "text"
8
+
| Binary -> Fmt.string ppf "binary"
9
+
| Close -> Fmt.string ppf "close"
10
+
| Ping -> Fmt.string ppf "ping"
11
+
| Pong -> Fmt.string ppf "pong"
12
+
13
+
let opcode_to_int = function
14
+
| Continuation -> 0
15
+
| Text -> 1
16
+
| Binary -> 2
17
+
| Close -> 8
18
+
| Ping -> 9
19
+
| Pong -> 10
20
+
21
+
let opcode_of_int = function
22
+
| 0 -> Some Continuation
23
+
| 1 -> Some Text
24
+
| 2 -> Some Binary
25
+
| 8 -> Some Close
26
+
| 9 -> Some Ping
27
+
| 10 -> Some Pong
28
+
| _ -> None
29
+
30
+
type t = { fin : bool; opcode : opcode; payload : string }
31
+
32
+
let text s = { fin = true; opcode = Text; payload = s }
33
+
let binary s = { fin = true; opcode = Binary; payload = s }
34
+
let ping s = { fin = true; opcode = Ping; payload = s }
35
+
let pong s = { fin = true; opcode = Pong; payload = s }
36
+
37
+
let close ?(code = 1000) ?(reason = "") () =
38
+
let payload =
39
+
if code = 0 && reason = "" then ""
40
+
else
41
+
let buf = Bytes.create (2 + String.length reason) in
42
+
Bytes.set_uint16_be buf 0 code;
43
+
Bytes.blit_string reason 0 buf 2 (String.length reason);
44
+
Bytes.to_string buf
45
+
in
46
+
{ fin = true; opcode = Close; payload }
47
+
48
+
let pp ppf t =
49
+
Fmt.pf ppf "%a%s %d bytes" pp_opcode t.opcode
50
+
(if t.fin then "" else " (fragment)")
51
+
(String.length t.payload)
52
+
53
+
(* Masking: XOR payload with 4-byte key *)
54
+
let mask_payload key payload =
55
+
let len = String.length payload in
56
+
let buf = Bytes.create len in
57
+
for i = 0 to len - 1 do
58
+
let b = Char.code payload.[i] lxor Char.code key.[i land 3] in
59
+
Bytes.set buf i (Char.chr b)
60
+
done;
61
+
Bytes.to_string buf
62
+
63
+
let random_mask_key () =
64
+
let buf = Bytes.create 4 in
65
+
for i = 0 to 3 do
66
+
Bytes.set buf i (Char.chr (Random.int 256))
67
+
done;
68
+
Bytes.to_string buf
69
+
70
+
(* Encode *)
71
+
72
+
let encode ?(mask = true) frame =
73
+
let len = String.length frame.payload in
74
+
let buf = Buffer.create (2 + 8 + 4 + len) in
75
+
(* Byte 0: FIN + opcode *)
76
+
let b0 = (if frame.fin then 0x80 else 0) lor opcode_to_int frame.opcode in
77
+
Buffer.add_char buf (Char.chr b0);
78
+
(* Byte 1: MASK + payload length *)
79
+
let mask_bit = if mask then 0x80 else 0 in
80
+
if len < 126 then Buffer.add_char buf (Char.chr (mask_bit lor len))
81
+
else if len < 65536 then (
82
+
Buffer.add_char buf (Char.chr (mask_bit lor 126));
83
+
Buffer.add_char buf (Char.chr ((len lsr 8) land 0xFF));
84
+
Buffer.add_char buf (Char.chr (len land 0xFF)))
85
+
else (
86
+
Buffer.add_char buf (Char.chr (mask_bit lor 127));
87
+
for i = 7 downto 0 do
88
+
Buffer.add_char buf (Char.chr ((len lsr (i * 8)) land 0xFF))
89
+
done);
90
+
(* Masking key + payload *)
91
+
if mask then (
92
+
let key = random_mask_key () in
93
+
Buffer.add_string buf key;
94
+
Buffer.add_string buf (mask_payload key frame.payload))
95
+
else Buffer.add_string buf frame.payload;
96
+
Buffer.contents buf
97
+
98
+
(* Decode *)
99
+
100
+
let get_byte s i = Char.code (String.get s i)
101
+
102
+
let decode buf =
103
+
let blen = String.length buf in
104
+
if blen < 2 then Error `Need_more
105
+
else
106
+
let b0 = get_byte buf 0 in
107
+
let b1 = get_byte buf 1 in
108
+
let fin = b0 land 0x80 <> 0 in
109
+
let opcode_n = b0 land 0x0F in
110
+
let masked = b1 land 0x80 <> 0 in
111
+
let payload_len_7 = b1 land 0x7F in
112
+
match opcode_of_int opcode_n with
113
+
| None -> Error (`Invalid (Fmt.str "unknown opcode %d" opcode_n))
114
+
| Some opcode ->
115
+
let header_end, payload_len =
116
+
if payload_len_7 < 126 then (2, payload_len_7)
117
+
else if payload_len_7 = 126 then
118
+
if blen < 4 then (4, -1)
119
+
else (4, (get_byte buf 2 lsl 8) lor get_byte buf 3)
120
+
else if blen < 10 then (10, -1)
121
+
else
122
+
let len = ref 0 in
123
+
for i = 0 to 7 do
124
+
len := (!len lsl 8) lor get_byte buf (2 + i)
125
+
done;
126
+
(10, !len)
127
+
in
128
+
if payload_len < 0 then Error `Need_more
129
+
else
130
+
let mask_len = if masked then 4 else 0 in
131
+
let total = header_end + mask_len + payload_len in
132
+
if blen < total then Error `Need_more
133
+
else
134
+
let payload_start = header_end + mask_len in
135
+
let raw_payload = String.sub buf payload_start payload_len in
136
+
let payload =
137
+
if masked then
138
+
let key = String.sub buf header_end 4 in
139
+
mask_payload key raw_payload
140
+
else raw_payload
141
+
in
142
+
let rest =
143
+
if total < blen then String.sub buf total (blen - total) else ""
144
+
in
145
+
Ok ({ fin; opcode; payload }, rest)
+56
lib/websocket.mli
+56
lib/websocket.mli
···
1
+
(** WebSocket frame codec (RFC 6455).
2
+
3
+
Encode and decode WebSocket frames. Handles masking, fragmentation,
4
+
ping/pong, and close frames. Does NOT handle the HTTP upgrade handshake —
5
+
see [ocaml-requests] for that.
6
+
7
+
{[
8
+
let frame = Frame.text "hello" in
9
+
let bytes = Frame.encode frame in
10
+
match Frame.decode bytes with
11
+
| Ok (frame, rest) -> ...
12
+
| Error `Need_more -> (* incomplete frame *)
13
+
]} *)
14
+
15
+
(** {1 Opcode} *)
16
+
17
+
type opcode = Continuation | Text | Binary | Close | Ping | Pong
18
+
19
+
val pp_opcode : opcode Fmt.t
20
+
21
+
(** {1 Frames} *)
22
+
23
+
type t = {
24
+
fin : bool; (** Final fragment. *)
25
+
opcode : opcode;
26
+
payload : string;
27
+
}
28
+
29
+
val text : string -> t
30
+
(** [text s] is a final text frame with payload [s]. *)
31
+
32
+
val binary : string -> t
33
+
(** [binary s] is a final binary frame with payload [s]. *)
34
+
35
+
val ping : string -> t
36
+
(** [ping s] is a ping frame. Payload is at most 125 bytes. *)
37
+
38
+
val pong : string -> t
39
+
(** [pong s] is a pong frame. *)
40
+
41
+
val close : ?code:int -> ?reason:string -> unit -> t
42
+
(** [close ?code ?reason ()] is a close frame. *)
43
+
44
+
val pp : t Fmt.t
45
+
46
+
(** {1 Encoding} *)
47
+
48
+
val encode : ?mask:bool -> t -> string
49
+
(** [encode ?mask frame] serializes [frame]. Client frames MUST be masked
50
+
([mask=true], the default). Server frames MUST NOT be masked. *)
51
+
52
+
(** {1 Decoding} *)
53
+
54
+
val decode : string -> (t * string, [ `Need_more | `Invalid of string ]) result
55
+
(** [decode buf] attempts to decode one frame from [buf]. Returns the frame and
56
+
the remaining bytes, or [`Need_more] if the buffer is incomplete. *)
+288
test/test.ml
+288
test/test.ml
···
1
+
(** Tests for WebSocket frame codec.
2
+
3
+
Test vectors derived from RFC 6455 §5.7 examples and adversarial edge cases.
4
+
Follows the same structure as ocaml-sse tests: spec vectors, incremental
5
+
parsing, and degenerate inputs. *)
6
+
7
+
let ws =
8
+
Alcotest.testable Websocket.pp (fun a b ->
9
+
a.Websocket.fin = b.fin && a.opcode = b.opcode && a.payload = b.payload)
10
+
11
+
(* {1 RFC 6455 §5.7 Examples} *)
12
+
13
+
(* Source: RFC 6455 §5.7 "A single-frame unmasked text message" *)
14
+
let test_rfc_unmasked_text () =
15
+
let bytes = "\x81\x05Hello" in
16
+
match Websocket.decode bytes with
17
+
| Ok (f, rest) ->
18
+
Alcotest.(check ws)
19
+
"unmasked Hello"
20
+
{ fin = true; opcode = Text; payload = "Hello" }
21
+
f;
22
+
Alcotest.(check string) "no rest" "" rest
23
+
| Error _ -> Alcotest.fail "decode failed"
24
+
25
+
(* Source: RFC 6455 §5.7 "A single-frame masked text message" *)
26
+
let test_rfc_masked_text () =
27
+
(* Mask key: 37 fa 21 3d, masked "Hello" *)
28
+
let bytes = "\x81\x85\x37\xfa\x21\x3d\x7f\x9f\x4d\x51\x58" in
29
+
match Websocket.decode bytes with
30
+
| Ok (f, _) ->
31
+
Alcotest.(check ws)
32
+
"masked Hello"
33
+
{ fin = true; opcode = Text; payload = "Hello" }
34
+
f
35
+
| Error _ -> Alcotest.fail "decode failed"
36
+
37
+
(* Source: RFC 6455 §5.7 "A fragmented unmasked text message" *)
38
+
let test_rfc_fragmented () =
39
+
let frag1 = "\x01\x03Hel" in
40
+
let frag2 = "\x80\x02lo" in
41
+
match Websocket.decode frag1 with
42
+
| Ok (f1, _) -> (
43
+
Alcotest.(check bool) "not fin" false f1.fin;
44
+
Alcotest.(check string) "first fragment" "Hel" f1.payload;
45
+
match Websocket.decode frag2 with
46
+
| Ok (f2, _) ->
47
+
Alcotest.(check bool) "fin" true f2.fin;
48
+
Alcotest.(check string) "second fragment" "lo" f2.payload
49
+
| Error _ -> Alcotest.fail "decode frag2 failed")
50
+
| Error _ -> Alcotest.fail "decode frag1 failed"
51
+
52
+
(* Source: RFC 6455 §5.7 "Unmasked Ping request and masked Ping response" *)
53
+
let test_rfc_ping () =
54
+
let bytes = "\x89\x05Hello" in
55
+
match Websocket.decode bytes with
56
+
| Ok (f, _) ->
57
+
Alcotest.(check ws)
58
+
"ping"
59
+
{ fin = true; opcode = Ping; payload = "Hello" }
60
+
f
61
+
| Error _ -> Alcotest.fail "decode failed"
62
+
63
+
(* Source: RFC 6455 §5.7 "256 bytes binary message in a single unmasked frame" *)
64
+
let test_rfc_256_bytes () =
65
+
let payload = String.init 256 (fun i -> Char.chr (i land 0xFF)) in
66
+
(* 126 = extended 16-bit length *)
67
+
let header = "\x82\x7e\x01\x00" in
68
+
let bytes = header ^ payload in
69
+
match Websocket.decode bytes with
70
+
| Ok (f, _) ->
71
+
Alcotest.(check int) "payload length" 256 (String.length f.payload);
72
+
Alcotest.(check string) "payload" payload f.payload
73
+
| Error _ -> Alcotest.fail "decode failed"
74
+
75
+
(* Source: RFC 6455 §5.7 "64KiB binary message" — uses 8-byte extended length *)
76
+
let test_rfc_64k () =
77
+
let payload = String.make 65536 '\xAA' in
78
+
let header = "\x82\x7f\x00\x00\x00\x00\x00\x01\x00\x00" in
79
+
let bytes = header ^ payload in
80
+
match Websocket.decode bytes with
81
+
| Ok (f, _) ->
82
+
Alcotest.(check int) "64K payload" 65536 (String.length f.payload)
83
+
| Error _ -> Alcotest.fail "decode failed"
84
+
85
+
(* {1 Roundtrip tests} *)
86
+
87
+
let test_roundtrip_unmasked () =
88
+
let frame = Websocket.text "roundtrip" in
89
+
let encoded = Websocket.encode ~mask:false frame in
90
+
match Websocket.decode encoded with
91
+
| Ok (decoded, rest) ->
92
+
Alcotest.(check ws) "roundtrip" frame decoded;
93
+
Alcotest.(check string) "no rest" "" rest
94
+
| Error _ -> Alcotest.fail "decode failed"
95
+
96
+
let test_roundtrip_masked () =
97
+
let frame = Websocket.binary "\x00\x01\x02\xFF" in
98
+
let encoded = Websocket.encode ~mask:true frame in
99
+
match Websocket.decode encoded with
100
+
| Ok (decoded, _) -> Alcotest.(check ws) "masked roundtrip" frame decoded
101
+
| Error _ -> Alcotest.fail "decode failed"
102
+
103
+
let test_roundtrip_close () =
104
+
let frame = Websocket.close ~code:1001 ~reason:"going away" () in
105
+
let encoded = Websocket.encode ~mask:false frame in
106
+
match Websocket.decode encoded with
107
+
| Ok (decoded, _) ->
108
+
Alcotest.(check bool) "fin" true decoded.fin;
109
+
let code = Bytes.get_uint16_be (Bytes.of_string decoded.payload) 0 in
110
+
Alcotest.(check int) "close code" 1001 code;
111
+
let reason =
112
+
String.sub decoded.payload 2 (String.length decoded.payload - 2)
113
+
in
114
+
Alcotest.(check string) "reason" "going away" reason
115
+
| Error _ -> Alcotest.fail "decode failed"
116
+
117
+
(* {1 Incremental / chunked parsing} *)
118
+
119
+
let test_byte_at_a_time () =
120
+
let frame = Websocket.text "byte by byte" in
121
+
let encoded = Websocket.encode ~mask:false frame in
122
+
let len = String.length encoded in
123
+
(* Feed all but last byte — should need more *)
124
+
let partial = String.sub encoded 0 (len - 1) in
125
+
(match Websocket.decode partial with
126
+
| Error `Need_more -> ()
127
+
| _ -> Alcotest.fail "expected Need_more for partial frame");
128
+
(* Feed full frame *)
129
+
match Websocket.decode encoded with
130
+
| Ok (decoded, _) -> Alcotest.(check ws) "full frame" frame decoded
131
+
| Error _ -> Alcotest.fail "decode failed"
132
+
133
+
let test_concatenated_frames () =
134
+
let f1 = Websocket.text "one" in
135
+
let f2 = Websocket.binary "two" in
136
+
let f3 = Websocket.ping "" in
137
+
let buf =
138
+
Websocket.encode ~mask:false f1
139
+
^ Websocket.encode ~mask:false f2
140
+
^ Websocket.encode ~mask:false f3
141
+
in
142
+
match Websocket.decode buf with
143
+
| Ok (d1, rest1) -> (
144
+
Alcotest.(check ws) "first" f1 d1;
145
+
match Websocket.decode rest1 with
146
+
| Ok (d2, rest2) -> (
147
+
Alcotest.(check ws) "second" f2 d2;
148
+
match Websocket.decode rest2 with
149
+
| Ok (d3, rest3) ->
150
+
Alcotest.(check ws) "third" f3 d3;
151
+
Alcotest.(check string) "empty" "" rest3
152
+
| Error _ -> Alcotest.fail "third decode failed")
153
+
| Error _ -> Alcotest.fail "second decode failed")
154
+
| Error _ -> Alcotest.fail "first decode failed"
155
+
156
+
(* {1 Adversarial / edge cases} *)
157
+
158
+
let test_empty_payload () =
159
+
let frame = Websocket.text "" in
160
+
let encoded = Websocket.encode ~mask:false frame in
161
+
match Websocket.decode encoded with
162
+
| Ok (decoded, _) -> Alcotest.(check ws) "empty payload" frame decoded
163
+
| Error _ -> Alcotest.fail "decode failed"
164
+
165
+
let test_125_byte_payload () =
166
+
(* Maximum payload for 7-bit length field *)
167
+
let payload = String.make 125 'x' in
168
+
let frame = Websocket.text payload in
169
+
let encoded = Websocket.encode ~mask:false frame in
170
+
match Websocket.decode encoded with
171
+
| Ok (decoded, _) -> Alcotest.(check ws) "125 bytes" frame decoded
172
+
| Error _ -> Alcotest.fail "decode failed"
173
+
174
+
let test_126_byte_payload () =
175
+
(* Minimum payload for 16-bit extended length *)
176
+
let payload = String.make 126 'y' in
177
+
let frame = Websocket.text payload in
178
+
let encoded = Websocket.encode ~mask:false frame in
179
+
match Websocket.decode encoded with
180
+
| Ok (decoded, _) -> Alcotest.(check ws) "126 bytes" frame decoded
181
+
| Error _ -> Alcotest.fail "decode failed"
182
+
183
+
let test_empty_buffer () =
184
+
match Websocket.decode "" with
185
+
| Error `Need_more -> ()
186
+
| _ -> Alcotest.fail "expected Need_more for empty buffer"
187
+
188
+
let test_single_byte () =
189
+
match Websocket.decode "\x81" with
190
+
| Error `Need_more -> ()
191
+
| _ -> Alcotest.fail "expected Need_more for single byte"
192
+
193
+
let test_truncated_extended_length () =
194
+
(* 126 = 16-bit extended, but only 1 of 2 length bytes present *)
195
+
match Websocket.decode "\x82\x7e\x01" with
196
+
| Error `Need_more -> ()
197
+
| _ -> Alcotest.fail "expected Need_more for truncated extended length"
198
+
199
+
let test_truncated_64bit_length () =
200
+
(* 127 = 64-bit extended, but only 4 of 8 length bytes present *)
201
+
match Websocket.decode "\x82\x7f\x00\x00\x00\x01" with
202
+
| Error `Need_more -> ()
203
+
| _ -> Alcotest.fail "expected Need_more for truncated 64-bit length"
204
+
205
+
let test_unknown_opcode () =
206
+
match Websocket.decode "\x83\x00" with
207
+
| Error (`Invalid _) -> ()
208
+
| _ -> Alcotest.fail "expected Invalid for reserved opcode 3"
209
+
210
+
let test_all_control_opcodes () =
211
+
(* Close *)
212
+
(match Websocket.decode "\x88\x00" with
213
+
| Ok (f, _) -> Alcotest.(check bool) "close opcode" (f.opcode = Close) true
214
+
| Error _ -> Alcotest.fail "close decode failed");
215
+
(* Ping *)
216
+
(match Websocket.decode "\x89\x00" with
217
+
| Ok (f, _) -> Alcotest.(check bool) "ping opcode" (f.opcode = Ping) true
218
+
| Error _ -> Alcotest.fail "ping decode failed");
219
+
(* Pong *)
220
+
match Websocket.decode "\x8A\x00" with
221
+
| Ok (f, _) -> Alcotest.(check bool) "pong opcode" (f.opcode = Pong) true
222
+
| Error _ -> Alcotest.fail "pong decode failed"
223
+
224
+
let test_binary_payload_all_bytes () =
225
+
(* Every byte value 0x00-0xFF *)
226
+
let payload = String.init 256 (fun i -> Char.chr i) in
227
+
let frame = Websocket.binary payload in
228
+
let encoded = Websocket.encode ~mask:false frame in
229
+
match Websocket.decode encoded with
230
+
| Ok (decoded, _) -> Alcotest.(check ws) "all byte values" frame decoded
231
+
| Error _ -> Alcotest.fail "decode failed"
232
+
233
+
let test_mask_determinism () =
234
+
(* Two masked encodings of same frame should decode to same payload *)
235
+
let frame = Websocket.text "deterministic" in
236
+
let e1 = Websocket.encode ~mask:true frame in
237
+
let e2 = Websocket.encode ~mask:true frame in
238
+
(* Encoded bytes differ (different random masks) *)
239
+
Alcotest.(check bool) "different wire bytes" true (e1 <> e2);
240
+
(* But decoded payloads match *)
241
+
let d1 = Result.get_ok (Websocket.decode e1) |> fst in
242
+
let d2 = Result.get_ok (Websocket.decode e2) |> fst in
243
+
Alcotest.(check ws) "same payload" d1 d2
244
+
245
+
let () =
246
+
Alcotest.run "websocket"
247
+
[
248
+
( "rfc-6455",
249
+
[
250
+
Alcotest.test_case "§5.7 unmasked text" `Quick test_rfc_unmasked_text;
251
+
Alcotest.test_case "§5.7 masked text" `Quick test_rfc_masked_text;
252
+
Alcotest.test_case "§5.7 fragmented" `Quick test_rfc_fragmented;
253
+
Alcotest.test_case "§5.7 ping" `Quick test_rfc_ping;
254
+
Alcotest.test_case "§5.7 256 bytes" `Quick test_rfc_256_bytes;
255
+
Alcotest.test_case "§5.7 64K" `Quick test_rfc_64k;
256
+
] );
257
+
( "roundtrip",
258
+
[
259
+
Alcotest.test_case "unmasked" `Quick test_roundtrip_unmasked;
260
+
Alcotest.test_case "masked" `Quick test_roundtrip_masked;
261
+
Alcotest.test_case "close" `Quick test_roundtrip_close;
262
+
] );
263
+
( "incremental",
264
+
[
265
+
Alcotest.test_case "byte at a time" `Quick test_byte_at_a_time;
266
+
Alcotest.test_case "concatenated" `Quick test_concatenated_frames;
267
+
] );
268
+
( "adversarial",
269
+
[
270
+
Alcotest.test_case "empty payload" `Quick test_empty_payload;
271
+
Alcotest.test_case "125 bytes (max 7-bit)" `Quick
272
+
test_125_byte_payload;
273
+
Alcotest.test_case "126 bytes (min 16-bit)" `Quick
274
+
test_126_byte_payload;
275
+
Alcotest.test_case "empty buffer" `Quick test_empty_buffer;
276
+
Alcotest.test_case "single byte" `Quick test_single_byte;
277
+
Alcotest.test_case "truncated 16-bit len" `Quick
278
+
test_truncated_extended_length;
279
+
Alcotest.test_case "truncated 64-bit len" `Quick
280
+
test_truncated_64bit_length;
281
+
Alcotest.test_case "unknown opcode" `Quick test_unknown_opcode;
282
+
Alcotest.test_case "all control opcodes" `Quick
283
+
test_all_control_opcodes;
284
+
Alcotest.test_case "all byte values" `Quick
285
+
test_binary_payload_all_bytes;
286
+
Alcotest.test_case "mask determinism" `Quick test_mask_determinism;
287
+
] );
288
+
]
+30
websocket.opam
+30
websocket.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "WebSocket frame codec (RFC 6455)"
4
+
description: """
5
+
Encode and decode WebSocket frames. Handles masking, fragmentation,
6
+
ping/pong, and close frames. Does not handle the HTTP upgrade handshake."""
7
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
8
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
9
+
license: "ISC"
10
+
depends: [
11
+
"dune" {>= "3.17"}
12
+
"ocaml" {>= "5.2"}
13
+
"fmt" {>= "0.9"}
14
+
"alcotest" {with-test}
15
+
"odoc" {with-doc}
16
+
]
17
+
build: [
18
+
["dune" "subst"] {dev}
19
+
[
20
+
"dune"
21
+
"build"
22
+
"-p"
23
+
name
24
+
"-j"
25
+
jobs
26
+
"@install"
27
+
"@runtest" {with-test}
28
+
"@doc" {with-doc}
29
+
]
30
+
]