Skip to content

Commit 51aedaa

Browse files
ulrikstridGithub Runner
ulrikstrid
and
Github Runner
authored
Initial websocket support (#45)
* Initial websocket support * Update lockdir * Remove digestif override, resolve session master * Add initial graphql websocket handler * Update lockdir * Make it work * GraphiQL client stuff * Simple working demo * Add note about websockets being unstable * Fix versions etc Co-authored-by: Github Runner <[email protected]>
1 parent af8f5d6 commit 51aedaa

File tree

89 files changed

+1475
-2340
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

89 files changed

+1475
-2340
lines changed

‎VERSION

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1 +1 @@
1-
0.6.1
1+
0.6.2

‎bin/Example.re

Lines changed: 22 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -4,8 +4,6 @@ let setup_log = (~style_renderer=?, level) => {
44
Logs.set_reporter(Logs_fmt.reporter());
55
};
66

7-
let entropy = Nocrypto_entropy_lwt.initialize();
8-
97
let server =
108
Morph.Server.make(~port=3333, ~address=Unix.inet_addr_loopback, ());
119

@@ -26,32 +24,45 @@ let greet_handler: Morph.Server.handler =
2624
);
2725
};
2826

27+
let websocket_handler = request => {
28+
Morph_websocket.handler(
29+
(~send, ~reader, ~close as _) => {reader(send)},
30+
request,
31+
);
32+
};
33+
let graphql_handler = Morph_websocket.Graphql.request_handler(Schema.schema);
34+
35+
let grahiql_handler = _ => {
36+
Render.respond_html(GraphiQL.make());
37+
};
38+
2939
let get_routes =
3040
Routes.[
3141
s("greet") /? nil @--> greet_handler,
3242
s("set_greeting") / str /? nil @--> set_session_handler,
3343
s("secure") /? nil @--> Secured.handler,
44+
s("ws") /? nil @--> websocket_handler,
45+
s("graphiql") /? nil @--> grahiql_handler,
46+
s("graphql") /? nil @--> graphql_handler,
3447
];
3548

49+
let post_routes = Routes.[s("graphql") /? nil @--> graphql_handler];
50+
3651
let handler =
3752
Morph.Server.apply_all(
3853
[
54+
Morph.Middlewares.Static.make(~path="public", ~public_path="./bin"),
3955
Morph.Middlewares.Static.make(~path="docs", ~public_path="./_docs"),
4056
Morph.Middlewares.Session.middleware,
4157
Auth.middleware,
4258
],
43-
Morph.Router.make(
44-
~get=get_routes,
45-
~post=get_routes,
46-
~put=get_routes,
47-
~del=get_routes,
48-
(),
49-
),
59+
Morph.Router.make(~get=get_routes, ~post=post_routes, ()),
5060
);
5161

5262
let () = {
53-
open Lwt.Infix;
5463
setup_log(Info);
5564

56-
entropy >>= (() => server.start(handler)) |> Lwt_main.run;
65+
let () = Mirage_crypto_rng_unix.initialize();
66+
67+
server.start(handler) |> Lwt_main.run;
5768
};

