From 73320b59b7ac5daf9ad1db690adc44496fec15e7 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 16 Dec 2014 23:51:09 -0500 Subject: [PATCH] fixup respond_error in lwt * take headers optionally * default status --- lwt/cohttp_lwt.ml | 9 +++++---- lwt/cohttp_lwt.mli | 3 ++- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/lwt/cohttp_lwt.ml b/lwt/cohttp_lwt.ml index 7825fc6b7d..895993e7c7 100644 --- a/lwt/cohttp_lwt.ml +++ b/lwt/cohttp_lwt.ml @@ -243,7 +243,8 @@ module type Server = sig body:string -> unit -> (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t val respond_error : - status:Cohttp.Code.status_code -> + ?headers:Header.t -> + ?status:Cohttp.Code.status_code -> body:string -> unit -> (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t val respond_redirect : @@ -302,8 +303,8 @@ module Make_server(IO:Cohttp.S.IO with type 'a t = 'a Lwt.t) let body = Cohttp_lwt_body.of_string body in return (res,body) - let respond_error ~status ~body () = - respond_string ~status ~body:("Error: "^body) () + let respond_error ?headers ?(status=`Internal_server_error) ~body () = + respond_string ?headers ~status ~body:("Error: "^body) () let respond_redirect ?headers ~uri () = let headers = @@ -367,7 +368,7 @@ module Make_server(IO:Cohttp.S.IO with type 'a t = 'a Lwt.t) try_lwt spec.callback (io_id,conn_id) req body with exn -> - respond_error ~status:`Internal_server_error ~body:(Printexc.to_string exn) () + respond_error ~body:(Printexc.to_string exn) () finally Cohttp_lwt_body.drain_body body ) req_stream in (* Clean up resources when the response stream terminates and call diff --git a/lwt/cohttp_lwt.mli b/lwt/cohttp_lwt.mli index b29e7b4944..cca1f5ab1a 100644 --- a/lwt/cohttp_lwt.mli +++ b/lwt/cohttp_lwt.mli @@ -186,7 +186,8 @@ module type Server = sig body:string -> unit -> (Response.t * Cohttp_lwt_body.t) Lwt.t val respond_error : - status:Cohttp.Code.status_code -> + ?headers:Header.t -> + ?status:Cohttp.Code.status_code -> body:string -> unit -> (Response.t * Cohttp_lwt_body.t) Lwt.t val respond_redirect :