/
t1.ml
61 lines (51 loc) · 1.48 KB
/
t1.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
open Moonpool
module H = Tiny_httpd
let j = ref 20
let min_per_dom = ref 2
let port = ref 8084
let handle_name (server : H.t) : unit =
H.add_route_handler server H.Route.(exact "hello" @/ string @/ return)
@@ fun name _req ->
H.Response.make_string @@ Ok (Printf.sprintf "hello %s" name)
let count = Atomic.make 0
let handle_name_json (server : H.t) : unit =
H.add_route_handler server H.Route.(exact "hellojs" @/ string @/ return)
@@ fun name _req ->
let j =
`Assoc
[
"what", `String "hello";
"who", `String name;
"count", `Int (Atomic.fetch_and_add count 1);
]
in
H.Response.make_string @@ Ok (Yojson.Safe.to_string j)
let run () : int =
let pool = Pool.create ~min:!j ~per_domain:!min_per_dom () in
let server =
H.create ~max_connections:2048 ~port:!port ~new_thread:(Pool.run pool) ()
in
handle_name server;
handle_name_json server;
Printf.printf "listening on http://127.0.0.1:%d (%d threads)\n%!" !port
(Pool.size pool);
match H.run server with
| Ok () -> 0
| Error e ->
Printf.eprintf "error: %s\n%!" (Printexc.to_string e);
1
let () =
(* force linking *)
ignore (Jemalloc.version ());
Printexc.record_backtrace true;
Arg.parse
[
"-j", Arg.Set_int j, " size of pool";
( "--min-per-dom",
Arg.Set_int min_per_dom,
" minimum number of threads per domain" );
"-p", Arg.Set_int port, " port to listen on";
]
ignore "t1 [opt]*";
let code = run () in
exit code