swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2025-11-06 14:10:39 +01:00
parent bd44c46fca
commit 78199273ae
1 changed files with 29 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

40
unikernel/server.ml
View file

@ -12,13 +12,33 @@ let request_from_h1 ~scheme { H1.Request.meth; target; headers; _ } =
let request_from_h2 { H2.Request.meth; target; scheme; headers } =
Mte.{ meth; target; scheme; headers }
let http_1_1_request_handler reqd =
let request = H1.Reqd.request reqd in
Log.debug (fun m ->
m "(HTTP/1.1) request-handler: %S" request.H1.Request.target);
let Mte.{ status; headers; content } =
Mte.request_handler (request_from_h1 ~scheme:"http" request)
let request_handler (reqd : [`H1 of H1.Reqd.t | `H2 of H2.Reqd.t] ) =
let request =
match reqd with
| `H1 reqd ->
request_from_h1 ~scheme:"http" (H1.Reqd.request reqd)
| `H2 reqd -> request_from_h2 (H2.Reqd.request reqd)
in
begin
match reqd with
| `H1 _ ->
Log.debug (fun m -> m "(HTTP/1.1) request-handler: %S" request.target);
| `H2 _ -> Log.debug (fun m -> m "(H2) request-handler: %S" request.target);
end;
let Mte.{ status; headers; content } = Mte.request_handler request in
let status =
match status with
| #H1.Status.t as status -> status
| _ -> Fmt.failwith "H2 status response on a H1 request"
in
let headers = H1.Headers.of_list (Headers.to_list headers) in
let response = H1.Response.create ~headers status in
H1.Reqd.respond_with_string reqd response content
let http_1_1_request_handler reqd =
let request = request_from_h1 ~scheme:"http" (H1.Reqd.request reqd) in
Log.debug (fun m -> m "(HTTP/1.1) request-handler: %S" request.target);
let Mte.{ status; headers; content } = Mte.request_handler request in
let status =
match status with
| #H1.Status.t as status -> status
@ -29,11 +49,9 @@ let http_1_1_request_handler reqd =
H1.Reqd.respond_with_string reqd response content
let http_2_0_request_handler reqd =
let request = H2.Reqd.request reqd in
Log.debug (fun m -> m "(H2) request-handler: %S" request.H2.Request.target);
let Mte.{ status; headers; content } =
Mte.request_handler (request_from_h2 request)
in
let request = request_from_h2 (H2.Reqd.request reqd) in
Log.debug (fun m -> m "(H2) request-handler: %S" request.target);
let Mte.{ status; headers; content } = Mte.request_handler request in
let response = H2.Response.create ~headers status in
H2.Reqd.respond_with_string reqd response content