diff --git a/bin/Main.ml b/bin/Main.ml index 4f9db41..7680058 100644 --- a/bin/Main.ml +++ b/bin/Main.ml @@ -7,7 +7,7 @@ let print_error msg = Printf.ksprintf printer msg ;; -let handle_response response = +let handle_response_eio response = match response with | Ok () -> 0 | Error `OSnap_Test_Failure -> 1 @@ -29,6 +29,7 @@ let handle_response response = print_error "%s" s; 1 | Error (`OSnap_Config_Unsupported_Format path) -> + let path = Eio.Path.native_exn path in print_error "Your config file has an unknown format."; print_error "Tried to parse %s." path; print_error "Known formats are json and yaml"; @@ -37,16 +38,19 @@ let handle_response response = print_error "Could not connect to Chrome."; 1 | Error (`OSnap_Config_Parse_Error (msg, path)) -> + let path = Eio.Path.native_exn path in print_error "Your config is in an invalid format"; print_error "Tried to parse %s" path; print_error "%s" msg; 1 | Error (`OSnap_Config_Invalid (s, path)) -> + let path = Eio.Path.native_exn path in print_error "Found some tests with an invalid format."; print_error "Tried to parse %s" path; print_error "%s" s; 1 | Error (`OSnap_Config_Undefined_Function (s, path)) -> + let path = Eio.Path.native_exn path in print_error "Tried to call non existant function `%s` in file %s" s path; 1 | Error (`OSnap_Config_Duplicate_Size_Names sizes) -> @@ -111,21 +115,24 @@ let default_cmd = value & opt (some int) None & info [ "p"; "parallelism" ] ~doc in let exec noCreate noOnly noSkip parallelism config_path = - let open Lwt_result.Syntax in - let run = - let* t = OSnap.setup ~config_path ~noCreate ~noOnly ~noSkip ~parallelism in - Lwt.catch - (fun () -> - OSnap.run t - |> Lwt_result.map_error (fun e -> - let () = OSnap.teardown t in - e)) - (function - | exn -> - let () = OSnap.teardown t in - Lwt_result.fail (`OSnap_Unknown_Error exn)) + let ( let*? ) = Result.bind in + let run ~sw ~env = + let*? t = + OSnap.setup ~sw ~env ~config_path ~noCreate ~noOnly ~noSkip ~parallelism + in + try + OSnap.run ~env t + |> Result.map_error (fun e -> + let () = OSnap.teardown t in + e) + with + | exn -> + let () = OSnap.teardown t in + Result.error (`OSnap_Unknown_Error exn) in - Lwt_main.run run |> handle_response + handle_response_eio + @@ Eio_main.run + @@ fun env -> Eio.Switch.run @@ fun sw -> run ~sw ~env in ( (let open Term in const exec $ noCreate $ noOnly $ noSkip $ parallelism $ config) @@ -158,8 +165,7 @@ let default_cmd = let cleanup_cmd = let exec config_path = - let run = OSnap.cleanup ~config_path in - Lwt_main.run run |> handle_response + handle_response_eio @@ Eio_main.run @@ fun env -> OSnap.cleanup ~env ~config_path in ( (let open Term in const exec $ config) @@ -181,4 +187,8 @@ let cleanup_cmd = let cmds = [ Cmd.v (snd cleanup_cmd) (fst cleanup_cmd) ] let default, info = default_cmd -let () = cmds |> Cmd.group ~default info |> Cmd.eval' |> exit + +let () = + Printexc.record_backtrace true; + cmds |> Cmd.group ~default info |> Cmd.eval' |> exit +;; diff --git a/bin/dune b/bin/dune index 70ca6fb..85c3571 100644 --- a/bin/dune +++ b/bin/dune @@ -4,4 +4,4 @@ (public_name osnap) (package osnap) (ocamlopt_flags -O3) - (libraries OSnap unix cmdliner lwt lwt.unix fmt)) + (libraries OSnap cmdliner eio eio.core eio_main fmt)) diff --git a/dune-project b/dune-project index 435ccda..30e27f4 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,4 @@ -(lang dune 3.1) +(lang dune 3.15) (name osnap) @@ -22,20 +22,19 @@ (depends ocaml dune + eio_main base64 cdp cmdliner - cohttp - cohttp-lwt-unix + httpun-eio + httpun-ws-eio decompress fileutils fmt libspng - lwt odiff-core + piaf re uri - websocket - websocket-lwt-unix yaml yojson)) diff --git a/lib/OSnap.ml b/lib/OSnap.ml index 43fbdff..3159a34 100644 --- a/lib/OSnap.ml +++ b/lib/OSnap.ml @@ -10,10 +10,11 @@ type t = ; browser : Browser.t } -let setup ~noCreate ~noOnly ~noSkip ~parallelism ~config_path = +let setup ~sw ~env ~noCreate ~noOnly ~noSkip ~parallelism ~config_path = + let ( let*? ) = Result.bind in let open Config.Types in let start_time = Unix.gettimeofday () in - let*? config = Config.Global.init ~config_path |> Lwt_result.lift in + let*? config = Config.Global.init ~env ~config_path in let config = match parallelism with | Some parallelism -> { config with parallelism } @@ -21,41 +22,41 @@ let setup ~noCreate ~noOnly ~noSkip ~parallelism ~config_path = in let () = OSnap_Paths.init_folder_structure config in let snapshot_dir = OSnap_Paths.get_base_images_dir config in - let*? all_tests = Config.Test.init config |> Lwt_result.lift in + let*? all_tests = Config.Test.init config in let*? only_tests, tests = all_tests - |> Lwt_list.map_p_until_exception (fun test -> + |> ResultList.map_p_until_first_error (fun test -> test.sizes - |> Lwt_list.map_p_until_exception (fun size -> + |> ResultList.map_p_until_first_error (fun size -> let { name = _size_name; width; height } = size in let filename = Test.get_filename test.name width height in - let current_image_path = Filename.concat snapshot_dir filename in - let exists = Sys.file_exists current_image_path in + let current_image_path = Eio.Path.(snapshot_dir / filename) in + let exists = Eio.Path.is_file current_image_path in if noCreate && not exists then - Lwt_result.fail + Result.error (`OSnap_Invalid_Run (Printf.sprintf "Flag --no-create is set. Cannot create new images for %s." test.name)) else if noSkip && test.skip then - Lwt_result.fail + Result.error (`OSnap_Invalid_Run (Printf.sprintf "Flag --no-skip is set. Cannot skip test %s." test.name)) else if noOnly && test.only then - Lwt_result.fail + Result.error (`OSnap_Invalid_Run (Printf.sprintf "Flag --no-only is set but the following test still has only set to \ true %s." test.name)) else if test.only - then Lwt_result.return (Either.left (test, size, exists)) - else Lwt_result.return (Either.right (test, size, exists)))) - |> Lwt_result.map List.flatten - |> Lwt_result.map (List.partition_map Fun.id) + then Result.ok (Either.left (test, size, exists)) + else Result.ok (Either.right (test, size, exists)))) + |> Result.map List.flatten + |> Result.map (List.partition_map Fun.id) in let tests_to_run = match only_tests, tests with @@ -67,26 +68,27 @@ let setup ~noCreate ~noOnly ~noSkip ~parallelism ~config_path = |> List.fast_sort (fun (_test, _size, exists1) (_test, _size, exists2) -> Bool.compare exists1 exists2) in - let*? browser = Browser.Launcher.make () in - Lwt_result.return { config; tests_to_run; start_time; browser } + let*? browser = Browser.Launcher.make ~sw ~env () in + Result.ok { config; tests_to_run; start_time; browser } ;; let teardown t = Browser.Launcher.shutdown t.browser -let run t = +let run ~env t = + let ( let*? ) = Result.bind in let open Config.Types in let { tests_to_run; config; start_time; browser } = t in let parallelism = max 1 config.parallelism in let pool = - Lwt_pool.create + Eio.Pool.create + ~validate:(fun target -> Result.is_ok target) parallelism (fun () -> Browser.Target.make browser) - ~validate:(fun target -> Lwt.return (Result.is_ok target)) in let*? test_results = tests_to_run - |> Lwt_list.map_p_until_exception (fun test -> - Lwt_pool.use pool (fun target -> + |> ResultList.map_p_until_first_error (fun test -> + Eio.Pool.use pool (fun target -> let test, { name = size_name; width; height }, exists = test in let test = Test.Types. @@ -104,7 +106,7 @@ let run t = ; result = None } in - Test.run config (Result.get_ok target) test)) + Test.run ~env config (Result.get_ok target) test)) in let end_time = Unix.gettimeofday () in let seconds = end_time -. start_time in diff --git a/lib/OSnap.mli b/lib/OSnap.mli index a6b94d2..f0a1b04 100644 --- a/lib/OSnap.mli +++ b/lib/OSnap.mli @@ -9,48 +9,52 @@ type t = } val setup - : noCreate:bool + : sw:Eio.Switch.t + -> env:Eio_unix.Stdenv.base + -> noCreate:bool -> noOnly:bool -> noSkip:bool -> parallelism:int option -> config_path:string -> ( t - , [> `OSnap_Chromium_Download_Failed - | `OSnap_CDP_Connection_Failed + , [> `OSnap_CDP_Connection_Failed | `OSnap_CDP_Protocol_Error of string + | `OSnap_Chromium_Download_Failed | `OSnap_Config_Duplicate_Size_Names of string list | `OSnap_Config_Duplicate_Tests of string list | `OSnap_Config_Global_Invalid of string | `OSnap_Config_Global_Not_Found - | `OSnap_Config_Undefined_Function of string * string - | `OSnap_Config_Invalid of string * string - | `OSnap_Config_Parse_Error of string * string - | `OSnap_Config_Unsupported_Format of string + | `OSnap_Config_Invalid of string * Eio.Fs.dir_ty Eio.Path.t + | `OSnap_Config_Parse_Error of string * Eio.Fs.dir_ty Eio.Path.t + | `OSnap_Config_Undefined_Function of string * Eio.Fs.dir_ty Eio.Path.t + | `OSnap_Config_Unsupported_Format of Eio.Fs.dir_ty Eio.Path.t | `OSnap_Invalid_Run of string ] ) - Lwt_result.t + result val teardown : t -> unit val run - : t + : env:Eio_unix.Stdenv.base + -> t -> ( unit , [> `OSnap_CDP_Protocol_Error of string | `OSnap_FS_Error of string | `OSnap_Test_Failure ] ) - Lwt_result.t + result val cleanup - : config_path:string + : env:Eio_unix.Stdenv.base + -> config_path:string -> ( unit , [> `OSnap_Config_Duplicate_Size_Names of string list | `OSnap_Config_Duplicate_Tests of string list | `OSnap_Config_Global_Invalid of string | `OSnap_Config_Global_Not_Found - | `OSnap_Config_Invalid of string * string - | `OSnap_Config_Parse_Error of string * string - | `OSnap_Config_Undefined_Function of string * string - | `OSnap_Config_Unsupported_Format of string + | `OSnap_Config_Invalid of string * Eio.Fs.dir_ty Eio.Path.t + | `OSnap_Config_Parse_Error of string * Eio.Fs.dir_ty Eio.Path.t + | `OSnap_Config_Undefined_Function of string * Eio.Fs.dir_ty Eio.Path.t + | `OSnap_Config_Unsupported_Format of Eio.Fs.dir_ty Eio.Path.t ] ) - Lwt_result.t + result diff --git a/lib/OSnap_Browser/OSnap_Browser_Actions.ml b/lib/OSnap_Browser/OSnap_Browser_Actions.ml index 0a27bbb..917ad7c 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Actions.ml +++ b/lib/OSnap_Browser/OSnap_Browser_Actions.ml @@ -2,146 +2,150 @@ open Cdp open OSnap_Browser_Target open OSnap_Utils -let wait_for ?timeout ?look_behind ~event target = +let wait_for ~clock ?timeout ?look_behind ~event target = let sessionId = target.sessionId in - let p, resolver = Lwt.wait () in + let p, resolver = Eio.Promise.create () in let callback data remove = remove (); - Lwt.wakeup_later resolver (`Data data) + Eio.Promise.resolve resolver (`Data data) in OSnap_Websocket.listen ~event ?look_behind ~sessionId callback; match timeout with - | None -> p + | None -> Eio.Promise.await p | Some t -> - let timeout = Lwt_unix.sleep (t /. 1000.) |> Lwt.map (fun () -> `Timeout) in - Lwt.pick [ timeout; p ] + Eio.Fiber.first + (fun () -> Eio.Promise.await p) + (fun () -> + Eio.Time.sleep clock (t /. 1000.); + `Timeout) ;; let get_document target = let sessionId = target.sessionId in let open Commands.DOM.GetDocument in - Request.make ~sessionId ~params:(Params.make ()) - |> OSnap_Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - 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) + let response = + Request.make ~sessionId ~params:(Params.make ()) + |> OSnap_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 ;; let select_element_all ~document ~selector ~sessionId = let open Commands.DOM.QuerySelectorAll in - Request.make - ~sessionId - ~params: - (Params.make - ~nodeId:document.Commands.DOM.GetDocument.Response.root.nodeId - ~selector - ()) - |> OSnap_Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - match response.Response.error, response.Response.result with - | _, Some { nodeIds = [] } -> - Result.error - (`OSnap_CDP_Protocol_Error - (Printf.sprintf "No node with the selector %S could not be found." selector)) - | None, None -> Result.error (`OSnap_CDP_Protocol_Error "") - | Some { message; _ }, None -> Result.error (`OSnap_CDP_Protocol_Error message) - | Some _, Some result | None, Some result -> Result.ok result) + let response = + Request.make + ~sessionId + ~params: + (Params.make + ~nodeId:document.Commands.DOM.GetDocument.Response.root.nodeId + ~selector + ()) + |> OSnap_Websocket.send + |> Response.parse + in + match response.Response.error, response.Response.result with + | _, Some { nodeIds = [] } -> + Result.error + (`OSnap_CDP_Protocol_Error + (Printf.sprintf "No node with the selector %S could not be found." selector)) + | None, None -> Result.error (`OSnap_CDP_Protocol_Error "") + | Some { message; _ }, None -> Result.error (`OSnap_CDP_Protocol_Error message) + | Some _, Some result | None, Some result -> Result.ok result ;; let select_element ~document ~selector ~sessionId = let open Commands.DOM.QuerySelector in - Request.make - ~sessionId - ~params: - (Params.make - ~nodeId:document.Commands.DOM.GetDocument.Response.root.nodeId - ~selector - ()) - |> OSnap_Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - match response.Response.error, response.Response.result with - | _, (Some { nodeId = `Int 0 } | Some { nodeId = `Float 0. }) -> - Result.error (`OSnap_Selector_Not_Found selector) - | None, None -> Result.error (`OSnap_CDP_Protocol_Error "") - | Some { message; _ }, None -> Result.error (`OSnap_CDP_Protocol_Error message) - | Some _, Some result | None, Some result -> Result.ok result) + let response = + Request.make + ~sessionId + ~params: + (Params.make + ~nodeId:document.Commands.DOM.GetDocument.Response.root.nodeId + ~selector + ()) + |> OSnap_Websocket.send + |> Response.parse + in + match response.Response.error, response.Response.result with + | _, (Some { nodeId = `Int 0 } | Some { nodeId = `Float 0. }) -> + Result.error (`OSnap_Selector_Not_Found selector) + | None, None -> Result.error (`OSnap_CDP_Protocol_Error "") + | Some { message; _ }, None -> Result.error (`OSnap_CDP_Protocol_Error message) + | Some _, Some result | None, Some result -> Result.ok result ;; let wait_for_network_idle target ~loaderId = let open Events.Page in let sessionId = target.sessionId in - let p, resolver = Lwt.wait () in + let p, resolver = Eio.Promise.create () in OSnap_Websocket.listen ~event:LifecycleEvent.name ~sessionId (fun response remove -> let eventData = LifecycleEvent.parse response in if eventData.params.name = "networkIdle" && loaderId = eventData.params.loaderId then ( remove (); - Lwt.wakeup_later resolver ())); - p + Eio.Promise.resolve resolver ())); + Eio.Promise.await p ;; let go_to ~url target = + let ( let*? ) = Result.bind in let open Commands.Page in let sessionId = target.sessionId in let params = Navigate.Params.make ~url () in let*? result = let open Navigate in - Request.make ~sessionId ~params - |> OSnap_Websocket.send - |> Lwt.map Navigate.Response.parse - |> Lwt.map (fun response -> - 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) + let response = + Request.make ~sessionId ~params |> OSnap_Websocket.send |> Navigate.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 match result.errorText, result.loaderId with - | Some error, _ -> `OSnap_CDP_Protocol_Error error |> Lwt_result.fail + | Some error, _ -> `OSnap_CDP_Protocol_Error error |> Result.error | None, None -> - Lwt_result.fail (`OSnap_CDP_Protocol_Error "CDP responded with no loader id") - | None, Some loaderId -> loaderId |> Lwt_result.return + Result.error (`OSnap_CDP_Protocol_Error "CDP responded with no loader id") + | None, Some loaderId -> loaderId |> Result.ok ;; -let type_text ~document ~selector ~text target = +let type_text ~clock ~document ~selector ~text target = + let ( let*? ) = Result.bind in let open Commands.DOM in let sessionId = target.sessionId in let*? node = select_element ~document ~selector ~sessionId in let*? () = let open Focus in - Request.make ~sessionId ~params:(Params.make ~nodeId:node.nodeId ()) - |> OSnap_Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - 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) - |> Lwt_result.map ignore + let response = + Request.make ~sessionId ~params:(Params.make ~nodeId:node.nodeId ()) + |> OSnap_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 |> Result.map ignore in let*? () = List.init (String.length text) (String.get text) - |> Lwt_list.iter_s (fun char -> - let definition = - (OSnap_Browser_KeyDefinition.make char : OSnap_Browser_KeyDefinition.t option) - in - match definition with + |> List.iter (fun c -> + match OSnap_Browser_KeyDefinition.make c with | Some def -> let open Commands.Input.DispatchKeyEvent in - let* () = + let () = Request.make ~sessionId ~params: @@ -159,7 +163,7 @@ let type_text ~document ~selector ~text target = ~isKeypad:(def.location = 3) ()) |> OSnap_Websocket.send - |> Lwt.map ignore + |> ignore in Request.make ~sessionId @@ -171,23 +175,24 @@ let type_text ~document ~selector ~text target = ~location:(`Int def.location) ()) |> OSnap_Websocket.send - |> Lwt.map ignore - | None -> Lwt.return ()) - |> Lwt_result.ok + |> ignore + | None -> ()) + |> Result.ok in let*? wait_result = - wait_for ~event:"Page.frameNavigated" ~look_behind:false ~timeout:1000. target - |> Lwt_result.ok + wait_for ~clock ~event:"Page.frameNavigated" ~look_behind:false ~timeout:1000. target + |> Result.ok in match wait_result with - | `Timeout -> Lwt_result.return () + | `Timeout -> Result.ok () | `Data data -> let event_data = Cdp.Events.Page.FrameNavigated.parse data in let loaderId = event_data.params.frame.loaderId in - wait_for_network_idle target ~loaderId |> Lwt_result.ok + wait_for_network_idle target ~loaderId |> Result.ok ;; let get_quads_all ~document ~selector target = + let ( let*? ) = Result.bind in let open Commands.DOM in let sessionId = target.sessionId in let to_float = function @@ -195,41 +200,46 @@ let get_quads_all ~document ~selector target = | `Int i -> float_of_int i in let*? { nodeIds } = select_element_all ~document ~selector ~sessionId in - nodeIds - |> Lwt_list.fold_left_s - (fun acc nodeId -> - let open GetContentQuads in - Request.make ~sessionId ~params:(Params.make ~nodeId ()) - |> OSnap_Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> + let quads = + nodeIds + |> List.fold_left + (fun acc nodeId -> + let open GetContentQuads in + let response = + Request.make ~sessionId ~params:(Params.make ~nodeId ()) + |> OSnap_Websocket.send + |> Response.parse + in match response.Response.error, response.Response.result with | ( (None | Some _) , Some { quads = (x1 :: y1 :: x2 :: _y2 :: _x3 :: y2 :: _x4 :: _y4 :: _) :: _ } ) -> ((to_float x1, to_float y1), (to_float x2, to_float y2)) :: acc - | _ -> acc)) - [] - |> Lwt_result.ok + | _ -> acc) + [] + in + Result.ok quads ;; let get_quads ~document ~selector target = + let ( let*? ) = Result.bind in let open Commands.DOM in let sessionId = target.sessionId in let*? { nodeId } = select_element ~document ~selector ~sessionId in let*? result = let open GetContentQuads in - Request.make ~sessionId ~params:(Params.make ~nodeId ()) - |> OSnap_Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - 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) + let response = + Request.make ~sessionId ~params:(Params.make ~nodeId ()) + |> OSnap_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 to_float = function | `Float f -> f @@ -237,11 +247,12 @@ let get_quads ~document ~selector target = in match result.quads with | (x1 :: y1 :: x2 :: _y2 :: _x3 :: y2 :: _x4 :: _y4 :: _) :: _ -> - Lwt_result.return ((to_float x1, to_float y1), (to_float x2, to_float y2)) - | _ -> Lwt_result.fail (`OSnap_Selector_Not_Visible selector) + Result.ok ((to_float x1, to_float y1), (to_float x2, to_float y2)) + | _ -> Result.error (`OSnap_Selector_Not_Visible selector) ;; let mousemove ~document ~to_ target = + let ( let*? ) = Result.bind in let open Commands.Input in let sessionId = target.sessionId in let*? x, y = @@ -250,17 +261,18 @@ let mousemove ~document ~to_ target = let*? (x1, y1), (x2, y2) = get_quads ~document ~selector target in let x = `Float (x1 +. ((x2 -. x1) /. 2.0)) in let y = `Float (y1 +. ((y2 -. y1) /. 2.0)) in - Lwt_result.return (x, y) - | `Coordinates (x, y) -> Lwt_result.return (x, y) + Result.ok (x, y) + | `Coordinates (x, y) -> Result.ok (x, y) in let open DispatchMouseEvent in Request.make ~sessionId ~params:(Params.make ~x ~y ~type_:`mouseMoved ()) |> OSnap_Websocket.send - |> Lwt.map ignore - |> Lwt_result.ok + |> ignore + |> Result.ok ;; -let click ~document ~selector target = +let click ~clock ~document ~selector target = + let ( let*? ) = Result.bind in let open Commands.Input in let sessionId = target.sessionId in let*? (x1, y1), (x2, y2) = get_quads ~document ~selector target in @@ -281,8 +293,8 @@ let click ~document ~selector target = ~y ()) |> OSnap_Websocket.send - |> Lwt.map ignore - |> Lwt_result.ok + |> ignore + |> Result.ok in let*? () = let open DispatchMouseEvent in @@ -298,22 +310,23 @@ let click ~document ~selector target = ~y ()) |> OSnap_Websocket.send - |> Lwt.map ignore - |> Lwt_result.ok + |> ignore + |> Result.ok in let*? wait_result = - wait_for ~event:"Page.frameNavigated" ~look_behind:false ~timeout:1000. target - |> Lwt_result.ok + wait_for ~clock ~event:"Page.frameNavigated" ~look_behind:false ~timeout:1000. target + |> Result.ok in match wait_result with - | `Timeout -> Lwt_result.return () + | `Timeout -> Result.ok () | `Data data -> let event_data = Cdp.Events.Page.FrameNavigated.parse data in let loaderId = event_data.params.frame.loaderId in - wait_for_network_idle target ~loaderId |> Lwt_result.ok + wait_for_network_idle target ~loaderId |> Result.ok ;; -let scroll ~document ~selector ~px target = +let scroll ~clock ~document ~selector ~px target = + let ( let*? ) = Result.bind in let sessionId = target.sessionId in match px, selector with | None, None -> assert false @@ -321,13 +334,14 @@ let scroll ~document ~selector ~px target = | None, Some selector -> let*? { nodeId } = select_element ~document ~selector ~sessionId in let open Commands.DOM.ScrollIntoViewIfNeeded in - Request.make ~sessionId ~params:(Params.make ~nodeId ()) - |> OSnap_Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - match response.Response.error with - | None -> Result.ok () - | Some { message; _ } -> Result.error (`OSnap_CDP_Protocol_Error message)) + let response = + Request.make ~sessionId ~params:(Params.make ~nodeId ()) + |> OSnap_Websocket.send + |> Response.parse + in + (match response.Response.error with + | None -> Result.ok () + | Some { message; _ } -> Result.error (`OSnap_CDP_Protocol_Error message)) | Some px, None -> let expression = Printf.sprintf @@ -341,61 +355,63 @@ let scroll ~document ~selector ~px target = px in let open Commands.Runtime.Evaluate in - let* response = + let response = Request.make ~sessionId ~params:(Params.make ~expression ()) |> OSnap_Websocket.send - |> Lwt.map Response.parse + |> Response.parse in (match response.Response.error with | None -> - let timeout = float_of_int (px / 200) in - Lwt_unix.sleep timeout |> Lwt_result.ok - | Some { message; _ } -> Lwt_result.fail (`OSnap_CDP_Protocol_Error message)) + let timeout = float_of_int (px / 200 / 1000) in + Eio.Time.sleep clock timeout; + Result.ok () + | Some { message; _ } -> Result.error (`OSnap_CDP_Protocol_Error message)) ;; let get_content_size target = + let ( let*? ) = Result.bind in let open Commands.Page in let sessionId = target.sessionId in let*? metrics = let open GetLayoutMetrics in - Request.make ~sessionId - |> OSnap_Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - 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) + let response = Request.make ~sessionId |> OSnap_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 - Lwt_result.return (metrics.cssContentSize.width, metrics.cssContentSize.height) + Result.ok (metrics.cssContentSize.width, metrics.cssContentSize.height) ;; let set_size ~width ~height target = + let ( let*? ) = Result.bind in let open Commands.Emulation in let sessionId = target.sessionId in let*? _ = let open SetDeviceMetricsOverride in - Request.make - ~sessionId - ~params:(Params.make ~width ~height ~deviceScaleFactor:(`Int 1) ~mobile:false ()) - |> OSnap_Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - 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) + let response = + Request.make + ~sessionId + ~params:(Params.make ~width ~height ~deviceScaleFactor:(`Int 1) ~mobile:false ()) + |> OSnap_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 - Lwt_result.return () + Result.ok () ;; let screenshot ?(full_size = false) target = + let ( let*? ) = Result.bind in let open Commands.Page in let sessionId = target.sessionId in let*? () = @@ -403,43 +419,47 @@ let screenshot ?(full_size = false) target = then let*? width, height = get_content_size target in set_size ~width ~height target - else Lwt_result.return () + else Result.ok () in let*? result = let open CaptureScreenshot in - Request.make - ~sessionId - ~params:(Params.make ~format:`png ~captureBeyondViewport:false ~fromSurface:true ()) - |> OSnap_Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - 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) + let response = + Request.make + ~sessionId + ~params: + (Params.make ~format:`png ~captureBeyondViewport:false ~fromSurface:true ()) + |> OSnap_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 - Lwt_result.return result.data + Result.ok result.data ;; let clear_cookies target = + let ( let*? ) = Result.bind in let open Commands.Storage in let sessionId = target.sessionId in let*? _ = let open ClearCookies in - Request.make ~sessionId ~params:(Params.make ()) - |> OSnap_Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - 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) + let response = + Request.make ~sessionId ~params:(Params.make ()) + |> OSnap_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 - Lwt_result.return () + Result.ok () ;; diff --git a/lib/OSnap_Browser/OSnap_Browser_Actions.mli b/lib/OSnap_Browser/OSnap_Browser_Actions.mli index 6b26c35..ae57996 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Actions.mli +++ b/lib/OSnap_Browser/OSnap_Browser_Actions.mli @@ -2,18 +2,18 @@ val get_document : OSnap_Browser_Target.target -> ( Cdp.Commands.DOM.GetDocument.Response.result , [> `OSnap_CDP_Protocol_Error of string ] ) - result - Lwt.t + Result.t -val wait_for_network_idle : OSnap_Browser_Target.target -> loaderId:string -> unit Lwt.t +val wait_for_network_idle : OSnap_Browser_Target.target -> loaderId:string -> unit val go_to : url:string -> OSnap_Browser_Target.target - -> (string, [> `OSnap_CDP_Protocol_Error of string ]) Lwt_result.t + -> (string, [> `OSnap_CDP_Protocol_Error of string ]) Result.t val type_text - : document:Cdp.Commands.DOM.GetDocument.Response.result + : clock:[> float Eio.Time.clock_ty ] Eio.Resource.t + -> document:Cdp.Commands.DOM.GetDocument.Response.result -> selector:string -> text:string -> OSnap_Browser_Target.target @@ -22,7 +22,7 @@ val type_text | `OSnap_Selector_Not_Found of string | `OSnap_Selector_Not_Visible of string ] ) - Lwt_result.t + Result.t val get_quads_all : document:Cdp.Commands.DOM.GetDocument.Response.result @@ -33,7 +33,7 @@ val get_quads_all | `OSnap_Selector_Not_Found of string | `OSnap_Selector_Not_Visible of string ] ) - Lwt_result.t + Result.t val get_quads : document:Cdp.Commands.DOM.GetDocument.Response.result @@ -44,7 +44,7 @@ val get_quads | `OSnap_Selector_Not_Found of string | `OSnap_Selector_Not_Visible of string ] ) - Lwt_result.t + Result.t val mousemove : document:Cdp.Commands.DOM.GetDocument.Response.result @@ -55,10 +55,11 @@ val mousemove | `OSnap_Selector_Not_Found of string | `OSnap_Selector_Not_Visible of string ] ) - Lwt_result.t + Result.t val click - : document:Cdp.Commands.DOM.GetDocument.Response.result + : clock:[> float Eio.Time.clock_ty ] Eio.Resource.t + -> document:Cdp.Commands.DOM.GetDocument.Response.result -> selector:string -> OSnap_Browser_Target.target -> ( unit @@ -66,10 +67,11 @@ val click | `OSnap_Selector_Not_Found of string | `OSnap_Selector_Not_Visible of string ] ) - Lwt_result.t + Result.t val scroll - : document:Cdp.Commands.DOM.GetDocument.Response.result + : clock:[> float Eio.Time.clock_ty ] Eio.Resource.t + -> document:Cdp.Commands.DOM.GetDocument.Response.result -> selector:string option -> px:int option -> OSnap_Browser_Target.target @@ -78,19 +80,19 @@ val scroll | `OSnap_Selector_Not_Found of string | `OSnap_Selector_Not_Visible of string ] ) - Lwt_result.t + Result.t val set_size : width:Cdp.Types.number -> height:Cdp.Types.number -> OSnap_Browser_Target.target - -> (unit, [> `OSnap_CDP_Protocol_Error of string ]) Lwt_result.t + -> (unit, [> `OSnap_CDP_Protocol_Error of string ]) Result.t val screenshot : ?full_size:bool -> OSnap_Browser_Target.target - -> (string, [> `OSnap_CDP_Protocol_Error of string ]) Lwt_result.t + -> (string, [> `OSnap_CDP_Protocol_Error of string ]) Result.t val clear_cookies : OSnap_Browser_Target.target - -> (unit, [> `OSnap_CDP_Protocol_Error of string ]) Lwt_result.t + -> (unit, [> `OSnap_CDP_Protocol_Error of string ]) Result.t diff --git a/lib/OSnap_Browser/OSnap_Browser_Download.ml b/lib/OSnap_Browser/OSnap_Browser_Download.ml index 24a498f..af042af 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Download.ml +++ b/lib/OSnap_Browser/OSnap_Browser_Download.ml @@ -1,4 +1,3 @@ -open Cohttp_lwt_unix open OSnap_Utils let get_uri revision (platform : OSnap_Utils.platform) = @@ -20,53 +19,82 @@ let get_uri revision (platform : OSnap_Utils.platform) = () ;; -let download ~revision dir = - let zip_path = Filename.concat dir "chromium.zip" in +let download ~env ~revision dir = + let ( let*? ) = Result.bind in + let zip_path = Eio.Path.(dir / "chromium.zip") in let revision_string = OSnap_Browser_Path.revision_to_string revision in - let* io = Lwt_io.open_file ~mode:Output zip_path in + let uri = get_uri revision_string (OSnap_Utils.detect_platform ()) in print_endline (Printf.sprintf "Downloading chromium revision %s.\n\ This is a one time setup and will only happen, if there are updates from OSnap..." revision_string); - let uri = get_uri revision_string (OSnap_Utils.detect_platform ()) in - let* response, body = Client.get uri in + Eio.Switch.run + @@ fun sw -> + let*? client = + Piaf.Client.create + ~sw + ~config: + { Piaf.Config.default with + follow_redirects = true + ; allow_insecure = true + ; flush_headers_immediately = true + } + env + uri + |> Result.map_error (fun _ -> `OSnap_Chromium_Download_Failed) + in + Eio.Path.with_open_out ~create:(`Or_truncate 0o755) zip_path + @@ fun io -> + let*? response = + Piaf.Client.get client (Uri.path_and_query uri) + |> Result.map_error (fun _ -> `OSnap_Chromium_Download_Failed) + in match response with | { status = `OK; _ } -> - let* () = Cohttp_lwt.Body.to_stream body |> Lwt_stream.iter_s (Lwt_io.write io) in - let* () = Lwt_io.close io in - zip_path |> Lwt_result.return + let*? () = + Piaf.Body.iter_string ~f:(fun chunk -> Eio.Flow.copy_string chunk io) response.body + |> Result.map_error (fun _ -> `OSnap_Chromium_Download_Failed) + in + Piaf.Client.shutdown client; + Result.ok zip_path | response -> - let* () = Lwt_io.close io in Format.fprintf Format.err_formatter "Chrome could not be downloaded:\n%a\n%!" - Response.pp_hum + Piaf.Response.pp_hum response; - Lwt_result.fail `OSnap_Chromium_Download_Failed + Result.error `OSnap_Chromium_Download_Failed ;; -let extract_zip ?(dest = "") source = +let extract_zip ~dest source = let extract_entry in_file (entry : Zip.entry) = - let out_file = Filename.concat dest entry.name in - if entry.is_directory && not (Sys.file_exists out_file) - then FileUtil.mkdir ~parent:true ~mode:(`Octal 511) out_file + let out_file = Eio.Path.(dest / entry.name) in + if entry.is_directory && not (Eio.Path.is_directory out_file) + then Eio.Path.mkdirs ~perm:0o755 out_file else ( - let parent_dir = FilePath.dirname out_file in - if not (Sys.file_exists parent_dir) - then FileUtil.mkdir ~parent:true ~mode:(`Octal 511) parent_dir; - let oc = open_out_gen [ Open_creat; Open_binary; Open_append ] 511 out_file in + let parent_dir = + Eio.Path.split out_file |> Option.map fst |> Option.value ~default:dest + in + if not (Eio.Path.is_directory parent_dir) + then Eio.Path.mkdirs ~perm:0o755 parent_dir; + let oc = + open_out_gen + [ Open_creat; Open_binary; Open_append ] + 511 + (Eio.Path.native_exn out_file) + in try Zip.copy_entry_to_channel in_file entry oc; close_out oc with | err -> close_out oc; - Sys.remove out_file; + Eio.Path.rmtree ~missing_ok:true out_file; raise err) in print_endline "Extracting Chromium..."; - let ic = Zip.open_in source in + let ic = Zip.open_in (Eio.Path.native_exn source) in ic |> Zip.entries |> List.iter (extract_entry ic); Zip.close_in ic; print_endline "Done!" @@ -93,19 +121,24 @@ let cleanup_old_revisions () = FileUtil.rm ~recurse:true ~force:Force [ path ]) ;; -let download revision = +let download ~env revision = + let ( let*? ) = Result.bind in print_newline (); print_newline (); + let fs = Eio.Stdenv.fs env in let*? () = - if not (is_revision_downloaded revision) - then ( - let extract_path = OSnap_Browser_Path.get_chromium_path revision in - Unix.mkdir extract_path 511; - Lwt_io.with_temp_dir ~prefix:"osnap_chromium_" (fun dir -> - let*? path = dir |> download ~revision in - extract_zip path ~dest:extract_path; - Lwt_result.return ())) - else Lwt_result.return () + if is_revision_downloaded revision + then Result.ok () + else ( + let extract_path = Eio.Path.(fs / OSnap_Browser_Path.get_chromium_path revision) in + Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 extract_path; + let _temp_dir = Filename.get_temp_dir_name () in + Eio.Path.with_open_dir + Eio.Path.(fs / "/tmp") + (fun dir -> + let*? path = dir |> download ~env ~revision in + extract_zip path ~dest:extract_path; + Result.ok ())) in - cleanup_old_revisions () |> Lwt_result.return + Result.ok (cleanup_old_revisions ()) ;; diff --git a/lib/OSnap_Browser/OSnap_Browser_Download.mli b/lib/OSnap_Browser/OSnap_Browser_Download.mli index 1d62124..f50c86e 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Download.mli +++ b/lib/OSnap_Browser/OSnap_Browser_Download.mli @@ -1,5 +1,6 @@ val download - : OSnap_Browser_Path.revision - -> (unit, [> `OSnap_Chromium_Download_Failed ]) Lwt_result.t + : env:Eio_unix.Stdenv.base + -> OSnap_Browser_Path.revision + -> (unit, [> `OSnap_Chromium_Download_Failed ]) Result.t val is_revision_downloaded : OSnap_Browser_Path.revision -> bool diff --git a/lib/OSnap_Browser/OSnap_Browser_Launcher.ml b/lib/OSnap_Browser/OSnap_Browser_Launcher.ml index 65d7160..a5c6080 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Launcher.ml +++ b/lib/OSnap_Browser/OSnap_Browser_Launcher.ml @@ -1,16 +1,16 @@ module Websocket = OSnap_Websocket open OSnap_Browser_Types -open OSnap_Utils -let make () = +let make ~sw ~env () = + let ( let*? ) = Result.bind in let latest_chromium_revision = OSnap_Browser_Path.get_latest_revision () in let*? () = if not (OSnap_Browser_Download.is_revision_downloaded latest_chromium_revision) - then OSnap_Browser_Download.download latest_chromium_revision - else Lwt_result.return () + then OSnap_Browser_Download.download ~env latest_chromium_revision + else Result.ok () in let base_path = OSnap_Browser_Path.get_chromium_path latest_chromium_revision in - let executable_path = + let executable = match OSnap_Utils.detect_platform () with | MacOS | MacOS_ARM -> Filename.concat base_path "chrome-mac/Chromium.app/Contents/MacOS/Chromium" @@ -18,79 +18,80 @@ let make () = | Win64 -> Filename.concat base_path "chrome-win/chrome.exe" | Win32 -> "" in + let process_manager = Eio.Stdenv.process_mgr env in + let read_stderr, write_stderr = Eio.Process.pipe process_manager ~sw in let process = - Lwt_process.open_process_full - ( "" - , [| executable_path - ; "about:blank" - ; "--headless" - ; "--no-sandbox" - ; "--hide-scrollbars" - ; "--remote-debugging-port=0" - ; "--mute-audio" - ; "--disable-gpu" - ; "--disable-background-networking" - ; "--enable-features=NetworkService,NetworkServiceInProcess" - ; "--disable-background-timer-throttling" - ; "--disable-backgrounding-occluded-windows" - ; "--disable-breakpad" - ; "--disable-client-side-phishing-detection" - ; "--disable-component-extensions-with-background-pages" - ; "--disable-default-apps" - ; "--disable-dev-shm-usage" - ; "--disable-extensions" - ; "--disable-features=Translate" - ; "--disable-hang-monitor" - ; "--disable-ipc-flooding-protection" - ; "--disable-popup-blocking" - ; "--disable-prompt-on-repost" - ; "--disable-renderer-backgrounding" - ; "--disable-sync" - ; "--force-color-profile=srgb" - ; "--metrics-recording-only" - ; "--no-first-run" - ; "--enable-automation" - ; "--password-store=basic" - ; "--use-mock-keychain" - ; "--enable-blink-features=IdleDetection" - |] ) + Eio.Process.spawn + ~stderr:write_stderr + ~sw + ~executable + process_manager + [ executable + ; "about:blank" + ; "--headless" + ; "--no-sandbox" + ; "--hide-scrollbars" + ; "--remote-debugging-port=0" + ; "--mute-audio" + ; "--disable-gpu" + ; "--disable-background-networking" + ; "--enable-features=NetworkService,NetworkServiceInProcess" + ; "--disable-background-timer-throttling" + ; "--disable-backgrounding-occluded-windows" + ; "--disable-breakpad" + ; "--disable-client-side-phishing-detection" + ; "--disable-component-extensions-with-background-pages" + ; "--disable-default-apps" + ; "--disable-dev-shm-usage" + ; "--disable-extensions" + ; "--disable-features=Translate" + ; "--disable-hang-monitor" + ; "--disable-ipc-flooding-protection" + ; "--disable-popup-blocking" + ; "--disable-prompt-on-repost" + ; "--disable-renderer-backgrounding" + ; "--disable-sync" + ; "--force-color-profile=srgb" + ; "--metrics-recording-only" + ; "--no-first-run" + ; "--enable-automation" + ; "--password-store=basic" + ; "--use-mock-keychain" + ; "--enable-blink-features=IdleDetection" + ] in - let rec get_ws_url proc = - match proc#state with - | Lwt_process.Running -> - Lwt.bind (Lwt_io.read_line proc#stderr) (fun line -> - match line with - | line - when line |> OSnap_Utils.contains_substring ~search:"Cannot start http server" - -> - proc#terminate; - Lwt_result.fail `OSnap_CDP_Connection_Failed - | line when line |> OSnap_Utils.contains_substring ~search:"DevTools listening on" - -> - let offset = String.length "DevTools listening on " in - let len = String.length line in - let socket = String.sub line offset (len - offset) in - socket |> Lwt_result.return - | _ -> get_ws_url proc) - | Lwt_process.Exited _ -> Lwt_result.fail `OSnap_CDP_Connection_Failed + let rec get_ws_url ~from proc = + let line = from |> Eio.Buf_read.line in + match line with + | line when line |> OSnap_Utils.contains_substring ~search:"Cannot start http server" + -> + Eio.Process.signal proc Sys.sigkill; + Result.error `OSnap_CDP_Connection_Failed + | line when line |> OSnap_Utils.contains_substring ~search:"DevTools listening on" -> + let offset = String.length "DevTools listening on " in + let len = String.length line in + let socket = String.sub line offset (len - offset) in + Result.ok socket + | _ -> get_ws_url ~from proc in - let*? url = get_ws_url process in - let _ = Websocket.connect url in + let stderr_buffer = Eio.Buf_read.of_flow read_stderr ~max_size:max_int in + let*? url = get_ws_url ~from:stderr_buffer process in + let*? () = Websocket.connect ~sw ~env url in let*? result = let open Cdp.Commands.Target.CreateBrowserContext in Request.make ?sessionId:None ~params:(Params.make ()) |> Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - let error = - response.Response.error - |> Option.map (fun (error : Response.error) -> - `OSnap_CDP_Protocol_Error error.message) - |> Option.value ~default:`OSnap_CDP_Connection_Failed - in - Option.to_result response.Response.result ~none:error) + |> Response.parse + |> fun response -> + let error = + response.Response.error + |> Option.map (fun (error : Response.error) -> + `OSnap_CDP_Protocol_Error error.message) + |> Option.value ~default:`OSnap_CDP_Connection_Failed + in + Option.to_result response.Response.result ~none:error in - Lwt_result.return { ws = url; process; browserContextId = result.browserContextId } + Result.ok { ws = url; process; browserContextId = result.browserContextId } ;; -let shutdown browser = browser.process#terminate +let shutdown browser = Eio.Process.signal browser.process Sys.sigkill diff --git a/lib/OSnap_Browser/OSnap_Browser_Launcher.mli b/lib/OSnap_Browser/OSnap_Browser_Launcher.mli index facd97e..cfd1f53 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Launcher.mli +++ b/lib/OSnap_Browser/OSnap_Browser_Launcher.mli @@ -1,10 +1,12 @@ val make - : unit + : sw:Eio.Switch.t + -> env:Eio_unix.Stdenv.base + -> unit -> ( OSnap_Browser_Types.t - , [> `OSnap_Chromium_Download_Failed - | `OSnap_CDP_Connection_Failed + , [> `OSnap_CDP_Connection_Failed | `OSnap_CDP_Protocol_Error of string + | `OSnap_Chromium_Download_Failed ] ) - Lwt_result.t + result val shutdown : OSnap_Browser_Types.t -> unit diff --git a/lib/OSnap_Browser/OSnap_Browser_Target.ml b/lib/OSnap_Browser/OSnap_Browser_Target.ml index f6933dc..1c23c23 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Target.ml +++ b/lib/OSnap_Browser/OSnap_Browser_Target.ml @@ -1,5 +1,4 @@ open OSnap_Browser_Types -open OSnap_Utils module Websocket = OSnap_Websocket type target = @@ -8,90 +7,91 @@ type target = } let enable_events t = + let ( let*? ) = Result.bind in let open Cdp.Commands in let sessionId = t.sessionId in - let* _ = + let*? _ = let open Page.Enable in - Request.make ~sessionId - |> Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - 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) + let response = Request.make ~sessionId |> 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*? _ = let open DOM.Enable in - Request.make ~sessionId ~params:(Params.make ()) - |> Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - 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) + let response = + Request.make ~sessionId ~params:(Params.make ()) |> 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*? _ = let open Page.SetLifecycleEventsEnabled in - Request.make ~sessionId ~params:(Params.make ~enabled:true ()) - |> Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - 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) + let response = + Request.make ~sessionId ~params:(Params.make ~enabled:true ()) + |> 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 - Lwt_result.return () + Result.ok () ;; let make browser = + let ( let*? ) = Result.bind in let*? { targetId } = let open Cdp.Commands.Target.CreateTarget in - Request.make - ?sessionId:None - ~params: - (Params.make - ~url:"about:blank" - ~browserContextId:browser.browserContextId - ~newWindow:true - ()) - |> Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - 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) + let response = + Request.make + ?sessionId:None + ~params: + (Params.make + ~url:"about:blank" + ~browserContextId:browser.browserContextId + ~newWindow:true + ()) + |> 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*? { sessionId } = let open Cdp.Commands.Target.AttachToTarget in - Request.make ?sessionId:None ~params:(Params.make ~targetId ~flatten:true ()) - |> Websocket.send - |> Lwt.map Response.parse - |> Lwt.map (fun response -> - 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) + let response = + Request.make ?sessionId:None ~params:(Params.make ~targetId ~flatten:true ()) + |> 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 t = { targetId; sessionId } in let*? () = enable_events t in - Lwt_result.return t + Result.ok t ;; diff --git a/lib/OSnap_Browser/OSnap_Browser_Target.mli b/lib/OSnap_Browser/OSnap_Browser_Target.mli index 53c6070..139d6be 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Target.mli +++ b/lib/OSnap_Browser/OSnap_Browser_Target.mli @@ -5,4 +5,4 @@ type target = val make : OSnap_Browser_Types.t - -> (target, [> `OSnap_CDP_Protocol_Error of string ]) Lwt_result.t + -> (target, [> `OSnap_CDP_Protocol_Error of string ]) Result.t diff --git a/lib/OSnap_Browser/OSnap_Browser_Types.ml b/lib/OSnap_Browser/OSnap_Browser_Types.ml index 5ca0fa5..b3edd1d 100644 --- a/lib/OSnap_Browser/OSnap_Browser_Types.ml +++ b/lib/OSnap_Browser/OSnap_Browser_Types.ml @@ -1,5 +1,5 @@ type t = { ws : string ; browserContextId : Cdp.Types.Browser.BrowserContextID.t - ; process : Lwt_process.process_full + ; process : [ `Generic | `Unix ] Eio.Process.ty Eio.Resource.t } diff --git a/lib/OSnap_Browser/dune b/lib/OSnap_Browser/dune index 7e2dcb6..c3672a2 100644 --- a/lib/OSnap_Browser/dune +++ b/lib/OSnap_Browser/dune @@ -4,13 +4,13 @@ OSnap_Utils OSnap_Websocket unix + fmt + piaf bigstringaf cdp - cohttp - cohttp-lwt - cohttp-lwt-unix decompress.de fileutils - lwt - lwt.unix + eio + eio.core + eio.unix uri)) diff --git a/lib/OSnap_Cleanup.ml b/lib/OSnap_Cleanup.ml index 1821f4f..ecf055a 100644 --- a/lib/OSnap_Cleanup.ml +++ b/lib/OSnap_Cleanup.ml @@ -1,12 +1,13 @@ module Config = OSnap_Config open OSnap_Utils -let cleanup ~config_path = +let cleanup ~env ~config_path = + let ( let*? ) = Result.bind in print_newline (); - let*? config = Config.Global.init ~config_path |> Lwt.return in + let*? config = Config.Global.init ~env ~config_path in let () = OSnap_Paths.init_folder_structure config in let snapshot_dir = OSnap_Paths.get_base_images_dir config in - let*? tests = Config.Test.init config |> Lwt.return in + let*? tests = Config.Test.init config in let test_file_paths = tests |> List.map (fun (test : Config.Types.test) -> @@ -14,17 +15,16 @@ let cleanup ~config_path = |> List.filter_map (fun (size : Config.Types.size) -> let Config.Types.{ width; height; _ } = size in let filename = OSnap_Test.get_filename test.name width height in - let current_image_path = Filename.concat snapshot_dir filename in - let exists = Sys.file_exists current_image_path in + let current_image_path = Eio.Path.(snapshot_dir / filename) in + let exists = Eio.Path.is_file current_image_path in if exists then Some filename else None)) |> List.flatten in let files_to_delete = - Sys.readdir snapshot_dir - |> Array.to_list + Eio.Path.read_dir snapshot_dir |> List.filter_map (fun file -> if not (List.mem file test_file_paths) - then Some (Filename.concat snapshot_dir file) + then Some Eio.Path.(snapshot_dir / file) else None) in let num_files_to_delete = List.length files_to_delete in @@ -37,8 +37,8 @@ let cleanup ~config_path = (Printf.sprintf "Deleting %i files...\n" num_files_to_delete); files_to_delete |> List.iter (fun file -> - Sys.remove file; - Fmt.pr "%a @." (styled `Faint string) (Printf.sprintf "Deleted %s" file)); + Eio.Path.rmtree ~missing_ok:true file; + Fmt.pr "%a @." (styled `Faint string) (Printf.sprintf "Deleted %s" (snd file))); Fmt.pr "\n%a @." (styled `Bold (styled `Green string)) "Done!") else Fmt.pr @@ -46,5 +46,5 @@ let cleanup ~config_path = (styled `Bold (styled `Green string)) "Everything clean. No files to remove!"; print_newline (); - Lwt_result.return () + Result.ok () ;; diff --git a/lib/OSnap_Config/OSnap_Config_Global.ml b/lib/OSnap_Config/OSnap_Config_Global.ml index dd267ee..7849bc8 100644 --- a/lib/OSnap_Config/OSnap_Config_Global.ml +++ b/lib/OSnap_Config/OSnap_Config_Global.ml @@ -4,7 +4,7 @@ module YAML = struct let ( let* ) = Result.bind let parse path = - let config = OSnap_Utils.get_file_contents path in + let config = Eio.Path.load path in let* yaml = config |> Yaml.of_string @@ -65,7 +65,7 @@ module YAML = struct |> Result.map (Option.value ~default:8) |> Result.map (max 1) in - let root_path = Filename.dirname path in + let root_path = Eio.Path.split path |> Option.map fst |> Option.get in let* test_pattern = yaml |> OSnap_Config_Utils.YAML.get_string_option ~path "testPattern" @@ -152,8 +152,8 @@ module JSON = struct let ( let* ) = Result.bind let parse path = - let config = OSnap_Utils.get_file_contents path in - let json = config |> Yojson.Basic.from_string ~fname:path in + let config = Eio.Path.load path in + let json = config |> Yojson.Basic.from_string in let* base_url = try json @@ -243,7 +243,7 @@ module JSON = struct | Yojson.Basic.Util.Type_error (message, _) -> Result.error (`OSnap_Config_Parse_Error (message, path)) in - let root_path = Filename.dirname path in + let root_path = Eio.Path.split path |> Option.map fst |> Option.get in let* ignore_patterns = try json @@ -321,48 +321,40 @@ module JSON = struct ;; end -let find config_names = - let rec scan_dir ~config_names segments = - let current_path = segments |> OSnap_Utils.path_of_segments in - let elements = current_path |> Sys.readdir |> Array.to_list in +let find ~env config_names = + let rec scan_dir ~config_names current_path = + let elements = current_path |> Eio.Path.read_dir in let files = elements |> List.find_all (fun el -> - let path = OSnap_Utils.path_of_segments (el :: segments) in - let is_direcoty = path |> Sys.is_directory in - not is_direcoty) + let path = Eio.Path.(current_path / el) in + Eio.Path.is_file path) in let found_file = files |> List.find_opt (fun file -> List.mem file config_names) in match found_file with - | Some file -> Some (file, segments) + | Some file -> Some Eio.Path.(current_path / file) | None -> - let parent_dir_segments = ".." :: segments in - let parent_dir = parent_dir_segments |> OSnap_Utils.path_of_segments in + let parent_dir = Eio.Path.(current_path / "..") in (try - if parent_dir |> Sys.is_directory - then scan_dir ~config_names parent_dir_segments + if Eio.Path.is_directory parent_dir + then scan_dir ~config_names parent_dir else None with - | Sys_error _ -> None) + | _ -> None) in - let base_path = Sys.getcwd () in - let config_path = scan_dir ~config_names [ base_path ] in - match config_path with - | None -> None - | Some (file, segments) -> - let path = file :: segments |> OSnap_Utils.path_of_segments in - Some path + scan_dir ~config_names (Eio.Stdenv.fs env) ;; -let init ~config_path = +let init ~env ~config_path = let ( let* ) = Result.bind in + let fs = Eio.Stdenv.fs env in let* config = if config_path = "" then ( - match find [ "osnap.config.json"; "osnap.config.yaml" ] with + match find ~env [ "osnap.config.json"; "osnap.config.yaml" ] with | Some path -> Result.ok path | None -> Result.error `OSnap_Config_Global_Not_Found) - else Result.ok config_path + else Result.ok Eio.Path.(fs / config_path) in let* format = OSnap_Config_Utils.get_format config in match format with diff --git a/lib/OSnap_Config/OSnap_Config_Global.mli b/lib/OSnap_Config/OSnap_Config_Global.mli index 6ab1a14..2ec6b73 100644 --- a/lib/OSnap_Config/OSnap_Config_Global.mli +++ b/lib/OSnap_Config/OSnap_Config_Global.mli @@ -1,11 +1,12 @@ val init - : config_path:string + : env:Eio_unix.Stdenv.base + -> config_path:string -> ( OSnap_Config_Types.global , [> `OSnap_Config_Duplicate_Size_Names of string list | `OSnap_Config_Global_Not_Found - | `OSnap_Config_Invalid of string * string - | `OSnap_Config_Parse_Error of string * string - | `OSnap_Config_Unsupported_Format of string - | `OSnap_Config_Undefined_Function of string * string + | `OSnap_Config_Invalid of string * Eio.Fs.dir_ty Eio.Path.t + | `OSnap_Config_Parse_Error of string * Eio.Fs.dir_ty Eio.Path.t + | `OSnap_Config_Undefined_Function of string * Eio.Fs.dir_ty Eio.Path.t + | `OSnap_Config_Unsupported_Format of Eio.Fs.dir_ty Eio.Path.t ] ) result diff --git a/lib/OSnap_Config/OSnap_Config_Test.ml b/lib/OSnap_Config/OSnap_Config_Test.ml index a30fb98..c7ec2a2 100644 --- a/lib/OSnap_Config/OSnap_Config_Test.ml +++ b/lib/OSnap_Config/OSnap_Config_Test.ml @@ -180,8 +180,8 @@ module JSON = struct ;; let parse global_config path = - let config = OSnap_Utils.get_file_contents path in - let json = config |> Yojson.Basic.from_string ~fname:path in + let config = Eio.Path.load path in + let json = config |> Yojson.Basic.from_string in try json |> Yojson.Basic.Util.to_list @@ -259,7 +259,7 @@ module YAML = struct ;; let parse global_config path = - let config = OSnap_Utils.get_file_contents path in + let config = Eio.Path.load path in let* yaml = config |> Yaml.of_string @@ -279,7 +279,7 @@ module YAML = struct ;; end -let find ?(root_path = "/") ?(pattern = "**/*.osnap.json") ?(ignore_patterns = []) () = +let find ~root_path ~pattern ~ignore_patterns = let _, path_segments, pattern_segments = pattern |> String.split_on_char Filename.dir_sep.[0] @@ -295,11 +295,7 @@ let find ?(root_path = "/") ?(pattern = "**/*.osnap.json") ?(ignore_patterns = [ let pattern = pattern_segments |> OSnap_Utils.path_of_segments in let* root_path = try - FilePath.make_absolute - (FileUtil.pwd ()) - (Filename.concat root_path (OSnap_Utils.path_of_segments path_segments)) - |> Unix.realpath - |> Result.ok + Eio.Path.(root_path / OSnap_Utils.path_of_segments path_segments) |> Result.ok with | _ -> Result.error @@ -313,11 +309,21 @@ let find ?(root_path = "/") ?(pattern = "**/*.osnap.json") ?(ignore_patterns = [ let is_ignored path = ignore_patterns |> List.exists (fun pattern -> Re.execp pattern path) in - FileUtil.find - (Custom (fun path -> (not (is_ignored path)) && Re.execp pattern path)) - root_path - (fun acc curr -> curr :: acc) - [] + let rec find_matching_files files = function + | dir :: rest when Eio.Path.is_directory dir -> + dir + |> Eio.Path.read_dir + |> List.map (fun file -> Eio.Path.(dir / file)) + |> List.append rest + |> find_matching_files files + | file :: rest + when (not (is_ignored (Eio.Path.native_exn file))) + && Re.execp pattern (Eio.Path.native_exn file) -> + rest |> find_matching_files (file :: files) + | _ :: rest -> rest |> find_matching_files files + | [] -> files + in + find_matching_files [] [ root_path ] |> OSnap_Utils.List.map_until_exception (fun path -> let* format = OSnap_Config_Utils.get_format path in Result.ok (path, format)) @@ -329,7 +335,6 @@ let init config = ~root_path:config.root_path ~pattern:config.test_pattern ~ignore_patterns:config.ignore_patterns - () in let* tests = tests diff --git a/lib/OSnap_Config/OSnap_Config_Test.mli b/lib/OSnap_Config/OSnap_Config_Test.mli index e4a4e91..3e954c2 100644 --- a/lib/OSnap_Config/OSnap_Config_Test.mli +++ b/lib/OSnap_Config/OSnap_Config_Test.mli @@ -4,9 +4,9 @@ val init , [> `OSnap_Config_Duplicate_Size_Names of string list | `OSnap_Config_Duplicate_Tests of string list | `OSnap_Config_Global_Invalid of string - | `OSnap_Config_Invalid of string * string - | `OSnap_Config_Parse_Error of string * string - | `OSnap_Config_Unsupported_Format of string - | `OSnap_Config_Undefined_Function of string * string + | `OSnap_Config_Invalid of string * Eio.Fs.dir_ty Eio.Path.t + | `OSnap_Config_Parse_Error of string * Eio.Fs.dir_ty Eio.Path.t + | `OSnap_Config_Undefined_Function of string * Eio.Fs.dir_ty Eio.Path.t + | `OSnap_Config_Unsupported_Format of Eio.Fs.dir_ty Eio.Path.t ] ) result diff --git a/lib/OSnap_Config/OSnap_Config_Types.ml b/lib/OSnap_Config/OSnap_Config_Types.ml index 819577d..043fe3c 100644 --- a/lib/OSnap_Config/OSnap_Config_Types.ml +++ b/lib/OSnap_Config/OSnap_Config_Types.ml @@ -33,7 +33,7 @@ type test = } type global = - { root_path : string + { root_path : Eio.Fs.dir_ty Eio.Path.t ; threshold : int ; ignore_patterns : string list ; test_pattern : string diff --git a/lib/OSnap_Config/OSnap_Config_Utils.ml b/lib/OSnap_Config/OSnap_Config_Utils.ml index d16f76b..9763ed8 100644 --- a/lib/OSnap_Config/OSnap_Config_Utils.ml +++ b/lib/OSnap_Config/OSnap_Config_Utils.ml @@ -1,5 +1,8 @@ let get_format path = path + |> Eio.Path.split + |> Option.map snd + |> Option.value ~default:"" |> Filename.extension |> String.lowercase_ascii |> function diff --git a/lib/OSnap_Config/dune b/lib/OSnap_Config/dune index adf4a23..0a60b85 100644 --- a/lib/OSnap_Config/dune +++ b/lib/OSnap_Config/dune @@ -1,3 +1,3 @@ (library (name OSnap_Config) - (libraries OSnap_Utils unix re fileutils yaml yojson)) + (libraries OSnap_Utils eio eio.unix unix re fileutils yaml yojson)) diff --git a/lib/OSnap_Paths/OSnap_Paths.ml b/lib/OSnap_Paths/OSnap_Paths.ml index 45d72f4..bea6a37 100644 --- a/lib/OSnap_Paths/OSnap_Paths.ml +++ b/lib/OSnap_Paths/OSnap_Paths.ml @@ -1,26 +1,26 @@ let get_snapshot_root_path (config : OSnap_Config.Types.global) = - Filename.concat config.root_path config.snapshot_directory + Eio.Path.(config.root_path / config.snapshot_directory) ;; let get_base_images_dir (config : OSnap_Config.Types.global) = let base_path = get_snapshot_root_path config in - Filename.concat base_path "__base_images__" + Eio.Path.(base_path / "__base_images__") ;; let get_updated_dir (config : OSnap_Config.Types.global) = let base_path = get_snapshot_root_path config in - Filename.concat base_path "__updated__" + Eio.Path.(base_path / "__updated__") ;; let get_diff_dir (config : OSnap_Config.Types.global) = let base_path = get_snapshot_root_path config in - Filename.concat base_path "__diff__" + Eio.Path.(base_path / "__diff__") ;; type t = - { base : string - ; updated : string - ; diff : string + { base : Eio.Fs.dir_ty Eio.Path.t + ; updated : Eio.Fs.dir_ty Eio.Path.t + ; diff : Eio.Fs.dir_ty Eio.Path.t } let get config = @@ -32,10 +32,9 @@ let get config = let init_folder_structure config = let dirs = get config in - if not (Sys.file_exists dirs.base) - then FileUtil.mkdir ~parent:true ~mode:(`Octal 0o755) dirs.base; - FileUtil.rm ~recurse:true [ dirs.updated ]; - FileUtil.mkdir ~parent:true ~mode:(`Octal 0o755) dirs.updated; - FileUtil.rm ~recurse:true [ dirs.diff ]; - FileUtil.mkdir ~parent:true ~mode:(`Octal 0o755) dirs.diff + Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dirs.base; + Eio.Path.rmtree ~missing_ok:true dirs.updated; + Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dirs.updated; + Eio.Path.rmtree ~missing_ok:true dirs.diff; + Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dirs.diff ;; diff --git a/lib/OSnap_Paths/OSnap_Paths.mli b/lib/OSnap_Paths/OSnap_Paths.mli index b0374c3..8b0c725 100644 --- a/lib/OSnap_Paths/OSnap_Paths.mli +++ b/lib/OSnap_Paths/OSnap_Paths.mli @@ -1,12 +1,12 @@ -val get_snapshot_root_path : OSnap_Config.Types.global -> string -val get_base_images_dir : OSnap_Config.Types.global -> string -val get_updated_dir : OSnap_Config.Types.global -> string -val get_diff_dir : OSnap_Config.Types.global -> string +val get_snapshot_root_path : OSnap_Config.Types.global -> Eio.Fs.dir_ty Eio.Path.t +val get_base_images_dir : OSnap_Config.Types.global -> Eio.Fs.dir_ty Eio.Path.t +val get_updated_dir : OSnap_Config.Types.global -> Eio.Fs.dir_ty Eio.Path.t +val get_diff_dir : OSnap_Config.Types.global -> Eio.Fs.dir_ty Eio.Path.t type t = - { base : string - ; updated : string - ; diff : string + { base : Eio.Fs.dir_ty Eio.Path.t + ; updated : Eio.Fs.dir_ty Eio.Path.t + ; diff : Eio.Fs.dir_ty Eio.Path.t } val get : OSnap_Config.Types.global -> t diff --git a/lib/OSnap_Paths/dune b/lib/OSnap_Paths/dune index ef0b335..8d8d687 100644 --- a/lib/OSnap_Paths/dune +++ b/lib/OSnap_Paths/dune @@ -1,3 +1,3 @@ (library (name OSnap_Paths) - (libraries OSnap_Config unix fileutils)) + (libraries OSnap_Config eio eio.core eio.unix)) diff --git a/lib/OSnap_Test/OSnap_Test.ml b/lib/OSnap_Test/OSnap_Test.ml index 6e93ee3..a4791d9 100644 --- a/lib/OSnap_Test/OSnap_Test.ml +++ b/lib/OSnap_Test/OSnap_Test.ml @@ -7,85 +7,81 @@ open OSnap_Utils open OSnap_Test_Types let save_screenshot ~path data = - let*? io = - try Lwt_io.open_file ~mode:Output path |> Lwt_result.ok with - | _ -> - `OSnap_FS_Error (Printf.sprintf "Could not save screenshot to %s" path) - |> Lwt_result.fail - in - let*? () = Lwt_io.write io data |> Lwt_result.ok in - Lwt_io.close io |> Lwt_result.ok + try Result.ok @@ Eio.Path.save ~append:false ~create:(`Or_truncate 0o755) path data with + | _ -> + Result.error + @@ `OSnap_FS_Error (Printf.sprintf "Could not save screenshot %S" (snd path)) ;; let read_file_contents ~path = - let*? io = - try Lwt_io.open_file ~mode:Input path |> Lwt_result.ok with - | _ -> - `OSnap_FS_Error (Printf.sprintf "Could not open file %S for reading" path) - |> Lwt_result.fail - in - let*? data = Lwt_io.read io |> Lwt_result.ok in - let*? () = Lwt_io.close io |> Lwt_result.ok in - Lwt_result.return data + try Result.ok @@ Eio.Path.load path with + | _ -> + Result.error + @@ `OSnap_FS_Error (Printf.sprintf "Could not open file %S for reading" (snd path)) ;; -let execute_actions ~document ~target ?size_name actions = +let execute_actions ~env ~document ~target ?size_name actions = let open Config.Types in + let clock = Eio.Stdenv.clock env in let run action = match action, size_name with - | Scroll (_, Some _), None -> Lwt_result.return () + | Scroll (_, Some _), None -> Result.ok () | Scroll (`Selector selector, None), _ -> - target |> Browser.Actions.scroll ~document ~selector:(Some selector) ~px:None + target |> Browser.Actions.scroll ~clock ~document ~selector:(Some selector) ~px:None | Scroll (`PxAmount px, None), _ -> - target |> Browser.Actions.scroll ~document ~selector:None ~px:(Some px) + target |> Browser.Actions.scroll ~clock ~document ~selector:None ~px:(Some px) | Scroll (`Selector selector, Some size_restr), Some size_name -> if size_restr |> List.mem size_name - then target |> Browser.Actions.scroll ~document ~selector:(Some selector) ~px:None - else Lwt_result.return () + then + target + |> Browser.Actions.scroll ~clock ~document ~selector:(Some selector) ~px:None + else Result.ok () | Scroll (`PxAmount px, Some size_restr), Some size_name -> if size_restr |> List.mem size_name - then target |> Browser.Actions.scroll ~document ~selector:None ~px:(Some px) - else Lwt_result.return () - | Click (_, Some _), None -> Lwt_result.return () - | Click (selector, None), _ -> target |> Browser.Actions.click ~document ~selector + then target |> Browser.Actions.scroll ~clock ~document ~selector:None ~px:(Some px) + else Result.ok () + | Click (_, Some _), None -> Result.ok () + | Click (selector, None), _ -> + target |> Browser.Actions.click ~clock ~document ~selector | Click (selector, Some size_restr), Some size_name -> if size_restr |> List.mem size_name - then target |> Browser.Actions.click ~document ~selector - else Lwt_result.return () - | Type (_, _, Some _), None -> Lwt_result.return () + then target |> Browser.Actions.click ~clock ~document ~selector + else Result.ok () + | Type (_, _, Some _), None -> Result.ok () | Type (selector, text, None), _ -> - target |> Browser.Actions.type_text ~document ~selector ~text + target |> Browser.Actions.type_text ~clock ~document ~selector ~text | Type (selector, text, Some size), Some size_name -> if size |> List.mem size_name - then target |> Browser.Actions.type_text ~document ~selector ~text - else Lwt_result.return () - | Wait (_, Some _), None -> Lwt_result.return () + then target |> Browser.Actions.type_text ~clock ~document ~selector ~text + else Result.ok () + | Wait (_, Some _), None -> Result.ok () | Wait (ms, Some size), Some size_name -> if size |> List.mem size_name then ( let timeout = float_of_int ms /. 1000.0 in - Lwt_unix.sleep timeout |> Lwt_result.ok) - else Lwt_result.return () + Eio.Time.sleep clock timeout |> Result.ok) + else Result.ok () | Wait (ms, None), _ -> let timeout = float_of_int ms /. 1000.0 in - Lwt_unix.sleep timeout |> Lwt_result.ok + Eio.Time.sleep clock timeout |> Result.ok in actions - |> Lwt_list.fold_left_s + |> List.fold_left (fun acc curr -> - let* result = run curr in + let result = run curr in match result with - | Ok () -> Lwt.return acc - | Error (`OSnap_Selector_Not_Found _s) -> Lwt.return acc - | Error (`OSnap_Selector_Not_Visible _s) -> Lwt.return acc - | Error (`OSnap_CDP_Protocol_Error _) as e -> Lwt.return e) + | Ok () -> acc + | Error (`OSnap_Selector_Not_Found _s) -> acc + | Error (`OSnap_Selector_Not_Visible _s) -> acc + | Error (`OSnap_CDP_Protocol_Error _) as e -> e) (Result.ok ()) ;; let get_ignore_regions ~document target size_name regions = + let ( let*? ) = Result.bind in let open Config.Types in let get_ignore_region = function - | Coordinates (a, b, _) -> Lwt_result.return [ a, b ] + | Coordinates (a, b, _) -> Result.ok [ a, b ] | SelectorAll (selector, _) -> let*? quads = target |> Browser.Actions.get_quads_all ~document ~selector in quads @@ -95,7 +91,7 @@ let get_ignore_regions ~document target size_name regions = let x2 = Int.of_float x2 in let y2 = Int.of_float y2 in (x1, y1), (x2, y2)) - |> Lwt_result.return + |> Result.ok | Selector (selector, _) -> let*? (x1, y1), (x2, y2) = target |> Browser.Actions.get_quads ~document ~selector @@ -104,9 +100,9 @@ let get_ignore_regions ~document target size_name regions = let y1 = Int.of_float y1 in let x2 = Int.of_float x2 in let y2 = Int.of_float y2 in - Lwt_result.return [ (x1, y1), (x2, y2) ] + Result.ok [ (x1, y1), (x2, y2) ] in - let* regions = + let regions = regions |> List.filter (fun region -> match region, size_name with @@ -120,16 +116,16 @@ let get_ignore_regions ~document target size_name regions = | SelectorAll (_, Some _), None -> false | SelectorAll (_, Some size_restr), Some size_name -> List.mem size_name size_restr | SelectorAll (_selector, None), _ -> true) - |> Lwt_list.map_p get_ignore_region + |> Eio.Fiber.List.map get_ignore_region in regions - |> List.filter_map (function - | Ok regions -> Some (Lwt_result.return regions) + |> Eio.Fiber.List.filter_map (function + | Ok regions -> Some (Result.ok regions) | Error (`OSnap_Selector_Not_Found _s) -> None | Error (`OSnap_Selector_Not_Visible _s) -> None - | Error (`OSnap_CDP_Protocol_Error _ as e) -> Some (Lwt_result.fail e)) - |> Lwt_list.map_p_until_exception Fun.id - |> Lwt_result.map List.flatten + | Error (`OSnap_CDP_Protocol_Error _ as e) -> Some (Result.error e)) + |> ResultList.map_p_until_first_error Fun.id + |> Result.map List.flatten ;; let get_filename ?(diff = false) name width height = @@ -138,56 +134,55 @@ let get_filename ?(diff = false) name width height = else Printf.sprintf "%s_%ix%i.png" name width height ;; -let run (global_config : Config.Types.global) target test = +let run ~env (global_config : Config.Types.global) target test = + let ( let*? ) = Result.bind in if test.skip then ( Printer.skipped_message ~name:test.name ~width:test.width ~height:test.height; - { test with result = Some `Skipped } |> Lwt_result.return) + Result.ok { test with result = Some `Skipped }) else ( let dirs = OSnap_Paths.get global_config in let filename = get_filename test.name test.width test.height in let diff_filename = get_filename ~diff:true test.name test.width test.height in let url = global_config.base_url ^ test.url in - let base_snapshot = Filename.concat dirs.base filename in - let updated_snapshot = Filename.concat dirs.updated filename in - let diff_image = Filename.concat dirs.diff diff_filename in + 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.clear_cookies in let*? () = target |> Browser.Actions.set_size ~width:(`Int test.width) ~height:(`Int test.height) in let*? loaderId = target |> Browser.Actions.go_to ~url in - let*? () = - target |> Browser.Actions.wait_for_network_idle ~loaderId |> Lwt_result.ok - in + let*? () = target |> Browser.Actions.wait_for_network_idle ~loaderId |> Result.ok in let*? document = target |> Browser.Actions.get_document in - let* () = - target - |> Browser.Actions.mousemove + let () = + ignore + @@ Browser.Actions.mousemove ~document ~to_:(`Coordinates (`Int (-100), `Int (-100))) - |> Lwt.map ignore + target in let*? () = - test.actions |> execute_actions ~document ~target ?size_name:test.size_name + execute_actions ~env ~document ~target ?size_name:test.size_name test.actions in let*? screenshot = target |> Browser.Actions.screenshot ~full_size:global_config.fullscreen - |> Lwt_result.map Base64.decode_exn + |> Result.map Base64.decode_exn in let*? result = if not test.exists then ( let*? () = save_screenshot ~path:base_snapshot screenshot in Printer.created_message ~name:test.name ~width:test.width ~height:test.height; - Lwt_result.return `Created) + Result.ok `Created) else let*? original_image_data = read_file_contents ~path:base_snapshot in if original_image_data = screenshot then ( Printer.success_message ~name:test.name ~width:test.width ~height:test.height; - Lwt_result.return `Passed) + Result.ok `Passed) else let*? ignoreRegions = test.ignore_regions |> get_ignore_regions ~document target test.size_name @@ -197,21 +192,21 @@ let run (global_config : Config.Types.global) target test = ~threshold:test.threshold ~diffPixel:global_config.diff_pixel_color ~ignoreRegions - ~output:diff_image + ~output:(Eio.Path.native_exn diff_image) ~original_image_data ~new_image_data:screenshot in match diff () with | Ok () -> Printer.success_message ~name:test.name ~width:test.width ~height:test.height; - Lwt_result.return `Passed + Result.ok `Passed | Error Io -> Printer.corrupted_message ~print_head:true ~name:test.name ~width:test.width ~height:test.height; - Lwt_result.return (`Failed `Io) + Result.ok (`Failed `Io) | Error Layout -> Printer.layout_message ~print_head:true @@ -219,7 +214,7 @@ let run (global_config : Config.Types.global) target test = ~width:test.width ~height:test.height; let*? () = save_screenshot screenshot ~path:updated_snapshot in - Lwt_result.return (`Failed `Layout) + Result.ok (`Failed `Layout) | Error (Pixel (diffCount, diffPercentage)) -> Printer.diff_message ~print_head:true @@ -229,7 +224,7 @@ let run (global_config : Config.Types.global) target test = ~diffCount ~diffPercentage; let*? () = save_screenshot screenshot ~path:updated_snapshot in - Lwt_result.return (`Failed (`Pixel (diffCount, diffPercentage))) + Result.ok (`Failed (`Pixel (diffCount, diffPercentage))) in - { test with result = Some result } |> Lwt_result.return) + { test with result = Some result } |> Result.ok) ;; diff --git a/lib/OSnap_Test/OSnap_Test.mli b/lib/OSnap_Test/OSnap_Test.mli index 92bf1b2..12ede2a 100644 --- a/lib/OSnap_Test/OSnap_Test.mli +++ b/lib/OSnap_Test/OSnap_Test.mli @@ -4,9 +4,10 @@ module Types = OSnap_Test_Types val get_filename : ?diff:bool -> string -> int -> int -> string val run - : OSnap_Config.Types.global + : env:Eio_unix.Stdenv.base + -> OSnap_Config.Types.global -> OSnap_Browser.Target.target -> Types.t -> ( Types.t , [> `OSnap_CDP_Protocol_Error of string | `OSnap_FS_Error of string ] ) - Lwt_result.t + Result.t diff --git a/lib/OSnap_Test/OSnap_Test_Printer.ml b/lib/OSnap_Test/OSnap_Test_Printer.ml index a50af17..05f84c4 100644 --- a/lib/OSnap_Test/OSnap_Test_Printer.ml +++ b/lib/OSnap_Test/OSnap_Test_Printer.ml @@ -209,6 +209,6 @@ let stats ~seconds results = diff_message ~print_head:false ~name ~width ~height ~diffCount ~diffPercentage | _ -> ())); match failed with - | [] -> Lwt_result.return () - | _ -> Lwt_result.fail `OSnap_Test_Failure + | [] -> Result.ok () + | _ -> Result.error `OSnap_Test_Failure ;; diff --git a/lib/OSnap_Test/dune b/lib/OSnap_Test/dune index 00b51de..83e93aa 100644 --- a/lib/OSnap_Test/dune +++ b/lib/OSnap_Test/dune @@ -8,7 +8,8 @@ OSnap_Config OSnap_Browser cdp - lwt - lwt.unix + eio + eio.core + eio.unix base64 fmt)) diff --git a/lib/OSnap_Utils/OSnap_Utils.ml b/lib/OSnap_Utils/OSnap_Utils.ml index 80b4117..0d9c510 100644 --- a/lib/OSnap_Utils/OSnap_Utils.ml +++ b/lib/OSnap_Utils/OSnap_Utils.ml @@ -1,11 +1,5 @@ -let ( let*? ) = Lwt_result.Syntax.( let* ) -let ( let+? ) = Lwt_result.Syntax.( let+ ) -let ( and*? ) = Lwt_result.Syntax.( and* ) -let ( and+? ) = Lwt_result.Syntax.( and+ ) -let ( let* ) = Lwt.Syntax.( let* ) -let ( let+ ) = Lwt.Syntax.( let+ ) -let ( and* ) = Lwt.Syntax.( and* ) -let ( and+ ) = Lwt.Syntax.( and+ ) +let ( let*? ) = Result.bind +let ( let+? ) a b = Result.map b a type platform = | Win32 @@ -92,28 +86,17 @@ module List = struct ;; end -module Lwt_list = struct - include Lwt_list - - let map_p_until_exception fn list = - let rec loop acc list = - match list with - | [] -> Lwt_result.return acc - | list -> - let* resolved, pending = Lwt.nchoose_split list in - let success, error = - resolved - |> List.partition_map (function - | Ok v -> Either.left v - | Error e -> Either.right e) - in - (match error with - | [] -> loop (success @ acc) pending - | hd :: _tl -> - pending |> List.iter Lwt.cancel; - Lwt_result.fail hd) - in - let promises = list |> List.map (Lwt.apply fn) in - loop [] promises +module ResultList = struct + let map_p_until_first_error (type err) (fn : 'a -> ('b, err) result) list = + let exception FoundError of err in + try + list + |> Eio.Fiber.List.map (fun n -> + match fn n with + | Ok n -> n + | Error e -> raise_notrace (FoundError e)) + |> Result.ok + with + | FoundError e -> Result.error e ;; end diff --git a/lib/OSnap_Utils/dune b/lib/OSnap_Utils/dune index 89934bc..a0deee4 100644 --- a/lib/OSnap_Utils/dune +++ b/lib/OSnap_Utils/dune @@ -1,3 +1,3 @@ (library (name OSnap_Utils) - (libraries unix lwt)) + (libraries unix eio eio.core)) diff --git a/lib/OSnap_Websocket/OSnap_Websocket.ml b/lib/OSnap_Websocket/OSnap_Websocket.ml index fec0c26..4f922e0 100644 --- a/lib/OSnap_Websocket/OSnap_Websocket.ml +++ b/lib/OSnap_Websocket/OSnap_Websocket.ml @@ -20,94 +20,124 @@ let call_event_handlers key message = Hashtbl.remove events key)) ;; -let websocket_handler recv send = - let close () = Websocket.Frame.close 1002 |> send in - let send_payload payload = Websocket.Frame.create ~content:payload () |> send in +let _websocket_handler ~sw wsd = + let close () = Httpun_ws.Wsd.close wsd in + let send_payload payload = + let payload = Bytes.of_string payload in + let len = Bytes.length payload in + Httpun_ws.Wsd.send_bytes wsd ~kind:`Text payload ~off:0 ~len + in let rec input_loop () = - let* () = Lwt.pause () in + let () = Eio.Fiber.yield () in if not (Queue.is_empty close_requests) then ( - close_requests |> Queue.iter (fun resolver -> Lwt.wakeup_later resolver ()); + close_requests |> Queue.iter (fun resolver -> Eio.Promise.resolve resolver ()); close_requests |> Queue.clear; close ()) else if not (Queue.is_empty pending_requests) then ( let key, message, resolver = Queue.take pending_requests in - let* () = send_payload message in + let () = send_payload message in Hashtbl.add sent_requests key resolver; input_loop ()) else input_loop () in - let react (frame : Websocket.Frame.t) = - match frame.opcode with - | Close | Continuation | Ctrl _ | Nonctrl _ -> close () - | Ping -> Websocket.Frame.create ~opcode:Pong () |> send - | Pong -> Lwt.return () - | Text | Binary -> - let response = frame.Websocket.Frame.content in - let id = - response - |> Yojson.Safe.from_string - |> Yojson.Safe.Util.member "id" - |> Yojson.Safe.Util.to_int_option - in - let method_ = - response - |> Yojson.Safe.from_string - |> Yojson.Safe.Util.member "method" - |> Yojson.Safe.Util.to_string_option - in - let sessionId = - response - |> Yojson.Safe.from_string - |> Yojson.Safe.Util.member "sessionId" - |> Yojson.Safe.Util.to_string_option - in - (match method_, sessionId with - | None, None -> () - | None, _ -> () - | Some method_, None -> - let key = method_ in - Hashtbl.add events key response; - Hashtbl.find_opt listeners key |> Option.iter (call_event_handlers key response) - | Some method_, Some sessionId -> - let key = method_ ^ sessionId in - Hashtbl.add events key response; - Hashtbl.find_opt listeners key |> Option.iter (call_event_handlers key response)); - (match id with - | None -> Lwt.return () - | Some key -> - Hashtbl.find_opt sent_requests key - |> Option.iter (fun resolver -> Lwt.wakeup_later resolver response); - Hashtbl.remove sent_requests key; - Lwt.return ()) - in - let rec react_forever () = - let* frame = recv () in - let* () = react frame in - react_forever () - in - Lwt.pick [ input_loop (); react_forever () ] + let frame ~opcode:_ ~is_fin:_ ~len:_ _payload = () in + Eio.Fiber.fork ~sw input_loop; + let eof () = () in + Httpun_ws.Websocket_connection.{ frame; eof } +;; + +let _error_handler = function + | `Handshake_failure (rsp, _body) -> + Format.eprintf "Handshake failure: %a\n%!" Httpun.Response.pp_hum rsp + | _ -> assert false ;; -let connect url = - let orig_uri = Uri.of_string url in - let uri = Uri.with_scheme orig_uri (Some "http") in - let* endpoint = Resolver_lwt.resolve_uri ~uri Resolver_lwt_unix.system in - let default_context = Lazy.force Conduit_lwt_unix.default_ctx in - let* client = endpoint |> Conduit_lwt_unix.endp_to_client ~ctx:default_context in - let* conn = Websocket_lwt_unix.connect ~ctx:default_context client uri in - let recv () = Websocket_lwt_unix.read conn in - let send = Websocket_lwt_unix.write conn in - websocket_handler recv send +let connect ~sw ~env url = + let uri = Uri.of_string url in + let resource = Uri.path uri in + let*? client = + Piaf.Client.create env ~sw (Uri.with_scheme uri (Some "http")) + |> Result.map_error (fun _ -> `OSnap_CDP_Connection_Failed) + in + let*? wsd = + Piaf.Client.ws_upgrade client resource + |> Result.map_error (fun _ -> `OSnap_CDP_Connection_Failed) + in + let close () = Piaf.Ws.Descriptor.close wsd in + let rec input_loop () = + let () = Eio.Fiber.yield () in + if not (Queue.is_empty close_requests) + then ( + close_requests |> Queue.iter (fun resolver -> Eio.Promise.resolve resolver ()); + close_requests |> Queue.clear; + close ()) + else if not (Queue.is_empty pending_requests) + then ( + let key, message, resolver = Queue.take pending_requests in + Piaf.Ws.Descriptor.send_string wsd message; + Hashtbl.add sent_requests key resolver; + input_loop ()) + else input_loop () + in + Result.ok + @@ Eio.Fiber.fork ~sw + @@ fun () -> + Eio.Fiber.both + (fun () -> + input_loop (); + Piaf.Client.shutdown client) + (fun () -> + wsd + |> Piaf.Ws.Descriptor.messages + |> Piaf.Stream.iter ~f:(fun (opcode, { Piaf.IOVec.buffer; off; len }) -> + match opcode with + | `Connection_close | `Continuation | `Other _ -> close () + | `Ping -> Piaf.Ws.Descriptor.send_pong wsd + | `Pong -> () + | `Text | `Binary -> + let response = Bigstringaf.substring ~off ~len buffer in + let json = response |> Yojson.Safe.from_string in + let id = + json |> Yojson.Safe.Util.member "id" |> Yojson.Safe.Util.to_int_option + in + let method_ = + json |> Yojson.Safe.Util.member "method" |> Yojson.Safe.Util.to_string_option + in + let sessionId = + json + |> Yojson.Safe.Util.member "sessionId" + |> Yojson.Safe.Util.to_string_option + in + (match method_, sessionId with + | None, None -> () + | None, _ -> () + | Some method_, None -> + let key = method_ in + Hashtbl.add events key response; + Hashtbl.find_opt listeners key + |> Option.iter (call_event_handlers key response) + | Some method_, Some sessionId -> + let key = method_ ^ sessionId in + Hashtbl.add events key response; + Hashtbl.find_opt listeners key + |> Option.iter (call_event_handlers key response)); + (match id with + | None -> () + | Some key -> + Hashtbl.find_opt sent_requests key + |> Option.iter (fun resolver -> Eio.Promise.resolve resolver response); + Hashtbl.remove sent_requests key; + ()))) ;; let send message = let key = id () in let message = message key in - let p, resolver = Lwt.wait () in + let p, resolver = Eio.Promise.create () in pending_requests |> Queue.add (key, message, resolver); - p + Eio.Promise.await p ;; let listen ?(look_behind = true) ~event ~sessionId handler = @@ -126,7 +156,7 @@ let listen ?(look_behind = true) ~event ~sessionId handler = ;; let close () = - let p, resolver = Lwt.wait () in + let p, resolver = Eio.Promise.create () in close_requests |> Queue.add resolver; - p + Eio.Promise.await p ;; diff --git a/lib/OSnap_Websocket/OSnap_Websocket.mli b/lib/OSnap_Websocket/OSnap_Websocket.mli index 0bae656..978146b 100644 --- a/lib/OSnap_Websocket/OSnap_Websocket.mli +++ b/lib/OSnap_Websocket/OSnap_Websocket.mli @@ -5,6 +5,11 @@ val listen -> (string -> (unit -> unit) -> unit) -> unit -val close : unit -> unit Lwt.t -val send : (int -> string) -> string Lwt.t -val connect : string -> unit Lwt.t +val close : unit -> unit +val send : (int -> string) -> string + +val connect + : sw:Eio.Switch.t + -> env:Eio_unix.Stdenv.base + -> string + -> (unit, [> `OSnap_CDP_Connection_Failed ]) result diff --git a/lib/OSnap_Websocket/dune b/lib/OSnap_Websocket/dune index bf75ca7..8a47f46 100644 --- a/lib/OSnap_Websocket/dune +++ b/lib/OSnap_Websocket/dune @@ -2,11 +2,15 @@ (name OSnap_Websocket) (libraries OSnap_Utils - conduit-lwt - conduit-lwt-unix + piaf + piaf.stream + bigstringaf + httpun + httpun-ws + httpun-ws-eio uri - lwt - lwt.unix + eio + eio.core + eio.unix yojson - websocket - websocket-lwt-unix)) + base64)) diff --git a/lib/dune b/lib/dune index 060e288..7428e06 100644 --- a/lib/dune +++ b/lib/dune @@ -8,8 +8,8 @@ OSnap_Config OSnap_Browser unix - lwt - lwt.unix - cdp - base64 - fmt)) + fmt + eio + eio.core + eio.unix + cdp)) diff --git a/osnap.opam b/osnap.opam index 23c97d4..42245c2 100644 --- a/osnap.opam +++ b/osnap.opam @@ -9,22 +9,21 @@ homepage: "https://github.com/eWert-Online/OSnap" bug-reports: "https://github.com/eWert-Online/OSnap/issues" depends: [ "ocaml" - "dune" {>= "3.1"} + "dune" {>= "3.15"} + "eio_main" "base64" "cdp" "cmdliner" - "cohttp" - "cohttp-lwt-unix" + "httpun-eio" + "httpun-ws-eio" "decompress" "fileutils" "fmt" "libspng" - "lwt" "odiff-core" + "piaf" "re" "uri" - "websocket" - "websocket-lwt-unix" "yaml" "yojson" "odoc" {with-doc} @@ -48,4 +47,7 @@ pin-depends: [ [ "libspng.dev" "git+https://github.com/eWert-Online/esy-libspng.git#opam"] [ "cdp.dev" "git+https://github.com/eWert-Online/reason-cdp.git#502346a7ba9a512ce9aaec456561b64464b3782f"] [ "odiff-core.dev" "git+https://github.com/dmtrKovalenko/odiff.git#5a9a1976c553b6c57c32c4e9dcf185bbcdaf1fca"] + [ "piaf.dev" "git+https://github.com/anmonteiro/piaf.git"] + [ "eio-ssl.dev" "git+https://github.com/anmonteiro/eio-ssl.git#0.3.0" ] + [ "multipart_form.dev" "git+https://github.com/anmonteiro/multipart_form.git" ] ] \ No newline at end of file diff --git a/osnap.opam.template b/osnap.opam.template index fe52ba9..3ab65d9 100644 --- a/osnap.opam.template +++ b/osnap.opam.template @@ -2,4 +2,7 @@ pin-depends: [ [ "libspng.dev" "git+https://github.com/eWert-Online/esy-libspng.git#opam"] [ "cdp.dev" "git+https://github.com/eWert-Online/reason-cdp.git#502346a7ba9a512ce9aaec456561b64464b3782f"] [ "odiff-core.dev" "git+https://github.com/dmtrKovalenko/odiff.git#5a9a1976c553b6c57c32c4e9dcf185bbcdaf1fca"] + [ "piaf.dev" "git+https://github.com/anmonteiro/piaf.git"] + [ "eio-ssl.dev" "git+https://github.com/anmonteiro/eio-ssl.git#0.3.0" ] + [ "multipart_form.dev" "git+https://github.com/anmonteiro/multipart_form.git" ] ] \ No newline at end of file