Raise and reraise exceptions with Stdlib rather than Lwt (#1079)

* Re-raise exceptions to preserve backtraces

* Use failwith instead of Lwt.fail_with

Lwt's documentation reads:

> In most cases, it is better to use `failwith s` from the standard
> library.

and

> Whenever possible, it is recommended to use `raise exn` instead, as
> raise captures a backtrace, while `Lwt.fail` does not. If you call
> `raise exn` in a callback that is expected by Lwt to return a
> promise, Lwt will automatically wrap `exn` in a rejected promise,
> but the backtrace will have been recorded by the OCaml runtime.
>
> For example, `bind`'s second argument is a callback which returns a
> promise. And so it is recommended to use `raise` in the body of that
> callback.
>
> Use `Lwt.fail` only when you specifically want to create a rejected
> promise, to pass to another function, or store in a data structure.

Prefer to capture backtraces to improve debugability.

* Use Stdlib.raise instead of Lwt.fail to capture backtraces

README.md

@@ -154,7 +154,7 @@ let compute ~time ~f =
 let body =
   let get () = Client.get (Uri.of_string "https://www.reddit.com/") in
   compute ~time:0.1 ~f:get >>= function
-  | `Timeout -> Lwt.fail_with "Timeout expired"
+  | `Timeout -> failwith "Timeout expired"
   | `Done (resp, body) -> Lwt.return (resp, body)
 ```
 
@@ -174,7 +174,7 @@ For example,
 ```ocaml
 let get_body ~uri ~timeout =
     let%bind _, body = Cohttp_async.Client.get ~interrupt:(after (sec timeout)) uri in
-    Body.to_string body    
+    Body.to_string body
 
 let body =
   let uri = Uri.of_string "https://www.reddit.com/" in
@@ -275,19 +275,18 @@ and follow_redirect ~max_redirects request_uri (response, body) =
       handle_redirect ~permanent:true ~max_redirects request_uri response
   | `Found | `Temporary_redirect ->
       handle_redirect ~permanent:false ~max_redirects request_uri response
-  | `Not_found | `Gone -> Lwt.fail_with "Not found"
+  | `Not_found | `Gone -> failwith "Not found"
   | status ->
-      Lwt.fail_with
-        (Printf.sprintf "Unhandled status: %s"
-           (Cohttp.Code.string_of_status status))
+      Printf.ksprintf failwith "Unhandled status: %s"
+          (Cohttp.Code.string_of_status status)
 
 and handle_redirect ~permanent ~max_redirects request_uri response =
-  if max_redirects <= 0 then Lwt.fail_with "Too many redirects"
+  if max_redirects <= 0 then failwith "Too many redirects"
   else
     let headers = Http.Response.headers response in
     let location = Http.Header.get headers "location" in
     match location with
-    | None -> Lwt.fail_with "Redirection without Location header"
+    | None -> failwith "Redirection without Location header"
     | Some url ->
         let open Lwt.Syntax in
         let uri = Uri.of_string url in

cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml

@@ -188,7 +188,7 @@ struct
   (* No implementation (can it be done?).  What should the failure exception be? *)
   exception Cohttp_lwt_xhr_callv_not_implemented
 
-  let callv ?ctx:_ _uri _reqs = Lwt.fail Cohttp_lwt_xhr_callv_not_implemented
+  let callv ?ctx:_ _uri _reqs = raise Cohttp_lwt_xhr_callv_not_implemented
 
   (* ??? *)
 end
@@ -269,7 +269,7 @@ module Make_client_async (P : Params) = Make_api (struct
         CLB.to_string body >>= fun body ->
         let bs = binary_string body in
         (*Js.Opt.case (File.CoerceTo.blob (Obj.magic blob))
-          (fun () -> Lwt.fail_with "could not coerce to blob")
+          (fun () -> failwith "could not coerce to blob")
           (fun blob -> Lwt.return (xml##(send_blob blob)))*)
         (*Lwt.return (xml##send (Js.Opt.return bs)) *)
         Lwt.return (xml##send (Js.Opt.return (Obj.magic bs))))

cohttp-lwt-unix/bin/cohttp_server_lwt.ml

@@ -79,8 +79,8 @@ let serve ~info ~docroot ~index uri path =
             Server.respond_string ~status:`Not_found
               ~body:(html_of_not_found path info)
               ()
-          else Lwt.fail e
-      | e -> Lwt.fail e)
+          else Lwt.reraise e
+      | e -> Lwt.reraise e)
 
 let handler ~info ~docroot ~index (ch, _conn) req _body =
   let uri = Cohttp.Request.uri req in

