This commit is contained in:
parent
bd44c46fca
commit
6ee6819a74
3 changed files with 36 additions and 19 deletions
2
src/dune
2
src/dune
|
|
@ -1,4 +1,4 @@
|
||||||
(library
|
(library
|
||||||
(name mte)
|
(name mte)
|
||||||
(wrapped false)
|
(wrapped false)
|
||||||
(libraries logs h2))
|
(libraries logs h2 lwt))
|
||||||
|
|
|
||||||
|
|
@ -39,8 +39,8 @@ let request_handler request =
|
||||||
| [ "" ] ->
|
| [ "" ] ->
|
||||||
let content = home_page_text in
|
let content = home_page_text in
|
||||||
let headers = default_headers ~content `Text_plain in
|
let headers = default_headers ~content `Text_plain in
|
||||||
{ status= `OK; headers; content }
|
Lwt.return { status= `OK; headers; content }
|
||||||
| _ ->
|
| _ ->
|
||||||
let content = "Not found." in
|
let content = "Not found." in
|
||||||
let headers = default_headers ~content `Text_plain in
|
let headers = default_headers ~content `Text_plain in
|
||||||
{ status= `Not_found; headers; content }
|
Lwt.return { status= `Not_found; headers; content }
|
||||||
|
|
|
||||||
|
|
@ -16,7 +16,11 @@ let http_1_1_request_handler reqd =
|
||||||
let request = H1.Reqd.request reqd in
|
let request = H1.Reqd.request reqd in
|
||||||
Log.debug (fun m ->
|
Log.debug (fun m ->
|
||||||
m "(HTTP/1.1) request-handler: %S" request.H1.Request.target);
|
m "(HTTP/1.1) request-handler: %S" request.H1.Request.target);
|
||||||
let Mte.{ status; headers; content } =
|
Lwt.async @@ fun () ->
|
||||||
|
Lwt.catch
|
||||||
|
(fun () ->
|
||||||
|
let open Syntax in
|
||||||
|
let+ Mte.{ status; headers; content } =
|
||||||
Mte.request_handler (request_from_h1 ~scheme:"http" request)
|
Mte.request_handler (request_from_h1 ~scheme:"http" request)
|
||||||
in
|
in
|
||||||
let status =
|
let status =
|
||||||
|
|
@ -26,16 +30,29 @@ let http_1_1_request_handler reqd =
|
||||||
in
|
in
|
||||||
let headers = H1.Headers.of_list (Headers.to_list headers) in
|
let headers = H1.Headers.of_list (Headers.to_list headers) in
|
||||||
let response = H1.Response.create ~headers status in
|
let response = H1.Response.create ~headers status in
|
||||||
H1.Reqd.respond_with_string reqd response content
|
H1.Reqd.respond_with_string reqd response content;
|
||||||
|
())
|
||||||
|
(fun exn ->
|
||||||
|
(* note: not sure what this does exactly, this is what is done in Dream *)
|
||||||
|
H1.Reqd.report_exn reqd exn;
|
||||||
|
Lwt.return_unit)
|
||||||
|
|
||||||
let http_2_0_request_handler reqd =
|
let http_2_0_request_handler reqd =
|
||||||
let request = H2.Reqd.request reqd in
|
let request = H2.Reqd.request reqd in
|
||||||
Log.debug (fun m -> m "(H2) request-handler: %S" request.H2.Request.target);
|
Log.debug (fun m -> m "(H2) request-handler: %S" request.H2.Request.target);
|
||||||
let Mte.{ status; headers; content } =
|
Lwt.async @@ fun () ->
|
||||||
|
Lwt.catch
|
||||||
|
(fun () ->
|
||||||
|
let open Syntax in
|
||||||
|
let+ Mte.{ status; headers; content } =
|
||||||
Mte.request_handler (request_from_h2 request)
|
Mte.request_handler (request_from_h2 request)
|
||||||
in
|
in
|
||||||
let response = H2.Response.create ~headers status in
|
let response = H2.Response.create ~headers status in
|
||||||
H2.Reqd.respond_with_string reqd response content
|
H2.Reqd.respond_with_string reqd response content;
|
||||||
|
())
|
||||||
|
(fun exn ->
|
||||||
|
H2.Reqd.report_exn reqd exn;
|
||||||
|
Lwt.return_unit)
|
||||||
|
|
||||||
let alpn_request_handler : type reqd headers request response ro wo.
|
let alpn_request_handler : type reqd headers request response ro wo.
|
||||||
reqd -> (reqd, headers, request, response, ro, wo) Alpn.protocol -> unit =
|
reqd -> (reqd, headers, request, response, ro, wo) Alpn.protocol -> unit =
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue