Source file client_connection.ml
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
module IOVec = Httpaf.IOVec
type state =
| Uninitialized
| Handshake of Client_handshake.t
| Websocket of Client_websocket.t
type t = state ref
type error =
[ Httpaf.Client_connection.error
| `Handshake_failure of Httpaf.Response.t * [`read] Httpaf.Body.t ]
type input_handlers = Client_websocket.input_handlers =
{ frame : opcode:Websocket.Opcode.t -> is_fin:bool -> Bigstringaf.t -> off:int -> len:int -> unit
; eof : unit -> unit }
let passes_scrutiny ~accept =
let upgrade = Httpaf.Headers.get headers "upgrade" in
let connection = Httpaf.Headers.get headers "connection" in
let sec_websocket_accept = Httpaf.Headers.get headers "sec-websocket-accept" in
sec_websocket_accept = Some accept
&& (match upgrade with
| None -> false
| Some upgrade -> String.lowercase_ascii upgrade = "websocket")
&& (match connection with
| None -> false
| Some connection -> String.lowercase_ascii connection = "upgrade")
;;
let handshake_exn t =
match !t with
| Handshake handshake -> handshake
| Uninitialized
| Websocket _ -> assert false
let create
~nonce
~host
~port
~resource
~sha1
~error_handler
~websocket_handler
=
let t = ref Uninitialized in
let nonce = Base64.encode_exn nonce in
let response_handler response response_body =
let accept = sha1 (nonce ^ "258EAFA5-E914-47DA-95CA-C5AB0DC85B11") in
match response.Httpaf.Response.status with
| `Switching_protocols when passes_scrutiny ~accept response.headers ->
Httpaf.Body.close_reader response_body;
let handshake = handshake_exn t in
t := Websocket (Client_websocket.create ~websocket_handler);
Client_handshake.close handshake
| _ ->
error_handler (`Handshake_failure(response, response_body))
in
let handshake =
let error_handler = (error_handler :> Httpaf.Client_connection.error_handler) in
Client_handshake.create
~nonce
~host
~port
~resource
~error_handler
~response_handler
in
t := Handshake handshake;
t
;;
let next_read_operation t =
match !t with
| Uninitialized -> assert false
| Handshake handshake -> Client_handshake.next_read_operation handshake
| Websocket websocket -> Client_websocket.next_read_operation websocket
;;
let read t bs ~off ~len =
match !t with
| Uninitialized -> assert false
| Handshake handshake -> Client_handshake.read handshake bs ~off ~len
| Websocket websocket -> Client_websocket.read websocket bs ~off ~len
;;
let read_eof t bs ~off ~len =
match !t with
| Uninitialized -> assert false
| Handshake handshake -> Client_handshake.read handshake bs ~off ~len
| Websocket websocket -> Client_websocket.read_eof websocket bs ~off ~len
;;
let next_write_operation t =
match !t with
| Uninitialized -> assert false
| Handshake handshake -> Client_handshake.next_write_operation handshake
| Websocket websocket -> Client_websocket.next_write_operation websocket
;;
let report_write_result t result =
match !t with
| Uninitialized -> assert false
| Handshake handshake -> Client_handshake.report_write_result handshake result
| Websocket websocket -> Client_websocket.report_write_result websocket result
;;
let yield_writer t f =
match !t with
| Uninitialized -> assert false
| Handshake handshake -> Client_handshake.yield_writer handshake f
| Websocket websocket -> Client_websocket.yield_writer websocket f
;;
let close t =
match !t with
| Uninitialized -> assert false
| Handshake handshake -> Client_handshake.close handshake
| Websocket websocket -> Client_websocket.close websocket
;;