wip: new IO API with streams

src/Tiny_httpd.ml

@@ -2,14 +2,209 @@ type input_stream = (bytes -> int -> int -> int) * (unit -> unit)
 (** An input stream is a function to read bytes into a buffer,
     and a function to close *)
 
-type output_stream = (bytes -> int -> int -> unit) * (unit -> unit) * (unit -> unit)
+type output_stream = (string -> int -> int -> unit) * (unit -> unit) * (unit -> unit)
 (** An output stream is a function to output bytes, a function to [flush],
     and a function to close. *)
 
-module Input_stream = struct
+module Buf_ = struct
+  type t = {
+    mutable bytes: bytes;
+    mutable i: int;
+  }
 
+  let create ?(size=4_096) () : t =
+    { bytes=Bytes.make size ' '; i=0 }
+
+  let size self = self.i
+  let clear self : unit =
+    if Bytes.length self.bytes > 4_096 * 1_024 then (
+      self.bytes <- Bytes.make 4096 ' '; (* free big buffer *)
+    );
+    self.i <- 0
+
+  let resize self new_size : unit =
+    let new_buf = Bytes.make new_size ' ' in
+    Bytes.blit self.bytes 0 new_buf 0 self.i;
+    self.bytes <- new_buf
+
+  let ensure_size self n : unit =
+    if Bytes.length self.bytes < n then (
+      resize self n;
+    )
+
+  let add_string (self:t) s i len : unit =
+    if Bytes.length self.bytes < self.i + len then (
+      resize self (self.i + self.i / 8 + len + 10);
+    );
+    Bytes.blit_string s i self.bytes self.i len;
+    self.i <- self.i + len
+
+  let read_once (self:t) ~read : int =
+    (* resize if needed *)
+    if self.i = Bytes.length self.bytes then (
+      resize self (self.i + self.i / 8 + 10);
+    );
+    let n_rd = read self.bytes self.i (Bytes.length self.bytes - self.i) in
+    self.i <- self.i + n_rd;
+    n_rd
+
+  (* remove the first [i] bytes *)
+  let remove_prefix (self:t) (i:int) : unit =
+    if i > self.i then invalid_arg "Buf_.contents_slice";
+    if i<self.i then (
+      Bytes.blit self.bytes i self.bytes 0 (self.i - i);
+    );
+    self.i <- self.i - i
+
+  let contents (self:t) : string = Bytes.sub_string self.bytes 0 self.i
+
+  let contents_slice (self:t) i len : string =
+    if i+len > self.i then invalid_arg "Buf_.contents_slice";
+    Bytes.sub_string self.bytes i len
+
+  let contents_and_clear (self:t) : string =
+    let x = contents self in
+    clear self;
+    x
 end
 
