Finish filter & fix Request.body bug

So apparently `Httpaf.Body.schedule_read` reuses the same buffer that it
passes to the `on_read` callback, so you have to copy it if you want to
keep the original one. See
inhabitedtype/httpaf#140 (comment)

ReWeb/Filter.ml

@@ -69,6 +69,8 @@ module type S = sig
       decoding and failure works in the same way as for [body_form]. *)
 end
 
+module H = Httpaf
+
 module Make(R : Request.S) : S
   with type ('fd, 'io) Service.Request.Reqd.t = ('fd, 'io) R.Reqd.t
   and type 'ctx Service.Request.t = 'ctx R.t = struct
@@ -158,6 +160,9 @@ module Make(R : Request.S) : S
 
   let multipart_ct_length = 30
 
+  let chunk_to_string { H.IOVec.buffer; off; len } =
+    Bigstringaf.substring buffer ~off ~len
+
   (* Complex because we need to keep track of files being uploaded *)
   let multipart_form ?(typ=Obj.magic Form.empty) path next request =
     match Request.meth request, Request.header "content-type" request with
@@ -166,21 +171,18 @@ module Make(R : Request.S) : S
       && String.sub content_type 0 multipart_ct_length = "multipart/form-data; boundary=" ->
       let stream = request
         |> Request.body
-        |> Body.to_piaf
-        |> Piaf.Body.to_string_stream
+        |> Body.to_stream
+        |> Lwt_stream.map chunk_to_string
       in
-      (*let files = Hashtbl.create ~random:true 5 in*)
+      let files = Hashtbl.create ~random:true 5 in
       let open Let.Lwt in
-      (*
       let close _ file prev =
-        let* () = Lwt_io.printf "Closing file\n" in
         let* () = prev in
         Lwt_unix.close file
       in
       let callback ~name ~filename string =
         let filename = path ~filename name in
         let write file =
-          let* () = Lwt_io.printf "Will write to file\n" in
           let f () = string
             |> String.length
             |> Lwt_unix.write_string file string 0
@@ -190,25 +192,15 @@ module Make(R : Request.S) : S
             exn |> Printexc.to_string |> Lwt_io.printf "ERROR: %s\n"
         in
         match Hashtbl.find_opt files filename with
-        | Some file ->
-          let* () = Lwt_io.printf "Will write to existing file\n" in
-          let* () = write file in
-          Lwt_io.printf "Wrote file\n"
+        | Some file -> write file
         | None ->
-          let* () = Lwt_io.printf "Will create new file\n" in
           let* file = Lwt_unix.openfile
             filename
             Unix.[O_CREAT; O_TRUNC; O_WRONLY; O_NONBLOCK]
             0o600
           in
-          let* () = Lwt_io.printf "Created new file\n" in
           Hashtbl.add files filename file;
-          let* () = write file in
-          Lwt_io.printf "Wrote file\n%!"
-      in
-      *)
-      let callback ~name ~filename _string = Lwt.return_unit
-        (*Lwt_io.printf "name: %s, filename: %s\n%!" name filename*)
+          write file
       in
       let f () =
         Multipart_form_data.parse ~stream ~content_type ~callback
@@ -217,11 +209,7 @@ module Make(R : Request.S) : S
         let+ () = exn |> Printexc.to_string |> Lwt_io.printf "ERROR: %s" in
         []
       in
-      let* () = Lwt_io.printf "Parsed form\n" in
-      (*
       let* () = Hashtbl.fold close files Lwt.return_unit in
-      let* () = Lwt_io.printf "Closed files\n" in
-  *)
       let fields = List.map (fun (k, v) -> k, [v]) fields in
       begin match Form.decode typ fields with
       | Ok obj ->

ReWeb/Request.ml

@@ -87,7 +87,11 @@ module Make(B : BODY)(R : REQD with type 'rw Body.t = 'rw B.t) = struct
     let stream, push_to_stream = Lwt_stream.create () in
     let on_eof () = push_to_stream None in
     let rec on_read buffer ~off ~len =
-      push_to_stream (Some { H.IOVec.off; len; buffer });
+      push_to_stream (Some {
+        H.IOVec.off;
+        len;
+        buffer = Bigstringaf.copy buffer ~off ~len
+      });
       B.schedule_read request_body ~on_eof ~on_read
     in
     B.schedule_read request_body ~on_eof ~on_read;