cohttp-lwt-unix/examples/client_lwt_timeout.ml

@@ -11,7 +11,7 @@ let compute ~time ~f =
 let body =
   let get () = Client.get (Uri.of_string "https://www.reddit.com/") in
   compute ~time:0.1 ~f:get >>= function
-  | `Timeout -> Lwt.fail_with "Timeout expired"
+  | `Timeout -> failwith "Timeout expired"
   | `Done (resp, body) ->
       let code = resp |> Response.status |> Code.code_of_status in
       Printf.printf "Response code: %d\n" code;

cohttp-lwt-unix/src/io.ml

@@ -40,12 +40,12 @@ let wrap_read f ~if_closed =
      https://github.com/ocsigen/lwt/pull/635 *)
   Lwt.catch f (function
     | Lwt_io.Channel_closed _ -> Lwt.return if_closed
-    | Unix.Unix_error _ as e -> Lwt.fail (IO_error e)
+    | Unix.Unix_error _ as e -> raise (IO_error e)
     | exn -> raise exn)
 
 let wrap_write f =
   Lwt.catch f (function
-    | Unix.Unix_error _ as e -> Lwt.fail (IO_error e)
+    | Unix.Unix_error _ as e -> raise (IO_error e)
     | exn -> raise exn)
 
 let read_line ic =
@@ -80,6 +80,6 @@ type error = exn
 let catch f =
   Lwt.try_bind f Lwt.return_ok (function
     | IO_error e -> Lwt.return_error e
-    | ex -> Lwt.fail ex)
+    | ex -> Lwt.reraise ex)
 
 let pp_error = Fmt.exn

cohttp-lwt-unix/src/server.ml

@@ -16,8 +16,8 @@ let respond_file ?headers ~fname () =
     (fun () ->
       (* Check this isn't a directory first *)
       ( fname |> Lwt_unix.stat >>= fun s ->
-        if Unix.(s.st_kind <> S_REG) then Lwt.fail Isnt_a_file
-        else Lwt.return_unit )
+        if Unix.(s.st_kind <> S_REG) then raise Isnt_a_file else Lwt.return_unit
+      )
       >>= fun () ->
       let count = 16384 in
       Lwt_io.open_file ~buffer:(Lwt_bytes.create count) ~mode:Lwt_io.input fname
@@ -55,7 +55,7 @@ let respond_file ?headers ~fname () =
     (function
       | Unix.Unix_error (Unix.ENOENT, _, _) | Isnt_a_file ->
           respond_not_found ()
-      | exn -> Lwt.fail exn)
+      | exn -> Lwt.reraise exn)
 
 let log_on_exn = function
   | Unix.Unix_error (error, func, arg) ->

cohttp-lwt-unix/test/cohttp_lwt_unix_test/src/cohttp_lwt_unix_test.ml

@@ -20,7 +20,7 @@ let expert ?(rsp = Http.Response.make ()) f _req _body =
   return (`Expert (rsp, f))
 
 let const rsp _req _body = rsp >|= response
-let response_sequence = Cohttp_test.response_sequence Lwt.fail_with
+let response_sequence = Cohttp_test.response_sequence failwith
 let () = Debug.activate_debug ()
 let () = Logs.set_level (Some Info)
 
@@ -36,9 +36,9 @@ let temp_server ?port spec callback =
       (fun () -> Server.create ~backlog:40 ~mode:(`TCP (`Port port)) server)
       (function
         | Lwt.Canceled -> Lwt.return_unit
-        | x ->
-            Lwt.wakeup_exn server_failed_wake x;
-            Lwt.fail x)
+        | exn ->
+            Lwt.wakeup_exn server_failed_wake exn;
+            Lwt.reraise exn)
   in
   Lwt.pick [ Lwt_unix.with_timeout 5.0 (fun () -> callback uri); server_failed ]
   >|= fun res ->

cohttp-lwt-unix/test/test_client.ml

@@ -54,18 +54,18 @@ let methods (handler : Cohttp_lwt.S.call) uri =
     Body.drain_body body >>= fun () ->
     match Response.status res with
     | `Created | `No_content | `OK -> Lwt.return_unit
-    | _ -> Lwt.fail_with "put failed"
+    | _ -> failwith "put failed"
   and get k =
     handler `GET Uri.(with_path uri k) >>= fun (res, body) ->
     match Response.status res with
     | `OK | `No_content -> Body.to_string body
