cors options in implementations

OCamlPro · Oct 1, 2024 · ef47753 · ef47753
1 parent 938e0a4
commit ef47753
Show file tree

Hide file tree

Showing 4 changed files with 16 additions and 8 deletions.
diff --git a/src/server/cohttp/ezAPIServerCohttp.ml b/src/server/cohttp/ezAPIServerCohttp.ml
@@ -116,5 +116,7 @@ let create_server ?catch ?allow_origin ?allow_headers ?allow_methods
     ~mode:(`TCP (`Port server_port))
     (Server.make_response_action ~callback ())
 
-let server ?catch servers =
-  Lwt.join (List.map (fun (port,kind) -> create_server ?catch port kind) servers)
+let server ?catch ?allow_origin ?allow_headers ?allow_methods ?allow_credentials servers =
+  Lwt.join (List.map (fun (port,kind) ->
+      create_server ?catch ?allow_origin ?allow_headers ?allow_methods ?allow_credentials
+        port kind) servers)
diff --git a/src/server/ezAPIServerUtils.ml b/src/server/ezAPIServerUtils.ml
@@ -151,12 +151,12 @@ let handle ?meth ?content_type ?ws s r path body =
         | Some ws -> ws ?onclose ?step ~react ~bg r.Req.req_id
       end >|= fun ra -> `ws ra
 
+type allow_kind_without_none = [ `all | `default | `custom of string list ]
 type allow_kind = [ `all | `default | `custom of string list ]
-type allow_kind_with_none = [ `all | `default | `custom of string list ]
 
 let merge_headers_allow ~dft ~key headers = function
   | `none -> headers
-  | #allow_kind as k ->
+  | #allow_kind_without_none as k ->
     let v old =
       match k, old with
       | `all, _ -> "*"

diff --git a/src/server/httpaf/ezAPIServerHttpAf.ml b/src/server/httpaf/ezAPIServerHttpAf.ml
@@ -322,10 +322,12 @@ let create_server ?catch ?allow_origin ?allow_headers ?allow_methods ?allow_cred
           ?allow_credentials s sockaddr fd) >>= fun _server ->
   Lwt.return_unit
 
-let server ?catch servers =
+let server ?catch ?allow_origin ?allow_headers ?allow_methods ?allow_credentials servers =
   let max_connections =
     let n = List.length servers in
     if n = 0 then 0 else limit_open_file () / 2 / n in
   let waiter = fst @@ Lwt.wait () in
-  Lwt.join (List.map (fun (port,kind) -> create_server ?catch ~max_connections port kind) servers) >>= fun () ->
+  Lwt.join (List.map (fun (port,kind) ->
+      create_server ?catch ?allow_origin ?allow_headers ?allow_methods
+        ?allow_credentials ~max_connections port kind) servers) >>= fun () ->
   waiter (* keep the server running *)
diff --git a/src/server/virtual/ezServer.mli b/src/server/virtual/ezServer.mli
@@ -8,7 +8,11 @@
 (*                                                                        *)
 (**************************************************************************)
 
-val server : ?catch:(string -> exn -> string EzAPIServerUtils.Answer.t Lwt.t) ->
-  (int * EzAPIServerUtils.server_kind) list -> unit Lwt.t
+open EzAPIServerUtils
+
+val server : ?catch:(string -> exn -> string Answer.t Lwt.t) ->
+  ?allow_origin:[ allow_kind | `origin ] -> ?allow_headers:allow_kind ->
+  ?allow_methods:allow_kind -> ?allow_credentials:bool ->
+  (int * server_kind) list -> unit Lwt.t
 
 val set_debug : unit -> unit