+module Input_stream = struct
+  type t = input_stream
+
+  let close (_,cl : t) = cl ()
+  let of_chan ic : t = input ic, fun () -> close_in ic
+  let of_chan_close_noerr ic : t = input ic, fun () -> close_in_noerr ic
+
+  let of_buf_ ?(i=0) ?len ~get_len ~blit s : t =
+    let off = ref i in
+    let s_len = match len with
+      | Some n -> min n (get_len s-i)
+      | None -> get_len s-i
+    in
+    let read buf i len =
+      let n = min len (s_len - !off) in
+      if n > 0 then (
+        blit s !off buf i n;
+        off := !off + n;
+      );
+      n
+    in
+    read, (fun () -> ())
+
+  let of_string ?i ?len s : t =
+    of_buf_ ?i ?len ~get_len:String.length ~blit:Bytes.blit_string s
+
+  let of_bytes ?i ?len s : t =
+    of_buf_ ?i ?len ~get_len:Bytes.length ~blit:Bytes.blit s
+
+  let with_file file f =
+    let ic = open_in file in
+    try
+      let x = f (of_chan_close_noerr ic) in
+      close_in ic;
+      x
+    with e ->
+      close_in_noerr ic;
+      raise e
+
+  let read_all ?(buf=Buf_.create()) (self:t) : string =
+    let (read, _) = self in
+    let continue = ref true in
+    while !continue do
+      let n_rd = Buf_.read_once buf ~read in
+      if n_rd = 0 then (
+        continue := false
+      )
+    done;
+    Buf_.contents_and_clear buf
+
+  let read_exactly ~too_short ?buf (self:t) (n:int) : unit =
+    let buf = match buf with
+      | Some buf ->
+        Buf_.ensure_size buf n;
+        buf
+      | None ->  Buf_.create ~size:n ()
+    in
+    let i = ref 0 in
+    while !i < n do
+      let is_read, _ = self in
+      let n_read = is_read buf.bytes !i (n- !i) in
+      if n_read=0 then too_short();
+      i := !i + n_read
+    done
+
+  let read_line ?(buf=Buf_.create()) (self:t) : string =
+    let rec read_chunk acc =
+      Buf_.clear buf;
+      let is_read, _ = self in
+      let _n = Buf_.read_once buf ~read:is_read in
+      match Bytes.index buf.Buf_.bytes '\n' with
+      | i ->
+        let s = Buf_.contents_slice buf 0 i in
+        Buf_.remove_prefix buf (i+1);
+        s :: acc
+      | exception Not_found ->
+        read_chunk (Buf_.contents_and_clear buf :: acc)
+    in
+    match read_chunk [] with
+    | [] -> ""
+    | [s] -> s
+    | [s1;s2] -> s1^s2
+    | l -> String.concat "" l
+      
+end
+
+module Output_stream = struct
+  type t = output_stream
+
+  let of_chan oc : t =
+    (output_substring oc, (fun () -> flush oc), (fun () -> close_out oc))
+
+  let of_chan_close_noerr oc : t =
+    (output_substring oc, (fun () -> flush oc), (fun () -> close_out_noerr oc))
+
+  let of_buf (buf:Buf_.t) : t =
+    let wr b i len =
+      Buf_.add_string buf b i len
+    in
+    (wr, (fun()->()), (fun()->()))
+
+  let with_file file f =
+    let oc = open_out file in
+    try
+      let x = f (of_chan_close_noerr oc) in
+      close_out oc;
+      x
+    with e ->
+      close_out_noerr oc;
+      raise e
+
+  let write (self:t) s =
+    let wr, _, _ = self in
+    wr s 0 (String.length s)
+  let flush self : unit = let _, fl, _ = self in fl()
+  let close self : unit = let _, _, cl = self in cl()
+end
+
+let pipe ?(buf=Buf_.create()) (is:input_stream) (os:output_stream) : unit =
+  let continue = ref true in
+  while !continue do
+    Buf_.clear buf;
+    let rd, _ = is in
+    let n = Buf_.read_once buf ~read:rd in
+    if n=0 then (
+      continue := false
+    ) else (
+      let wr, _, _ = os in
+      wr (Bytes.unsafe_to_string buf.bytes) 0 n
+    )
+  done;
+  Output_stream.flush os;
+  Input_stream.close is;
+  Output_stream.close os;
+  ()
+
+
 exception Bad_req of int * string
 let bad_reqf c fmt = Printf.ksprintf (fun s ->raise (Bad_req (c,s))) fmt
 
@@ -28,6 +223,8 @@ let _debug k =
 module Response_code = struct
   type t = int
 
+  let ok = 200
+  let not_found = 404
   let descr = function
     | 100 -> "Continue"
     | 200 -> "OK"
@@ -50,7 +247,7 @@ module Response_code = struct
     | 500 -> "Internal server error"
     | 501 -> "Not implemented"
     | 503 -> "Service unavailable"
-    | _ -> "Unknown response" (* TODO *)
+    | n -> "Unknown response code " ^ string_of_int n (* TODO *)
 end
 
 type 'a resp_result = ('a, Response_code.t * string) result 
@@ -93,9 +290,9 @@ module Headers = struct
     let pp_pair out (k,v) = Format.fprintf out "@[<h>%s: %s@]" k v in
     Format.fprintf out "@[<v>%a@]" (Format.pp_print_list pp_pair) l
 
-  let parse_ (is:input_stream) : t =
+  let parse_ ~buf (is:input_stream) : t =
     let rec loop acc =