-    | _ -> Body.drain_body body >>= fun () -> Lwt.fail Not_found
+    | _ -> Body.drain_body body >>= fun () -> raise Not_found
   and delete k =
     handler `DELETE Uri.(with_path uri k) >>= fun (res, body) ->
     Body.drain_body body >>= fun () ->
     match Response.status res with
     | `OK | `No_content -> Lwt.return_unit
-    | _ -> Lwt.fail Not_found
+    | _ -> raise Not_found
   and mem k =
     handler `HEAD Uri.(with_path uri k) >>= fun (res, body) ->
     Body.drain_body body >|= fun () ->
@@ -171,10 +171,10 @@ let test_unknown uri =
             connection := c;
             match body with
             (* Still, body may have been (partially) consumed and needs re-creation. *)
-            | Some (`Stream _) -> Lwt.fail Connection.Retry
+            | Some (`Stream _) -> raise Connection.Retry
             | None | Some (`Empty | `String _ | `Strings _) ->
                 handler ?headers ?body meth uri)
-        | e -> Lwt.fail e)
+        | e -> Lwt.reraise e)
   in
   tests handler uri
 

cohttp-lwt/src/connection.ml

@@ -172,7 +172,7 @@ module Make (Net : S.Net) : S.Connection with module Net = Net = struct
         Queue.push { uri; meth; headers; body; res_r } connection.waiting;
         Lwt_condition.broadcast connection.condition ();
         res
-    | Closing _ | Half _ | Closed | Failed _ -> Lwt.fail Retry
+    | Closing _ | Half _ | Closed | Failed _ -> raise Retry
 
   let rec writer connection =
     match connection.state with

cohttp-lwt/src/connection_cache.ml

@@ -161,10 +161,10 @@ end = struct
         (function
           | Retry -> (
               match body with
-              | Some (`Stream _) -> Lwt.fail Retry
+              | Some (`Stream _) -> raise Retry
               | None | Some `Empty | Some (`String _) | Some (`Strings _) ->
-                  if retry <= 0 then Lwt.fail Retry else request (retry - 1))
-          | e -> Lwt.fail e)
+                  if retry <= 0 then raise Retry else request (retry - 1))
+          | e -> Lwt.reraise e)
     in
     request self.retry
 end

cohttp-lwt/src/server.ml

@@ -105,7 +105,7 @@ module Make (IO : S.IO) = struct
         Lwt.catch
           (fun () -> callback conn req body)
           (function
-            | Out_of_memory -> Lwt.fail Out_of_memory
+            | Out_of_memory -> Lwt.reraise Out_of_memory
             | exn ->
                 Log.err (fun f ->
                     f "Error handling %a: %s" Request.pp_hum req
@@ -177,5 +177,5 @@ module Make (IO : S.IO) = struct
             Lwt.return_unit)
       (fun e ->
         conn_closed ();
-        Lwt.fail e)
+        Lwt.reraise e)
 end

cohttp-mirage/src/input_channel.ml

@@ -13,7 +13,7 @@ module Make (Channel : Mirage_channel.S) = struct
         Cstruct.blit_to_bytes v 0 buf pos len;
         Lwt.return (`Ok len)
     | Ok `Eof -> Lwt.return `Eof
-    | Error e -> Lwt.fail (Read_exn e)
+    | Error e -> raise (Read_exn e)
 
   let create ?(buf_len = 0x4000) chan =
     { buf = Bytebuffer.create buf_len; chan }

cohttp-mirage/src/io.ml

@@ -54,8 +54,8 @@ module Make (Channel : Mirage_channel.S) = struct
     Channel.write_string oc buf 0 (String.length buf);
     Channel.flush oc >>= function
     | Ok () -> Lwt.return_unit
-    | Error `Closed -> Lwt.fail_with "Trying to write on closed channel"
-    | Error e -> Lwt.fail (Write_exn e)
+    | Error `Closed -> failwith "Trying to write on closed channel"
+    | Error e -> raise (Write_exn e)
 
   let flush _ =
     (* NOOP since we flush in the normal writer functions above *)
@@ -68,5 +68,5 @@ module Make (Channel : Mirage_channel.S) = struct
     Lwt.try_bind f Lwt.return_ok (function
       | Input_channel.Read_exn e -> Lwt.return_error (Read_error e)
       | Write_exn e -> Lwt.return_error (Write_error e)
-      | ex -> Lwt.fail ex)
+      | ex -> Lwt.reraise ex)
 end

cohttp-mirage/src/static.ml

@@ -24,7 +24,7 @@ module HTTP (FS : Mirage_kv.RO) (S : Cohttp_lwt.S.Server) = struct
   open Lwt.Infix
   open Astring
 
-  let failf fmt = Fmt.kstr Lwt.fail_with fmt
+  let failf fmt = Fmt.failwith fmt
 
   let read_fs t name =
     FS.get t (Key.v name) >>= function