From c930d780dc6bdc4d7680cc285e008e4a0aa3d51b Mon Sep 17 00:00:00 2001 From: Rizo Date: Mon, 17 Jun 2024 17:04:39 +0100 Subject: [PATCH] Add credentials to fetch api --- vendor/stdweb/src/Stdweb.mli | 2 ++ vendor/stdweb/src/Stdweb_fetch.ml | 14 +++++++++++--- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/vendor/stdweb/src/Stdweb.mli b/vendor/stdweb/src/Stdweb.mli index 3bea81c..d179dbc 100644 --- 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 index 9016be3..d35833e 100644 --- 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