Skip to content

Commit

Permalink
Delete the "app" concept
Browse files Browse the repository at this point in the history
  • Loading branch information
aantron committed Dec 14, 2021
1 parent b355e00 commit af8085a
Show file tree
Hide file tree
Showing 5 changed files with 14 additions and 113 deletions.
62 changes: 3 additions & 59 deletions src/http/error_handler.ml
Original file line number Diff line number Diff line change
Expand Up @@ -264,62 +264,6 @@ let app

respond_with_option (fun () -> user's_error_handler error)

(* let app
app user's_error_handler =
fun next_handler request ->
Lwt.try_bind
(fun () ->
next_handler request)
(fun response ->
let status = Dream.status response in
if Dream.is_client_error status || Dream.is_server_error status then begin
let caused_by, severity =
if Dream.is_client_error status then
`Client, `Warning
else
`Server, `Error
in
let error = Error.{
condition = `Response response;
layer = `App;
caused_by;
request = Some request;
response = Some response;
client = Some (Dream.client request);
severity = severity;
debug = Dream.debug app;
will_send_response = true;
} in
respond_with_option (fun () -> user's_error_handler error)
end
else
Lwt.return response)
(* This exception handler is partially redundant, in that the HTTP-level
handlers will also catch exceptions. However, this handler is able to
capture more relevant context. We leave the HTTP-level handlers for truly
severe protocol-level errors and integration mistakes. *)
(fun exn ->
let error = Error.{
condition = `Exn exn;
layer = `App;
caused_by = `Server;
request = Some request;
response = None;
client = Some (Dream.client request);
severity = `Error;
debug = Dream.debug app;
will_send_response = true;
} in
respond_with_option (fun () -> user's_error_handler error)) *)



(* TODO Simplify streams. *)
Expand All @@ -334,7 +278,7 @@ let default_response = function
Dream.response ~status:`Bad_Request client_stream server_stream

let httpaf
app user's_error_handler =
user's_error_handler =
fun client_address ?request error start_response ->

ignore (request : Httpaf.Request.t option);
Expand Down Expand Up @@ -394,7 +338,7 @@ let httpaf


let h2
app user's_error_handler =
user's_error_handler =
fun client_address ?request error start_response ->

ignore request; (* TODO Recover something from the request. *)
Expand Down Expand Up @@ -457,7 +401,7 @@ let h2
However, SSL protocol errors are not wrapped in any of these, so we add an
edditional top-level handler to catch them. *)
let tls
app user's_error_handler client_address error =
user's_error_handler client_address error =

let error = {
Dream.condition = `Exn error;
Expand Down
3 changes: 0 additions & 3 deletions src/http/error_handler.mli
Original file line number Diff line number Diff line change
Expand Up @@ -36,17 +36,14 @@ val app :
(Dream.error -> Dream.response Lwt.t)

val httpaf :
Dream.app ->
Dream.error_handler ->
(Unix.sockaddr -> Httpaf.Server_connection.error_handler)

val h2 :
Dream.app ->
Dream.error_handler ->
(Unix.sockaddr -> H2.Server_connection.error_handler)

val tls :
Dream.app ->
Dream.error_handler ->
(Unix.sockaddr -> exn -> unit)

Expand Down
35 changes: 11 additions & 24 deletions src/http/http.ml
Original file line number Diff line number Diff line change
Expand Up @@ -293,7 +293,6 @@ let websocket_handler user's_websocket_handler socket =
chance to tell the user that something is wrong with their app. *)
(* TODO Rename conn like in the body branch. *)
let wrap_handler
app
https
(user's_error_handler : Dream.error_handler)
(user's_dream_handler : Dream.handler) =
Expand Down Expand Up @@ -339,7 +338,7 @@ let wrap_handler

let request : Dream.request =
Dream.request_from_http
~app ~client ~method_ ~target ~https ~version ~headers body in
~client ~method_ ~target ~https ~version ~headers body in

(* Call the user's handler. If it raises an exception or returns a promise
that rejects with an exception, pass the exception up to Httpaf. This
Expand Down Expand Up @@ -445,7 +444,6 @@ let wrap_handler

(* TODO Factor out what is in common between the http/af and h2 handlers. *)
let wrap_handler_h2
app
https
(_user's_error_handler : Dream.error_handler)
(user's_dream_handler : Dream.handler) =
Expand Down Expand Up @@ -485,7 +483,7 @@ let wrap_handler_h2

let request : Dream.request =
Dream.request_from_http
~app ~client ~method_ ~target ~https ~version ~headers body in
~client ~method_ ~target ~https ~version ~headers body in

(* Call the user's handler. If it raises an exception or returns a promise
that rejects with an exception, pass the exception up to Httpaf. This
Expand Down Expand Up @@ -552,7 +550,6 @@ type tls_library = {
create_handler :
certificate_file:string ->
key_file:string ->
app:Dream.app ->
handler:Dream.handler ->
error_handler:Dream.error_handler ->
Unix.sockaddr ->
Expand All @@ -563,35 +560,33 @@ type tls_library = {
let no_tls = {
create_handler = begin fun
~certificate_file:_ ~key_file:_
~app
~handler
~error_handler ->
Httpaf_lwt_unix.Server.create_connection_handler
?config:None
~request_handler:(wrap_handler app false error_handler handler)
~error_handler:(Error_handler.httpaf app error_handler)
~request_handler:(wrap_handler false error_handler handler)
~error_handler:(Error_handler.httpaf error_handler)
end;
}

let openssl = {
create_handler = begin fun
~certificate_file ~key_file
~app
~handler
~error_handler ->

let httpaf_handler =
Httpaf_lwt_unix.Server.SSL.create_connection_handler
?config:None
~request_handler:(wrap_handler app true error_handler handler)
~error_handler:(Error_handler.httpaf app error_handler)
~request_handler:(wrap_handler true error_handler handler)
~error_handler:(Error_handler.httpaf error_handler)
in

let h2_handler =
H2_lwt_unix.Server.SSL.create_connection_handler
?config:None
~request_handler:(wrap_handler_h2 app true error_handler handler)
~error_handler:(Error_handler.h2 app error_handler)
~request_handler:(wrap_handler_h2 true error_handler handler)
~error_handler:(Error_handler.h2 error_handler)
in

let perform_tls_handshake =
Expand Down Expand Up @@ -636,14 +631,13 @@ let openssl = {
let ocaml_tls = {
create_handler = fun
~certificate_file ~key_file
~app
~handler
~error_handler ->
Httpaf_lwt_unix.Server.TLS.create_connection_handler_with_default
~certfile:certificate_file ~keyfile:key_file
?config:None
~request_handler:(wrap_handler app true error_handler handler)
~error_handler:(Error_handler.httpaf app error_handler)
~request_handler:(wrap_handler true error_handler handler)
~error_handler:(Error_handler.httpaf error_handler)
}


Expand All @@ -664,7 +658,6 @@ let serve_with_details
~port
~stop
~error_handler
~app
~certificate_file
~key_file
~builtins
Expand All @@ -685,13 +678,12 @@ let serve_with_details
tls_library.create_handler
~certificate_file
~key_file
~app
~handler:user's_dream_handler
~error_handler
in

(* TODO Should probably move out to the TLS library options. *)
let tls_error_handler = Error_handler.tls app error_handler in
let tls_error_handler = Error_handler.tls error_handler in

(* Some parts of the various HTTP servers that are under heavy development
( *cough* Gluten SSL/TLS at the moment) leak exceptions out of the
Expand Down Expand Up @@ -756,8 +748,6 @@ let serve_with_maybe_https
~builtins
user's_dream_handler =

let app = Dream.new_app (Error_handler.app error_handler) in

try%lwt
(* This check will at least catch secrets like "foo" when used on a public
interface. *)
Expand All @@ -778,7 +768,6 @@ let serve_with_maybe_https
~port
~stop
~error_handler
~app
~certificate_file:""
~key_file:""
~builtins
Expand Down Expand Up @@ -840,7 +829,6 @@ let serve_with_maybe_https
~port
~stop
~error_handler
~app
~certificate_file
~key_file
~builtins
Expand Down Expand Up @@ -869,7 +857,6 @@ let serve_with_maybe_https
~port
~stop
~error_handler
~app
~certificate_file
~key_file
~builtins
Expand Down
8 changes: 0 additions & 8 deletions src/pure/dream_pure.mli
Original file line number Diff line number Diff line change
Expand Up @@ -363,10 +363,6 @@ val is_websocket : response -> (websocket -> unit promise) option



(* TODO All of this should become server-side-only once the error handling
middleware is clarified. *)
type app

type log_level = [
| `Error
| `Warning
Expand Down Expand Up @@ -400,11 +396,7 @@ type error = {

type error_handler = error -> response option promise

val new_app : (error -> response Lwt.t) -> app
val app : request -> app
val app_error_handler : app -> (error -> response promise)
val request_from_http :
app:app ->
client:string ->
method_:method_ ->
target:string ->
Expand Down
19 changes: 0 additions & 19 deletions src/pure/inmost.ml
Original file line number Diff line number Diff line change
Expand Up @@ -52,7 +52,6 @@ and 'a message = {
}

and client = {
app : app;
request_client : string;
method_ : method_;
target : string;
Expand All @@ -70,10 +69,6 @@ and server = {
websocket : (websocket -> unit Lwt.t) option;
}

and app = {
error_handler : error -> response Lwt.t;
}

and error_handler = error -> response option Lwt.t

and log_level = [
Expand Down Expand Up @@ -113,14 +108,6 @@ and error = {
will_send_response : bool;
}

(* TODO Remove. *)
let app_error_handler app =
app.error_handler

let new_app error_handler = {
error_handler;
}

type 'a promise = 'a Lwt.t

type handler = request -> response Lwt.t
Expand Down Expand Up @@ -398,11 +385,7 @@ let with_local key value message =
let fold_locals f initial message =
fold_scope f initial message.locals

let app request =
request.specific.app

let request_from_http
~app
~client
~method_
~target
Expand All @@ -415,7 +398,6 @@ let request_from_http

let rec request = {
specific = {
app;
request_client = client;
method_;
target;
Expand Down Expand Up @@ -459,7 +441,6 @@ let request
specific = {
(* TODO Is there a better fake error handler? Maybe this function should
come after the response constructors? *)
app = new_app (fun _ -> assert false);
request_client = client;
method_;
target;
Expand Down

0 comments on commit af8085a

Please sign in to comment.