Add credentials to fetch api

rizo · Jun 17, 2024 · c930d78 · c930d78
1 parent 99248b4
commit c930d78
Show file tree

Hide file tree

Showing 2 changed files with 13 additions and 3 deletions.
diff --git a/vendor/stdweb/src/Stdweb.mli b/vendor/stdweb/src/Stdweb.mli
@@ -551,12 +551,14 @@ module Fetch : sig
     [ `Get | `Put | `Post | `Delete | `Head | `Connect | `Trace | `Options ]
 
   type mode = [ `Cors | `No_cors ]
+  type credentials = [ `Omit | `Same_origin | `Include ]
 
   val fetch :
     ?body:Body.t ->
     ?meth:meth ->
     ?headers:(string * string) list ->
     ?mode:mode ->
+    ?credentials:credentials ->
     string ->
     response Promise.t
 end

diff --git a/vendor/stdweb/src/Stdweb_fetch.ml b/vendor/stdweb/src/Stdweb_fetch.ml
@@ -36,6 +36,7 @@ type meth =
   [ `Get | `Put | `Post | `Delete | `Head | `Connect | `Trace | `Options ]
 
 type mode = [ `Cors | `No_cors ]
+type credentials = [ `Omit | `Same_origin | `Include ]
 type options = Jx.t
 type headers = Jx.t
 
@@ -54,7 +55,7 @@ end
 module Options = struct
   type t = options
 
-  let make ?body ?meth ?(headers = []) ?mode () =
+  let make ?body ?meth ?(headers = []) ?mode ?credentials () =
     let open Jx.Encoder in
     let fields = [] in
     let fields =
@@ -71,6 +72,13 @@ module Options = struct
       | Some `No_cors -> ("mode", string "no-cors") :: fields
       | None -> fields
     in
+    let fields =
+      match credentials with
+      | Some `Omit -> ("credentials", string "omit") :: fields
+      | Some `Same_origin -> ("credentials", string "same-origin") :: fields
+      | Some `Include -> ("credentials", string "include") :: fields
+      | None -> fields
+    in
     let fields =
       match body with
       | Some body -> ("body", Body.to_js body) :: fields
@@ -116,7 +124,7 @@ module Response = struct
   let to_js = Jx.Encoder.js
 end
 
-let fetch ?body ?(meth = `Get) ?headers ?mode url =
-  let opts = Options.make ~meth ?headers ?mode ?body () in
+let fetch ?body ?(meth = `Get) ?headers ?mode ?credentials url =
+  let opts = Options.make ~meth ?headers ?mode ?credentials ?body () in
   Jx.Obj.call2 Stdweb_global.window "fetch" ~return:Response.of_js
     Jx.Encoder.string Options.to_js url opts