‎bin/GraphiQL.re

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
open Tyxml;
2+
let graphiql_script =
3+
Tyxml.Html.script(
4+
~a=[
5+
Tyxml.Xml.string_attrib("type", "module") |> Tyxml.Html.to_attrib,
6+
Tyxml.Html.a_src("/public/graphiql.js"),
7+
],
8+
Tyxml.Html.cdata_script(""),
9+
);
10+
11+
let make = () => {
12+
let crossorigin = `Anonymous;
13+
<html>
14+
<head>
15+
<title> "GraphiQL" </title>
16+
<style>
17+
{j|body {
18+
height: 100%;
19+
margin: 0;
20+
width: 100%;
21+
overflow: hidden;
22+
}
23+
24+
#graphiql {
25+
height: 100vh;
26+
}|j}
27+
</style>
28+
<script
29+
crossorigin
30+
src="https://unpkg.com/react@16/umd/react.development.js"
31+
/>
32+
<script
33+
crossorigin
34+
src="https://unpkg.com/react-dom@16/umd/react-dom.development.js"
35+
/>
36+
<script
37+
crossorigin
38+
src="https://cdnjs.cloudflare.com/ajax/libs/graphiql/1.0.3/graphiql.js"
39+
/>
40+
<script
41+
crossorigin
42+
src="https://unpkg.com/[email protected]/browser/client.js"
43+
/>
44+
<script
45+
crossorigin
46+
src="https://unpkg.com/[email protected]/browser/client.js"
47+
/>
48+
<link
49+
rel="stylesheet"
50+
href="https://unpkg.com/graphiql/graphiql.min.css"
51+
/>
52+
</head>
53+
<body> <div id="graphiql"> "Loading..." </div> graphiql_script </body>
54+
</html>;
55+
};

‎bin/Schema.re

Lines changed: 111 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,111 @@
1+
open Graphql_lwt;
2+
3+
let set_interval = (s, f, destroy) => {
4+
let rec set_interval_loop = (s, f, n) => {
5+
let timeout =
6+
Lwt_timeout.create(s, () =>
7+
if (n > 0) {
8+
f();
9+
set_interval_loop(s, f, n - 1);
10+
} else {
11+
destroy();
12+
}
13+
);
14+
15+
Lwt_timeout.start(timeout);
16+
};
17+
18+
set_interval_loop(s, f, 5);
19+
};
20+
21+
type user = {
22+
id: int,
23+
name: string,
24+
email: string,
25+
};
26+
27+
let users =
28+
ref([
29+
{id: 1, name: "Ulrik Strid", email: "[email protected]"},
30+
{id: 2, name: "Cem Turan", email: "[email protected]"},
31+
]);
32+
33+
let user =
34+
Schema.(
35+
obj("user", ~doc="A user in the system", ~fields=_ =>
36+
[
37+
field("id", ~typ=non_null(int), ~args=Arg.[], ~resolve=(_info, user) =>
38+
user.id
39+
),
40+
field(
41+
"name", ~typ=non_null(string), ~args=Arg.[], ~resolve=(_info, user) =>
42+
user.name
43+
),
44+
field(
45+
"email",
46+
~typ=non_null(string),
47+
~args=Arg.[],
48+
~resolve=(_info, user) =>
49+
user.email
50+
),
51+
]
52+
)
53+
);
54+
55+
let schema: Schema.schema(Hmap.t) =
56+
Schema.(
57+
schema(
58+
~mutations=[
59+
field(
60+
"addUser",
61+
~typ=non_null(user),
62+
~args=
63+
Arg.[
64+
arg("name", ~typ=non_null(string)),
65+
arg("email", ~typ=non_null(string)),
66+
],
67+
~resolve=(_info, (), name, email) => {
68+
let new_user = {id: List.length(users^) + 1, name, email};
69+
users := [new_user, ...users^];
70+
new_user;
71+
},
72+
),
73+
],
74+
~subscriptions=[
75+
subscription_field(
76+
"subscribe_to_user",
77+
~typ=non_null(user),
78+
~args=Arg.[arg'("intarg", ~typ=int, ~default=0)],
79+
~resolve=(_info, _intarg) => {
80+
let (user_stream, push_to_user_stream) = Lwt_stream.create();
81+
let destroy_stream = () => push_to_user_stream(None);
82+
set_interval(
83+
2,
84+
() => {
85+
let idx = Random.int(List.length(users^));
86+
push_to_user_stream(Some(List.nth(users^, idx)));
87+
},
88+
destroy_stream,
89+
);
90+
Lwt_result.return((user_stream, destroy_stream));
91+
},
92+
),
93+
],
94+
[
95+
field(
96+
"users",
97+
~typ=non_null(list(non_null(user))),
98+
~args=Arg.[],
99+
~resolve=(_info, ()) =>
100+
users^
101+
),
102+
field(
103+
"userById",
104+
~typ=user,
105+
~args=Arg.[arg("id", ~typ=non_null(int))],
106+
~resolve=(_info, (), id) =>
107+
List.find_opt(u => u.id == id, users^)
108+
),
109+
],
110+
)
111+
);

‎bin/dune

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
(executable
22
(name Example)
3-
(libraries morph nocrypto.lwt tyxml routes logs.fmt fmt fmt.tty lwt uri)
3+
(libraries morph morph_graphql_server morph_websocket tyxml routes logs.fmt
4+
fmt fmt.tty lwt uri mirage-crypto-rng.unix graphql-lwt)
45
(preprocess
56
(pps tyxml-jsx)))

0 commit comments

Comments
 (0)