feat: add ability to define headers sent with each request

Author: eWert-Online

lib/OSnap.ml

@@ -119,6 +119,7 @@ let run ~env t =
            ; name = test.OSnap_Config.Types.name
            ; actions = test.OSnap_Config.Types.actions
            ; ignore_regions = test.OSnap_Config.Types.ignore
+           ; additional_headers = test.OSnap_Config.Types.additional_headers
            ; threshold = test.OSnap_Config.Types.threshold
            ; retry = test.OSnap_Config.Types.retry
            ; warnings = []

lib/OSnap_Browser/OSnap_Browser_Actions.ml

@@ -498,3 +498,27 @@ let clear_cookies target =
   in
   Result.ok ()
 ;;
+
+let set_headers ~headers target =
+  match headers with
+  | None -> Result.ok ()
+  | Some headers ->
+    let ( let*? ) = Result.bind in
+    let open Commands.Network in
+    let sessionId = target.sessionId in
+    let*? _ =
+      let open SetExtraHTTPHeaders in
+      let response =
+        Request.make ~sessionId ~params:(Params.make ~headers ()) |> OSnap_Websocket.send
+      in
+      let response = response |> Response.parse in
+      let error =
+        response.Response.error
+        |> Option.map (fun (error : Response.error) ->
+          `OSnap_CDP_Protocol_Error error.message)
+        |> Option.value ~default:(`OSnap_CDP_Protocol_Error "")
+      in
+      Option.to_result response.Response.result ~none:error
+    in
+    Result.ok ()
+;;

lib/OSnap_Browser/OSnap_Browser_Actions.mli

@@ -109,3 +109,8 @@ val screenshot
 val clear_cookies
   :  OSnap_Browser_Target.target
   -> (unit, [> `OSnap_CDP_Protocol_Error of string ]) Result.t
+
+val set_headers
+  :  headers:(string * string) list option
+  -> OSnap_Browser_Target.target
+  -> (unit, [> `OSnap_CDP_Protocol_Error of string ]) Result.t

lib/OSnap_Browser/OSnap_Browser_Target.ml

@@ -45,6 +45,18 @@ let enable_events t =
     in
     Option.to_result response.Response.result ~none:error
   in
+  let*? _ =
+    let open Network.Enable in
+    let params = Params.make () in
+    let response = Request.make ~sessionId ~params |> Websocket.send |> Response.parse in
+    let error =
+      response.Response.error
+      |> Option.map (fun (error : Response.error) ->
+        `OSnap_CDP_Protocol_Error error.message)
+      |> Option.value ~default:(`OSnap_CDP_Protocol_Error "")
+    in
+    Option.to_result response.Response.result ~none:error
+  in
   let*? _ =
     let open Page.SetLifecycleEventsEnabled in
     let response =

lib/OSnap_Config/OSnap_Config_Global.ml

@@ -126,6 +126,9 @@ module YAML = struct
       |> Result.join
       |> Result.map (Option.value ~default:0xFF0000FFl)
     in
+    let* additional_headers =
+      yaml |> OSnap_Config_Utils.YAML.parse_http_headers ~path "additionalHttpHeaders"
+    in
     let duplicates =
       default_sizes
       |> List.filter (fun (s : OSnap_Config_Types.size) -> Option.is_some s.name)
@@ -150,6 +153,7 @@ module YAML = struct
         ; snapshot_directory
         ; diff_pixel_color
         ; parallelism
+        ; additional_headers
         }
   ;;
 end

lib/OSnap_Config/OSnap_Config_Test.ml

@@ -100,8 +100,24 @@ module YAML = struct
            ~parser:(parse_ignore ~path)
       |> Result.map (Option.value ~default:[])
     in
+    let* additional_headers =
+      test
+      |> OSnap_Config_Utils.YAML.parse_http_headers ~path "additionalHttpHeaders"
+      |> Result.map (Option.fold ~some:Option.some ~none:global_config.additional_headers)
+    in
     let* () = Common.collect_duplicates sizes in
-    Result.ok { only; skip; threshold; retry; name; url; sizes; actions; ignore }
+    Result.ok
+      { only
+      ; skip
+      ; threshold
+      ; retry
+      ; name
+      ; url
+      ; sizes
+      ; actions
+      ; ignore
+      ; additional_headers
+      }
   ;;
 
   let parse global_config path =

lib/OSnap_Config/OSnap_Config_Types.ml

@@ -25,6 +25,8 @@ type ignoreType =
   | Selector of string * size_restriction
   | SelectorAll of string * size_restriction
 
+type additional_headers = (string * string) list option
+
 type test =
   { only : bool
   ; skip : bool
@@ -35,6 +37,7 @@ type test =
   ; sizes : size list
   ; actions : action list
   ; ignore : ignoreType list
+  ; additional_headers : additional_headers
   }
 
 type global =
@@ -50,4 +53,5 @@ type global =
   ; snapshot_directory : string
   ; diff_pixel_color : int32
   ; parallelism : int option
+  ; additional_headers : additional_headers
   }

lib/OSnap_Config/OSnap_Config_Utils.ml

@@ -265,6 +265,32 @@ module YAML = struct
     OSnap_Config_Types.{ name; width; height } |> Result.ok
   ;;
 
+  let parse_http_headers ~path key obj =
+    obj
+    |> Yaml.Util.find key
+    |> Result.map
+         (Option.map (fun headers ->
+            match headers with
+            | `Null -> Result.ok []
+            | headers ->
+              let keys = Yaml.Util.keys headers in
+              let values = Yaml.Util.values headers in
+              (match keys, values with
+               | _, Error _ | Error _, _ ->
+                 Result.error
+                   (`Msg
+                       "HTTP Headers are in an invalid format. Expected to see an object.")
+               | Ok keys, Ok values ->
+                 let* values =
+                   OSnap_Utils.List.map_until_exception Yaml.Util.to_string values
+                 in
+                 Result.ok (List.combine keys values))))
+    |> Result.map to_result_option
+    |> Result.join
+    |> Result.map_error (function `Msg message ->
+        `OSnap_Config_Parse_Error (message, path))
+  ;;
+
   let parse_size ~path ~default_sizes size =
     match size with
     | `String name ->

lib/OSnap_Test/OSnap_Test.ml

@@ -171,6 +171,7 @@ let run ~env (global_config : Config.Types.global) target test =
     let base_snapshot = Eio.Path.(dirs.base / filename) in
     let updated_snapshot = Eio.Path.(dirs.updated / filename) in
     let diff_image = Eio.Path.(dirs.diff / diff_filename) in
+    let*? () = target |> Browser.Actions.set_headers ~headers:test.additional_headers in
     let*? () = target |> Browser.Actions.clear_cookies in
     let*? () =
       target

lib/OSnap_Test/OSnap_Test_Types.ml

@@ -6,6 +6,7 @@ type t =
   ; height : int
   ; actions : OSnap_Config.Types.action list
   ; ignore_regions : OSnap_Config.Types.ignoreType list
+  ; additional_headers : OSnap_Config.Types.additional_headers
   ; threshold : int
   ; retry : int
   ; exists : bool