blob: 40fa9a81e8599b1890d94a77f1f4a6530687144a (
plain)
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
|
open Function_references
let debug = Sys.getenv_opt "DEMO_ENV" == Some "development"
let handle_form_request action_id form_data =
let form_data =
let form_data_js = Js.FormData.make () in
form_data
|> List.iter (fun (name, value) ->
(* For now we're only supporting strings. *)
let _filename, value = value |> List.hd in
Js.FormData.append form_data_js name (`String value));
form_data_js
in
let args, form_data = ReactServerDOM.decodeFormDataReply form_data in
let action_id =
match action_id with
| Some action_id -> action_id
| None -> failwith "We don't support progressive enhancement yet."
in
let handler =
match FunctionReferences.get action_id with
| Some (FormData handler) -> handler
| _ -> assert false
in
handler args form_data
let handle_request_body request action_id =
let%lwt body = Dream.body request in
let action_id =
match action_id with
| Some action_id -> action_id
| None ->
failwith
"Missing action ID, this request was not created by \
server-reason-react"
in
let handler =
match FunctionReferences.get action_id with
| Some (Body handler) -> handler
| _ -> assert false
in
handler (ReactServerDOM.decodeReply body)
let handle_request request =
let action_id = Dream.header request "ACTION_ID" in
let content_type = Dream.header request "Content-Type" in
match content_type with
| Some content_type
when String.starts_with content_type ~prefix:"multipart/form-data" -> (
let%lwt result = Dream.multipart request ~csrf:false in
match result with
| `Ok form_data -> handle_form_request action_id form_data
| _ ->
failwith
"Missing form data, this request was not created by \
server-reason-react")
| _ -> handle_request_body request action_id
let stream_function_response request =
Dream.stream
~headers:[ ("Content-Type", "application/react.action") ]
(fun stream ->
let%lwt () =
ReactServerDOM.create_action_response
~subscribe:(fun chunk ->
Dream.log "Action response";
Dream.log "%s" chunk;
let%lwt () = Dream.write stream chunk in
Dream.flush stream)
(handle_request request)
in
Dream.flush stream)
let is_react_component_header str =
String.equal str "application/react.component"
let stream_model ~location app =
Dream.stream
~headers:
[
("Content-Type", "application/react.component");
("X-Content-Type-Options", "nosniff");
("X-Location", location);
]
(fun stream ->
let%lwt () =
ReactServerDOM.render_model ~debug
~subscribe:(fun chunk ->
Dream.log "Chunk";
Dream.log "%s" chunk;
let%lwt () = Dream.write stream chunk in
Dream.flush stream)
app
in
Dream.flush stream)
let stream_html ~bootstrap_script_content ~bootstrap_scripts ~bootstrap_modules
app =
Dream.stream
~headers:[ ("Content-Type", "text/html") ]
(fun stream ->
let%lwt html, subscribe =
ReactServerDOM.render_html
~bootstrapScriptContent:bootstrap_script_content
~bootstrapScripts:bootstrap_scripts
~bootstrapModules:bootstrap_modules ~debug app
in
let%lwt () = Dream.write stream html in
let%lwt () = Dream.flush stream in
let%lwt () =
subscribe (fun chunk ->
Dream.log "Chunk";
Dream.log "%s" chunk;
let%lwt () = Dream.write stream chunk in
Dream.flush stream)
in
Dream.flush stream)
let create_from_request ?(bootstrap_modules = []) ?(bootstrap_scripts = [])
?(bootstrap_script_content = "") app request =
match Dream.header request "Accept" with
| Some accept when is_react_component_header accept ->
stream_model ~location:(Dream.target request) app
| _ ->
stream_html ~bootstrap_script_content ~bootstrap_scripts
~bootstrap_modules app
|
