55 lines
1.6 KiB
OCaml
55 lines
1.6 KiB
OCaml
|
open Lwt.Infix
|
||
|
|
open H2
|
||
|
|
|
||
|
|
module type HTTP2 = H2_mirage.Server
|
||
|
|
|
||
|
|
module Dispatch (C : Mirage_console.S) (Http2 : HTTP2) = struct
|
||
|
|
let log c fmt = Printf.ksprintf (C.log c) fmt
|
||
|
|
|
||
|
|
let get_content c path =
|
||
|
|
log c "Replying: %s" path >|= fun () -> "Hello from the h2 unikernel"
|
||
|
|
|
||
|
|
let dispatcher c reqd =
|
||
|
|
let { Request.target; _ } = Reqd.request reqd in
|
||
|
|
Lwt.catch
|
||
|
|
(fun () ->
|
||
|
|
get_content c target >|= fun body ->
|
||
|
|
let response =
|
||
|
|
Response.create
|
||
|
|
~headers:
|
||
|
|
(Headers.of_list
|
||
|
|
[ "content-length", body |> String.length |> string_of_int ])
|
||
|
|
`OK
|
||
|
|
in
|
||
|
|
Reqd.respond_with_string reqd response body)
|
||
|
|
(fun exn ->
|
||
|
|
let response = Response.create `Internal_server_error in
|
||
|
|
Lwt.return
|
||
|
|
(Reqd.respond_with_string reqd response (Printexc.to_string exn)))
|
||
|
|
|> ignore
|
||
|
|
|
||
|
|
let serve c dispatch =
|
||
|
|
let error_handler ?request:_ _error mk_response =
|
||
|
|
let response_body = mk_response Headers.empty in
|
||
|
|
Body.Writer.write_string response_body "Error handled";
|
||
|
|
Body.Writer.flush response_body (fun () ->
|
||
|
|
Body.Writer.close response_body)
|
||
|
|
in
|
||
|
|
Http2.create_connection_handler
|
||
|
|
?config:None
|
||
|
|
~request_handler:(dispatch c)
|
||
|
|
~error_handler
|
||
|
|
end
|
||
|
|
|
||
|
|
(** Server boilerplate *)
|
||
|
|
module Make (C : Mirage_console.S) (Clock : Mirage_clock.PCLOCK) (Http2 : HTTP2) =
|
||
|
|
struct
|
||
|
|
module D = Dispatch (C) (Http2)
|
||
|
|
|
||
|
|
let log c fmt = Printf.ksprintf (C.log c) fmt
|
||
|
|
|
||
|
|
let start c _clock http2 =
|
||
|
|
log c "started unikernel listen on port 8001" >>= fun () ->
|
||
|
|
http2 (`TCP 8001) @@ D.serve c D.dispatcher
|
||
|
|
end
|