-      let line = input_line is.ic in
+      let line = Input_stream.read_line ~buf is in
       if line = "\r" then (
         List.rev acc
       ) else (
@@ -132,24 +329,18 @@ module Request = struct
       (Meth.to_string self.meth) Headers.pp self.headers
       self.path self.body
 
-  let read_body (is:input_stream) (n:int) : string =
+  let read_body ~buf (is:input_stream) (n:int) : string =
     _debug (fun k->k "read body of size %d" n);
-    if Bytes.length is.buf < n then (
+    Input_stream.read_exactly ~buf is n
-      is.buf <- Bytes.make n ' ';
+      ~too_short:(fun () -> bad_reqf 400 "body is too short");
-    );
+    Buf_.contents_and_clear buf
-    let i = ref 0 in
-    while !i < n do
-      let read = input is.ic is.buf !i (n- !i) in
-      if read=0 then bad_reqf 400 "body is too short";
-      i := !i + read
-    done;
-    Bytes.sub_string is.buf 0 n
 
-  let read_body_chunked ~size:max_size (is:input_stream) : string =
+  let read_body_chunked ~buf:buf_line ~size:max_size (is:input_stream) : string =
     _debug (fun k->k "read body with chunked encoding (max-size: %d)" max_size);
-    let n = ref 0 in
+    let buf_res = Buf_.create() in (* store the accumulated chunks *)
     let rec read_chunks () =
-      let line = input_line is.ic in
+      Buf_.clear buf_line;
+      let line = Input_stream.read_line ~buf:buf_line is in
       (* parse chunk length, ignore extensions *)
       let chunk_size =
         if String.trim line = "" then 0
@@ -159,42 +350,34 @@ module Request = struct
       in
       _debug (fun k->k "chunk size: %d" chunk_size);
       if chunk_size = 0 then (
-        Bytes.sub_string is.buf 0 !n (* done *)
+        Buf_.contents buf_res (* done *)
       ) else (
-        let new_size = chunk_size + !n in
+        let new_size = chunk_size + Buf_.size buf_res in
         (* is the body bigger than expected? *)
         if max_size>0 && new_size > max_size then (
           bad_reqf 413
             "body size was supposed to be %d, but at least %d bytes received"
             max_size new_size
         );
-        (* resize buffer if needed *)
+        Input_stream.read_exactly
-        if Bytes.length is.buf < new_size then (
+          ~too_short:(fun () -> bad_reqf 400 "chunk is too short")
-          let new_buf = Bytes.make (new_size + 10) ' ' in
+          is ~buf:buf_res chunk_size;
-          Bytes.blit is.buf 0 new_buf 0 !n;
+        _debug (fun k->k "read a chunk of size %d" chunk_size);
-          is.buf <- new_buf;
-        );
-        while !n < new_size do
-          let read = input is.ic is.buf !n (new_size - !n) in
-          if read=0 then bad_reqf 400 "body is too short";
-          n := !n + read
-        done;
-        _debug (fun k->k "read a chunk");
         read_chunks()
       )
     in
     read_chunks()
 
   (* parse request, but not body (yet) *)
-  let parse_req_start (is:input_stream) : unit t option resp_result =
+  let parse_req_start ~buf (is:input_stream) : unit t option resp_result =
     try
-      let line = input_line is.ic in
+      let line = Input_stream.read_line ~buf is in
       let meth, path =
         try Scanf.sscanf line "%s %s HTTP/1.1\r" (fun x y->x,y)
         with _ -> raise (Bad_req (400, "Invalid request line"))
       in
       let meth = Meth.of_string meth in
-      let headers = Headers.parse_ is in
+      let headers = Headers.parse_ ~buf is in
       _debug (fun k->k "got meth: %s, path %S" (Meth.to_string meth) path);
       Ok (Some {meth; path; headers; body=()})
     with
@@ -204,7 +387,7 @@ module Request = struct
       Error (400, Printexc.to_string e)
 
   (* parse body, given the headers *)
-  let parse_body_ (is:input_stream) (req:_ t) : string t resp_result =
+  let parse_body_ ~buf (req:input_stream t) : string t resp_result =
     try
       let n =
         match List.assoc "Content-Length" req.headers |> int_of_string with
@@ -214,10 +397,10 @@ module Request = struct
       in
       let body =
         match List.assoc "Transfer-Encoding" req.headers |> String.trim with
-        | "chunked" -> read_body_chunked ~size:n is (* body sent by chunks *)
+        | "chunked" -> read_body_chunked ~buf ~size:n req.body (* body sent by chunks *)
         | s -> bad_reqf 500 "cannot handle transfer encoding: %s" s
         | exception Not_found ->
-          read_body is n
+          read_body ~buf req.body n
       in
       Ok {req with body}
     with
@@ -225,15 +408,18 @@ module Request = struct
     | Bad_req (c,s) -> Error (c,s)
     | e ->
       Error (400, Printexc.to_string e)
+
+  let read_body_full ?buf (self:input_stream t) : string t =
+    try
+      let body = Input_stream.read_all ?buf self.body in
+      { self with body }
+    with
+    | Bad_req _ as e -> raise e
+    | e -> bad_reqf 500 "failed to read body: %s" (Printexc.to_string e)
 end
 
 module Response = struct
-  type out_stream = bytes -> int -> int -> int
+  type body = [`String of string | `Stream of input_stream]
-  type body = [
-    | `String of string
-    | `Stream of out_stream
-  ]
-
   type t = {
     code: Response_code.t;
     headers: Headers.t;
@@ -250,15 +436,23 @@ module Response = struct
     in
     { code; headers; body=`String body; }
 
-  let make_raw_chunked ?(headers=[]) ~code body : t =
+  let make_raw_stream ?(headers=[]) ~code body : t =
     (* add content length to response *)
     let headers = Headers.set "Transfer-Encoding" "chunked" headers in
     { code; headers; body=`Stream body; }
 
-  let make ?headers r : t = match r with
+  let make_string ?headers r = match r with
     | Ok body -> make_raw ?headers ~code:200 body
-    | Error (code,msg) ->
+    | Error (code,msg) -> make_raw ?headers ~code msg
-      make_raw ?headers ~code msg
+
+  let make_stream ?headers r = match r with
+    | Ok body -> make_raw_stream ?headers ~code:200 body
+    | Error (code,msg) -> make_raw ?headers ~code msg
+
+  let make ?headers r : t = match r with
+    | Ok (`String body) -> make_raw ?headers ~code:200 body
+    | Ok (`Stream body) -> make_raw_stream ?headers ~code:200 body
+    | Error (code,msg) -> make_raw ?headers ~code msg
 
   let fail ?headers ~code fmt =
     Printf.ksprintf (fun msg -> make_raw ?headers ~code msg) fmt
@@ -274,18 +468,20 @@ module Response = struct
       self.code Headers.pp self.headers pp_body self.body
 
   (* print a stream as a series of chunks *)
-  let output_stream_ (oc:out_channel) (str:out_stream) : unit =
+  let output_stream_ (oc:out_channel) (str:input_stream) : unit =
-    let buf = Bytes.make 4096 ' ' in
+    let buf = Buf_.create ~size:4096 () in
     let continue = ref true in
     while !continue do
+      Buf_.clear buf;
       (* next chunk *)
-      let n = str buf 0 (Bytes.length buf) in
+      let read, _ = str in
+      let n = Buf_.read_once buf ~read in
       _debug (fun k->k "send chunk of size %d" n);
       Printf.fprintf oc "%x\r\n" n;
       if n = 0 then (
         continue := false;
       ) else (
-        output oc buf 0 n;
+        output oc buf.bytes 0 n;
       );
       output_string oc "\r\n";
     done;
@@ -308,11 +504,11 @@ type cb_path_handler = string Request.t -> Response.t
 type t = {
   addr: string;
   port: int;
-  fork: (unit -> unit) -> unit;
+  new_thread: (unit -> unit) -> unit;
   masksigpipe: bool;
   mutable handler: (string Request.t -> Response.t);
   mutable path_handlers : (unit Request.t -> cb_path_handler resp_result option) list;
-  mutable cb_decode_req: (string Request.t -> string Request.t option) list;
+  mutable cb_decode_req: (input_stream Request.t -> input_stream Request.t option) list;
   mutable cb_encode_resp: (string Request.t -> Response.t -> Response.t option) list;
   mutable running: bool;
 }
@@ -346,10 +542,10 @@ let add_path_handler
 
 let create
     ?(masksigpipe=true)
-    ?(fork=(fun f -> ignore (Thread.create f () : Thread.t)))
+    ?(new_thread=(fun f -> ignore (Thread.create f () : Thread.t)))
     ?(addr="127.0.0.1") ?(port=8080) () : t =
   let handler _req = Response.fail ~code:404 "no top handler" in
-  { fork; addr; port; masksigpipe; handler; running= true;
+  { new_thread; addr; port; masksigpipe; handler; running= true;
     path_handlers=[];
     cb_encode_resp=[]; cb_decode_req=[];
   }
@@ -368,12 +564,12 @@ let find_map f l =
 let handle_client_ (self:t) (client_sock:Unix.file_descr) : unit =
   let ic = Unix.in_channel_of_descr client_sock in
   let oc = Unix.out_channel_of_descr client_sock in
-  (* wrap [ic] in a stream with a reusable buffer *)
+  let buf = Buf_.create() in
-  let is = {ic; buf=Bytes.make 1024 ' '} in
+  let is = Input_stream.of_chan ic in
   let continue = ref true in
   while !continue && self.running do
     _debug (fun k->k "read next request");
-    match Request.parse_req_start is with
+    match Request.parse_req_start ~buf is with
     | Ok None -> continue := false
     | Error (c,s) ->
       let res = Response.make_raw ~code:c s in
@@ -395,14 +591,15 @@ let handle_client_ (self:t) (client_sock:Unix.file_descr) : unit =
             | s -> bad_reqf 417 "unknown expectation %s" s
             | exception Not_found -> ()
           end;
-          (* modify request by reading body *)
+          (* preprocess request's input stream *)
-          let req = Request.parse_body_ is req |> unwrap_resp_result in
+          let req = {req with body=is} in
-          (* preprocess query *)
           let req =
             List.fold_left
               (fun req cb -> match cb req with None -> req | Some r' -> r')
               req self.cb_decode_req
           in
+          (* now actually read request's body *)
+          let req = Request.parse_body_ ~buf req |> unwrap_resp_result in
           let resp = handler req in
           (* post-process response *)
           List.fold_left
@@ -439,7 +636,7 @@ let run (self:t) : (unit,_) result =
     Unix.listen sock 10;
     while self.running do
       let client_sock, _ = Unix.accept sock in
-      self.fork
+      self.new_thread
         (fun () -> handle_client_ self client_sock);
     done;
     Ok ()

src/Tiny_httpd.mli

@@ -2,24 +2,51 @@ type input_stream = (bytes -> int -> int -> int) * (unit -> unit)
 (** An input stream is a function to read bytes into a buffer,
     and a function to close *)
 
-type output_stream = (bytes -> int -> int -> unit) * (unit -> unit) * (unit -> unit)
+type output_stream = (string -> int -> int -> unit) * (unit -> unit) * (unit -> unit)
 (** An output stream is a function to output bytes, a function to [flush],
     and a function to close. *)
 
+(** {2 Tiny buffer implementation} *)
+module Buf_ : sig
+  type t
+  val clear : t -> unit
+  val create : ?size:int -> unit -> t
+  val contents : t -> string
+end
+
+(** {2 Generic input stream} *)
 module Input_stream : sig
   type t = input_stream
 
   val of_chan : in_channel -> t
-  val of_string : string -> t
+  val of_chan_close_noerr : in_channel -> t
-  val of_bytes : bytes -> t
+  val of_string : ?i:int -> ?len:int -> string -> t
+  val of_bytes : ?i:int -> ?len:int -> bytes -> t
+  val close : t -> unit
+  val with_file : string -> (t -> 'a) -> 'a
+  (** Open a file with given name, and obtain an input stream *)
+
+  val read_line : ?buf:Buf_.t -> t -> string
+  val read_all : ?buf:Buf_.t -> t -> string
 end
 
+(** {2 Generic output stream} *)
 module Output_stream : sig
   type t = output_stream
-
   val of_chan : out_channel -> t
+  val of_chan_close_noerr : out_channel -> t
+  val of_buf : Buf_.t -> t
+  val write : t -> string -> unit
+  val flush : t -> unit
+  val close : t -> unit
+
+  val with_file : string -> (t -> 'a) -> 'a
+  (** Open a file with given name, and obtain an output stream *)
 end
 
+val pipe : ?buf:Buf_.t -> input_stream -> output_stream -> unit
+(** [pipe is os] pipes the content of [is] into [os]. *)
+
 module Meth : sig
   type t = [
     | `GET
@@ -57,16 +84,18 @@ module Request : sig
   val meth : _ t -> Meth.t
   val path : _ t -> string
   val body : 'b t -> 'b
+  val read_body_full : ?buf:Buf_.t -> input_stream t -> string t
 end
 
 module Response_code : sig
   type t = int
-
+  val ok : t
+  val not_found : t
   val descr : t -> string
 end
 
 module Response : sig
-  type out_stream = bytes -> int -> int -> int
+  type body = [`String of string | `Stream of input_stream]
   type t
 
   val make_raw :
@@ -75,16 +104,24 @@ module Response : sig
     string ->
     t
 
-  val make_raw_chunked :
+  val make_raw_stream :
     ?headers:Headers.t ->
     code:Response_code.t ->
-    out_stream ->
+    input_stream ->
     t
 
   val make :
+    ?headers:Headers.t ->
+    (body, Response_code.t * string) result -> t
+
+  val make_string :
     ?headers:Headers.t ->
     (string, Response_code.t * string) result -> t
 
+  val make_stream :
+    ?headers:Headers.t ->
+    (input_stream, Response_code.t * string) result -> t
+
   val fail : ?headers:Headers.t -> code:int ->
     ('a, unit, string, t) format4 -> 'a
   (** Make the current request fail with the given code and message.
@@ -104,25 +141,32 @@ type t
 
 val create :
   ?masksigpipe:bool ->
-  ?fork:((unit -> unit) -> unit) ->
+  ?new_thread:((unit -> unit) -> unit) ->
   ?addr:string ->
   ?port:int ->
   unit ->
   t
+(** TODO: document *)
 
 val addr : t -> string
 val port : t -> int
 
-val add_decode_request_cb : t -> (string Request.t -> string Request.t option) -> unit
+val add_decode_request_cb :
+  t ->
+  (input_stream Request.t -> input_stream Request.t option) -> unit
 (** Add a callback for every request.
     The callback can modify the request by returning [Some r'] where [r']
     is the new request, or just perform side effects (logging?) and return [None].
 *)
 
-val add_encode_response_cb: t -> (string Request.t -> Response.t -> Response.t option) -> unit
+val add_encode_response_cb:
+  t -> (string Request.t -> Response.t -> Response.t option) -> unit
 (** Add a callback for every request/response pair.
     Similarly to {!add_encode_response_cb} the callback can return a new
-    response, for example to compress it. *)
+    response, for example to compress it.
+    The callback is given the fully parsed query as well as the current
+    response.
+*)
 
 val set_top_handler : t -> (string Request.t -> Response.t) -> unit
 (** Setup a handler called by default.
@@ -149,8 +193,13 @@ val add_path_handler :
 *)
 
 val stop : t -> unit
-val run : t -> (unit, exn) result
+(** Ask the server to stop. This might not have an immediate effect
+    as {!run} might currently be waiting on IO. *)
 
+val run : t -> (unit, exn) result
+(** Run the main loop of the server, listening on a socket
+    described at the server's creation time, using [new_thread] to
+    start a thread for each new client. *)
 
 (**/**)
 

src/bin/http_of_dir.ml

@@ -63,7 +63,7 @@ let serve ~config (dir:string) : _ result =
          if contains_dot_dot path then (
            S.Response.fail_raise ~code:403 "invalid path in delete"
          );
-         S.Response.make
+         S.Response.make_string
            (try
               Sys.remove (dir // path); Ok "file deleted successfully"
             with e -> Error (500, Printexc.to_string e))
@@ -114,11 +114,11 @@ let serve ~config (dir:string) : _ result =
          let parent = Filename.(dirname path) in
          let parent = if parent <> path then Some parent else None in
          let body = html_list_dir ~top:dir path ~parent in
-         S.Response.make ~headers:[header_html] (Ok body)
+         S.Response.make_string ~headers:[header_html] (Ok body)
        ) else (
          try
            let ic = open_in full_path in
-           S.Response.make_raw_chunked ~code:200 (input ic)
+           S.Response.make_raw_stream ~code:200 (S.Input_stream.of_chan ic)
          with e ->
            S.Response.fail ~code:500 "error while reading file: %s" (Printexc.to_string e)
        ));

src/dune

@@ -3,4 +3,5 @@
   (name tiny_httpd)
   (public_name tiny_httpd)
   (libraries threads)
+  (flags :standard -safe-string)
   (wrapped false))

src/examples/echo.ml

@@ -10,10 +10,10 @@ let () =
   let server = S.create () in
   (* say hello *)
   S.add_path_handler ~meth:`GET server
-    "/hello/%s@/" (fun name _req -> S.Response.make (Ok ("hello " ^name ^"!\n")));
+    "/hello/%s@/" (fun name _req -> S.Response.make_string (Ok ("hello " ^name ^"!\n")));
   (* echo request *)
   S.add_path_handler server
-    "/echo" (fun req -> S.Response.make (Ok (Format.asprintf "echo:@ %a@." S.Request.pp req)));
+    "/echo" (fun req -> S.Response.make_string (Ok (Format.asprintf "echo:@ %a@." S.Request.pp req)));
   S.add_path_handler ~meth:`PUT server
     "/upload/%s" (fun path req ->
         debug_ (fun k->k "start upload %S\n%!" path);
@@ -21,7 +21,7 @@ let () =
           let oc = open_out @@ "/tmp/" ^ path in
           output_string oc req.S.Request.body;
           flush oc;
-          S.Response.make (Ok "uploaded file")
+          S.Response.make_string (Ok "uploaded file")
         with e ->
           S.Response.fail ~code:500 "couldn't upload file: %s" (Printexc.to_string e)
       );