-
Notifications
You must be signed in to change notification settings - Fork 10
/
index.html
592 lines (509 loc) · 22.3 KB
/
index.html
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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8" />
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<meta name="viewport" content="width=device-width, initial-scale=1.0" />
<meta name="description" content="" />
<meta name="author" content="Maxim Sokhatsky" />
<title>WS</title>
<link rel="stylesheet" href="https://n2o.dev/blank.css?x=15" />
<link rel="stylesheet" href="https://n2o.dev/zima.css?x=15" />
<link rel="shortcut icon" type="image/x-icon" href="img/favicon.ico" />
<link rel="apple-touch-icon" sizes="180x180" href=".img/apple-touch-icon.png" />
<link rel="icon" type="image/png" sizes="32x32" href="img/favicon-32x32.png" />
<link rel="icon" type="image/png" sizes="16x16" href="img/favicon-16x16.png" />
<link rel="manifest" href="img/site.webmanifest" />
</head>
<body>
<nav>
<a href="https://erp.uno">ERP</a>
<a href="https://ws.erp.uno" style="background:#ededed;">WS</a>
</nav>
<header>
<a href="https://github.com/erpuno"><img src="https://avatars.githubusercontent.com/u/4131155?s=400&u=5e1fb3f98771143ec08d91485e5a274ab60a5960&v=4" /></a>
<h1>WS</h1>
</header>
<aside>
<article>
<section>
<h3>SYNOPSIS</h3>
<div>High-performance, idiomatic, zero-dependency, Async-based,
F# WebSocket server with supervision and ticker in 200 LOC.
</div><br/>
<div>
JAN 2021 © <a href="https://github.com/5HT">5HT</a> <a href="https://5ht.co/license.htm">ISC</a><br />
VER 1.0
</div>
</section>
<section>
<a name="plugin"></a><h3>USAGE</h3>
<div>Get the NuGet dependency:</div><br/>
<figure>
<code> paket add ws </code>
</figure>
</section>
</article>
</aside>
<main>
<article>
<section>
<h3>F# WebSocket Server</h3>
<h4>Annotation</h4>
<p>The idea to write web servers and web frameworks
in all languages came to my mind ever since I
realized that what I did for the Erlang ecosystem:
the direction of frameworks for enterprises under
the general brand N2O, and now as part of the <a href="https://erp.uno">erp.uno</a>
platform; quite applicable for other languages and
platforms as well. This article provides a version
of the websocket server for the F# programming language,
<a href="https://ws.erp.uno">ws.erp.uno</a>.
Package address: <a href="https://nuget.org/packages/ws">nuget.org/packages/ws</a>.
Repository address: <a href="https://github.com/erpuno/ws">erpuno/ws</a>.
</p>
<h4>Foreword</h4>
<p>
<b>Haskell</b>. The first experiment was carried out by Andrey Melnikov
as a port for Haskell: <a href="https://github.com/nponeccop/n2o.hs">N2O.HS</a>,
later a more complete version with N2O and NITRO expressed in existential signatures
was made by Marat Khafizov, who runs the <a href="https://github.com/o3">O3</a> Github
organization and the <a herf="https://o3.click">o3.click</a> website.
It is completely incomprehensible to me why not a single Haskell programmer,
who seems to be supposed to admire minimalism, does not follow this path,
but usually looks for the truth in such frameworks as UrWeb, IHP, UnisonWeb.
In my opinion, these are all overcomplicated things.</p>
<p><b>Standard ML</b>. Also for academic purposes, Marat Khafizov made a port
of the bundle of the N2O web server and the NITRO web framework into the
Standard ML language (both major versions of SML/NJ and MLton) —
this work is presented by the <a href="https://github.com/o1">O1</a> organization on Github.
This is the language that I consider appropriate to teach as the first
academic programming language (prior to acquaintance with the industrial
languages Erlang, F#, Haskell).</p>
<p><b>Lean</b>. To consolidate my idea and articulate it more clearly and accurately,
I asked <a href="https://github.com/forked-from-1kasper">Siegmentation Fault</a>
to make a port to an even more formal programming language, the Lean 4 mathematical prover.
This version of the N2O web server and the NITRO web framework
is presented by Github by the <a href="https://github.com/o89">O89</a>
organization and two sites at once: <a href="https://lean4.dev">lean4.dev</a>
and <a href="https://bum.pm">bum.pm</a>. The latter is a package manager
written in Lean 4, which Aleksandr Temerev from CERN helps us to maintain.
Lean 4 N2O projects were liked by Leonardo de Moura, author of Lean and Z3,
and we are immensely happy about it.</p>
<h4>Idiomatic WebSocket server in F#</h4>
<p>Idiomatic criteria can be perceived differently by everyone,
but basically this means a minimum of preludes and a maximum of essence,
one way or another, the main mantra of all minimalists in general and N2O
infrastructure in particular. So, in the modern criteria for the idiomaticity
of a web server for the F# language, I would highlight the following:
1) the use of the System.Net.WebSockets system classes, which already
provide a buffered encoder and decoder of frames of the RFC 6455 standard;
2) the server must be built on Async computational expressions;
3) MailboxProcessor should be used to manage asynchronous threads of execution (lightweight processes),
and not a self-written system of workers, which, although it will help
squeeze the latter out of F# (I got 14 million messages per second),
will not demonstrate the essence, since it will be a deviation towards actor runtimes;
4) Using the TcpListener and TcpClient, NetworkStream classes. You are not allowed
to use anything else!</p>
<h4>What to read before writing?</h4>
<p>After a bit of googling, I realized that the Internet lacks an article
that describes the history of the concept of asynchronous computations
which are popularly known by the async/await keywords. I see the future
article called "Survey of brief Async history",
which will show a retrospective of Async technology:
</p>
<p>0) J operator 1965; <br>
1) LISP call/cc 1968; <br>
2) Erlang 1986; <br>
3) Concurrent ML 1998; <br>
4) Haskell async 2004; <br>
5) C # async yield 2006; <br>
6) Perl IO: Async 2007; <br>
7) F# Async 2010 <br>
8) C# / PHP Async 2012 <br>
9) Python async 2015 <br>
10) ECMAScript async 2017</p>
<p>The seminal article on F# async is Leo Gorodinsky's `<b>F# Async Guide</b>`.
The main book that I would recommend to look through before getting acquainted
with F# is `<b>Expert F# 4.0</b>` by the author of the language Don Syme.
The main presentation on F# Async, I would call Don Syme's talk at the London
meetup — `<b>Some F# for the Erlang programmer</b>`. Armed with these documents
and this <a href="https://gist.github.com/panesofglass/03589f24f14f7c1e5899">Gist snippet</a>,
I went to Lviv to write the most idiomatic websocket server.</p>
<h4>Showcase</h4>
<p>As is usually accepted in backtracking systems, Prolog and declarative languages,
we will move from the end, namely from the interface that we want to get.
I would like the ECHO Server to be an id function.</p>
<figure>
<code>
open N2O
module Program =
[<EntryPoint>]
let main _ =
let mutable ret = 0
try Server.proto <- fun _ -> id
use ws = Server.start "0.0.0.0" 1900
System.Threading.Thread.Sleep -1
with exn ->
printfn "EXIT: %s" exn.Message
ret <- 1
ret
</code>
</figure>
<h4>Asynchronous process architecture</h4>
<p>For those familiar with the Erlang/OTP architecture,
it is known that designing network applications begins
with a supervision tree of lightweight processes and the
protocols that govern their interactions. Child
processes usually share CancellationToken lifetime tokens,
so that exceptions thrown in parent processes can cancel
the entire subprocess tree. Therefore, the async process loops
contain the expression:</p>
<figure>
<code>
while not ct.IsCancellationRequested do
</code>
</figure>
<p>Our websocket server consists of 7 asynchronous processes:</p>
<figure>
<code>
[Sup] [L]*
/ /
[start]--[S]--[C]*
\ \
[H] [T]*
</code>
</figure>
<p>The legend of this tree is as follows: [start] node is the entry point from
which the rest of the asynchronous processes will be born, corresponds to
the <b>start</b> function; The [S] node cooperates with the asynchronous process
represented by the listen function; [Sup] node corresponds to the
<b>startSupervisor</b> function; [C] the node corresponds to the <b>startClient</b>
function; [H] node meets the <b>heartbeat</b> function requirement;
[L] node matches the <b>loop</b> function; The [T] node meets the <b>telemetry</b>
function requirement. An asterisk will denote processes, the number of
which depends on the number of active connections: [C]*, [L]*, [T]*.</p>
<h4>Interaction protocols</h4>
<p>At the moment of birth of the client [C], in the parent process of
the server [S], the notification [S] -> [Sup] takes place according
to the so-called Supervisor Sup protocol with the same type.
The public protocol of the public function Server.protocol is
represented by the Msg type , which is used to control an asynchronous process [L].</p>
<p>The server ping system is implemented compatible with the Sup
and Msg protocols , the heartbit process [H] sends a Tick message
at intervals to the supervisor [Sup], which in turn sends broadcasts
to all telemetry clients [T] created on the same queue as [C],
ie the same protocol.</p>
<p>Processes [T], [L] and [C] share the WebSocket stream and are all
connected to the server's supervisor, notifying it in case of exceptions.</p>
<figure>
<code>
type Msg =
| Bin of byte array
| Text of string
| Nope
type Sup =
| Connect of MailboxProcessor<Msg> * WebSocket
| Disconnect of MailboxProcessor<Msg>
| Close of WebSocket
| Tick
type Req =
{ path : string;
method : string;
version : string;
headers : NameValueCollection }
</code>
</figure>
<p>I state: for any WebSocket server the following signature is the only needed:</p>
<figure>
<code>
proto : Req -> Msg -> Msg
</code>
</figure>
<p>Also, no more types needed! The Req record type is required in addition to Sup and Msg union types because:
a) we need to pass endpoint URL and probably peer IP address to WebSocket async processes;
b) we need to dispatch protocol modules (such as ECHO) through URL path;
c) we need to read <b>X-Authorization</b> token from RFC 2616 headers in production environment,
which is basically the whole request parser, implemented in separete module.</p>
<p>Thus our ECHO protocol function including router could be seen as:</p>
<figure>
<code>
let echo : Req -> Msg -> Msg =
fun _ -> id
</code>
</figure>
<p>In pure functional manner you can build even complex router which maps
URI services to particular monoidal functions:</p>
<figure>
<code>
let nope = fun _ -> Nope
let tick = fun _ -> Text "TICK"
let echo = id
let route : Req -> Msg -> Msg =
fun x ->
match x.path with
| "/nope" -> nope
| "/tick" -> tick
| "/echo" -> echo
| _ -> id
</code>
</figure>
<h4>RFC 2616 Header Parser</h4>
<p>Simple header <b>request</b> parser function
is a prelude for RFC 6455 handshake. This function populates
NameValueCollection with parsed headers from the initial HTTP request.</p>
<figure>
<code>
let parseHeader (headers : NameValueCollection) (line : string) : unit =
match line.Split(':', 2, StringSplitOptions.TrimEntries) with
| [| key; value |] -> headers.Add(key.ToLower(), value)
| _ -> ()
let request (lines : string array) : Req =
let req = { path = ""; version = ""; method = "";
headers = NameValueCollection() }
match (Array.head lines).Split(' ',
StringSplitOptions.RemoveEmptyEntries) with
| [| method; uri; version |] ->
Array.iter (parseHeader req.headers) (Array.tail lines)
{ req with path = uri; version = version; method = method }
| _ -> req
</code>
</figure>
<h4>RFC 6455 Handshake</h4>
<p>Functions for handling HTTP headers. <b>isWebSocketsUpgrade</b> looks
for an Upgrade and WebSocket pair in the headers. <b>getLines</b> returns
headers as an array of strings, and the <b>getKey</b> function returns the
header value by its key.</p>
<figure>
<code>
let isWebSocketsUpgrade (req: Req) =
req.headers.["upgrade"].ToLower() = "websocket"
let getLines (bytes: Byte []) len =
if len > 8 then
bytes.[..(len - 9)]
|> UTF8Encoding.UTF8.GetString
|> fun hs -> hs.Split([| "\r\n" |],
StringSplitOptions.RemoveEmptyEntries)
else
[||]
</code>
</figure>
<p>The RFC 6455 response feature is called handshake.
As far as I know, this functionality is not in the system namespaces..</p>
<figure>
<code>
let acceptString6455 acceptCode =
"HTTP/1.1 101 Switching Protocols\r\n" +
"Upgrade: websocket\r\n" +
"Connection: Upgrade\r\n" +
"Sec-WebSocket-Accept: " + acceptCode + "\r\n\r\n"
let handshake lines =
req.headers.["sec-websocket-key"] + "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
|> Encoding.ASCII.GetBytes
|> SHA1CryptoServiceProvider.Create().ComputeHash
|> Convert.ToBase64String
|> acceptString6455
|> Encoding.ASCII.GetBytes
</code>
</figure>
<h4>Asynchronous Server Processes</h4>
<p>The first process, [start], is an entry point where three processes
start at once: the supervisor of all connections [Sup] process,
the connection listener server process [S], and, if the Server.ticker
flag is enabled, the heartbeat process, which works as an interval
cyclic timer [H]. The epilogue of the [start] process contains the
tokenization of the global token for all subprocesses when the
variable is released, which contains the websocket server in external code.</p>
<figure>
<code>
let start (addr: string) (port: int) =
let cts = new CancellationTokenSource()
let token = cts.Token
let sup = startSupervisor token
let listener = TcpListener(IPAddress.Parse(addr), port)
try listener.Start(10) with
| :? SocketException -> failwithf "%s:%i is acquired" addr port
| err -> failwithf "%s" err.Message
Async.Start(listen listener token sup, token)
if ticker then Async.Start(heartbeat interval token sup, token)
{ new IDisposable with member x.Dispose() = cts.Cancel() }
</code>
</figure>
<p>The second process [Sup], the supervisor, is a pure function that processes
messages from protocol supervisors about registration and death of the connections.
There is also a broadcast of messages as a reaction to the heartbeat of the ticker.</p>
<figure>
<code>
let startSupervisor (ct: CancellationToken) =
MailboxProcessor.Start(
(fun (inbox: MailboxProcessor<Sup>) ->
let listeners = ResizeArray<_>()
async {
while not ct.IsCancellationRequested do
match! inbox.Receive() with
| Close ws -> ()
| Connect (l, ns) -> listeners.Add(l)
| Disconnect l -> listeners.Remove(l) |> ignore
| Tick -> listeners.ForEach(fun l -> l.Post Nope)
}),
cancellationToken = ct
)
</code>
</figure>
<p>Interval heartbeat timer [H].</p>
<figure>
<code>
let heartbeat (interval: int)
(ct: CancellationToken)
(sup: MailboxProcessor<Sup>) =
async {
while not ct.IsCancellationRequested do
do! Async.Sleep interval
sup.Post(Tick)
}
</code>
</figure>
<p>The main loop of the process [S], which accepts new TCP connections and starts new clients [C].</p>
<figure>
<code>
let listen (listener: TcpListener)
(ct: CancellationToken)
(sup: MailboxProcessor<Sup>) =
async {
while not ct.IsCancellationRequested do
let! client = listener.AcceptTcpClientAsync() |> Async.AwaitTask
client.NoDelay <- true
startClient client sup ct |> ignore
}
</code>
</figure>
<p>Asychronous process [C] with a queue (MailboxProcessor) for processing TCP connections or,
more simply, a TCP client. This is the entry point for the client connection,
and this is where the handshake happens. In case of a successful handshake,
we send RFC 6455 a response and launch two asynchronous processes at once:
the first is the processing cycle of the websocket messages [L] itself, and also,
if the Server.ticker flag is set, we start the telemetry process [T], which shares
the WebSocket stream and can perform asynchronous message flushing there,
competing with the main loop [L]. Such processes always exist in pairs.</p>
<figure>
<code>
let startClient (tcp: TcpClient)
(sup: MailboxProcessor<Sup>)
(ct: CancellationToken) =
MailboxProcessor.Start(
(fun (inbox: MailboxProcessor<Msg>) ->
async {
let ns = tcp.GetStream()
let size = tcp.ReceiveBufferSize
let bytes = Array.create size (byte 0)
let! len = ns.ReadAsync(bytes, 0, bytes.Length)
|> Async.AwaitTask
let lines = getLines bytes len
match isWebSocketsUpgrade lines with
| true ->
do! ns.AsyncWrite (handshake lines)
let ws =
WebSocket.CreateFromStream(
(ns :> Stream), true, "n2o", TimeSpan(1, 0, 0))
sup.Post(Connect(inbox, ws))
if ticker then Async.Start(telemetry ws inbox ct sup, ct)
return! looper ws size ct sup
| _ -> tcp.Close()
}),
cancellationToken = ct
)
</code>
</figure>
<p>The telemetry process [T] listens to the queue, and for any message, sends the
text "TICK" to the websocket channel.</p>
<figure>
<code>
let telemetry (ws: WebSocket)
(inbox: MailboxProcessor<Msg>)
(ct: CancellationToken)
(sup: MailboxProcessor<Sup>) =
async {
try
while not ct.IsCancellationRequested do
let! _ = inbox.Receive()
do! send ws ct (Text "TICK")
finally
sup.Post(Disconnect <| inbox)
ws.CloseAsync(WebSocketCloseStatus.PolicyViolation, "TELEMETRY", ct)
|> ignore
}
</code>
</figure>
<p>The main message loop [L], in which a buffered WebSocket stream is created,
the type of which is explicitly present in the supervisor protocol.
Also, a global buffer for the entire cycle is allocated here, where the bytes
of their socket are copied using ReceiveAsync. When an exception occurs,
the supervisor is notified with a Close message, which signals a disconnection,
for example, in the event of a UTF-8 validation error.</p>
<figure>
<code>
let looper (ws: WebSocket)
(bufferSize: int)
(ct: CancellationToken)
(sup: MailboxProcessor<Sup>) =
async {
try
let mutable bytes = Array.create bufferSize (byte 0)
while not ct.IsCancellationRequested do
let! result =
ws.ReceiveAsync(ArraySegment<byte>(bytes), ct)
|> Async.AwaitTask
let recv = bytes.[0..result.Count - 1]
match (result.MessageType) with
| WebSocketMessageType.Text ->
do! protocol (Text (Encoding.UTF8.GetString recv))
|> send ws ct
| WebSocketMessageType.Binary ->
do! protocol (Bin recv)
|> send ws ct
| WebSocketMessageType.Close -> ()
| _ -> printfn "PROTOCOL VIOLATION"
finally
sup.Post(Close <| ws)
ws.CloseAsync(WebSocketCloseStatus.PolicyViolation, "LOOPER", ct)
|> ignore
}
</code>
</figure>
<p>Channel termination functions inherit the archaic, in my opinion,
separation of text and binary messages. As practice shows, treating
everything as binary messages only improves the semantics of the protocol.</p>
<figure>
<code>
let sendBytes (ws: WebSocket) ct bytes =
ws.SendAsync(ArraySegment<byte>(bytes),
WebSocketMessageType.Binary, true, ct) |> ignore
let send ws ct (msg: Msg) =
async {
match msg with
| Text text -> sendBytes ws ct (Encoding.UTF8.GetBytes text)
| Bin arr -> sendBytes ws ct arr
| Nope -> ()
}
</code>
</figure>
<h4>What's next?</h4>
<p>Then there are next phases:<br><br>
1) BERT serialization for compatibility with N2O client infrastructure; <br>
2) Implementation of the NITRO protocol.</p>
<h4>Acknowledgments</h4>
<p>I would like to thank everyone who liked our project,
especially Phillip Carter, program manager of .NET and
F# <span class="heart">❤</span> We are extremely excited!</p>
<h4>Authors</h4>
<p>Maxim Sokhatsky, Igor Gorodetsky, Siegmentation Fault</p>
<br/>
<br/>
<br/>
</section>
</article>
</main>
<footer>ERP.UNO</footer>
<script>function drop(){document.getElementById("dropdown").classList.toggle("show");}</script>
</body>
</html>