refactor: use eio

.github/workflows/main.yml

@@ -16,8 +16,8 @@ jobs:
           - ubuntu-latest
           # - windows-latest
         ocaml-compiler:
-          - 4.14.x
-          # - 4.08.x
+          # - 4.14.x
+          - 5.1.x
           # - 4.06.x
 
     runs-on: ${{ matrix.os }}
@@ -30,7 +30,9 @@ jobs:
         with:
           ocaml-compiler: ${{ matrix.ocaml-compiler }}
       - name: Install project dependencies
-        run: opam install . --deps-only --with-doc --with-test
+        run: |
+          opam install . --deps-only --with-doc --with-test
+          opam pin add cohttp-eio 6.0.0~beta2
       - name: Build the project
         run: opam exec -- dune build @install
 

.ocamlformat

@@ -1,4 +1,4 @@
-version = 0.21.0
+version = 0.26.1
 profile=conventional
 margin=80
 if-then-else=k-r

dune-project

@@ -20,6 +20,9 @@
  (depends
   ocaml
   containers
+  cohttp-eio
+  eio
+  eio_main
   cohttp
   ppx_deriving
   cohttp-lwt-unix

imandra-http-api-client.opam

@@ -11,6 +11,9 @@ depends: [
   "dune" {>= "2.7"}
   "ocaml"
   "containers"
+  "cohttp-eio"
+  "eio"
+  "eio_main"
   "cohttp"
   "ppx_deriving"
   "cohttp-lwt-unix"

src/api.ml

@@ -99,6 +99,7 @@ module Response = struct
     stderr: string;
     raw_stdio: string option;
   }
+  [@@deriving show]
 
   type model = {
     syntax: src_syntax;

src/api.mli

@@ -91,6 +91,8 @@ module Response : sig
     raw_stdio: string option;
   }
 
+  val pp_capture : Format.formatter -> capture -> unit
+
   type model = {
     syntax: src_syntax;
     src: string;

src/dune

@@ -1,7 +1,18 @@
 (library
  (name imandra_http_api_client)
  (public_name imandra-http-api-client)
+ (preprocess
+  (pps ppx_deriving.show))
  (flags
   (:standard -w -27))
- (libraries str cohttp-lwt-unix lwt decoders decoders-yojson containers)
+ (libraries
+  str
+  cohttp-lwt-unix
+  cohttp-eio
+  eio
+  eio_main
+  lwt
+  decoders
+  decoders-yojson
+  containers)
  (wrapped true))

src/imandra_http_api_client.ml

@@ -19,6 +19,15 @@ type error =
   | `Error_decoding_response of Decoders_yojson.Basic.Decode.error
   ]
 
+let handle_error fpf (e : error) =
+  let open CCFormat in
+  match e with
+  | `Error_decoding_response err ->
+    fprintf fpf "Decoding error: %a" Decoders_yojson.Basic.Decode.pp_error err
+  | `Error_response (code, err) ->
+    (* TODO: also print the err *)
+    fprintf fpf "Error response: Code = %s" (Cohttp.Code.string_of_status code)
+
 let build_uri (c : Config.t) path = Uri.with_path c.base_uri path
 
 let default_headers (c : Config.t) =
@@ -48,7 +57,7 @@ let read_error s =
   | Error e -> Error (`Error_decoding_response e)
 
 let read (dec : 'a Decoders_yojson.Basic.Decode.decoder) (resp, body) :
-    ('a Api.Response.with_capture, [> error ]) Lwt_result.t =
+    ('a Api.Response.with_capture, [> error ]) CCResult.t Lwt.t =
   let open Lwt.Syntax in
   let* body = Cohttp_lwt.Body.to_string body in
   let status = Cohttp.Response.status resp in
@@ -136,3 +145,114 @@ let decompose (c : Config.t) req =
   let body = make_body E.Request.decomp_req_src req in
   let* res = Cohttp_lwt_unix.Client.call `POST uri ~headers ~body in
   read D.Response.decompose_result res
+
+module Eio = struct
+  let make_body enc x =
+    Decoders_yojson.Basic.Encode.encode_string enc x
+    |> Cohttp_eio.Body.of_string
+
+  let read_raw (s : Cohttp_eio.Body.t) =
+    let flow = s |> Eio.Flow.read_all in
+    let to_str = CCFormat.sprintf "%S" flow in
+    match
+      Decoders_yojson.Basic.Decode.decode_string
+        Decoders_yojson.Basic.Decode.string to_str
+    with
+    | Ok err -> Ok err
+    | Error e -> Error (`Error_decoding_response e)
+
+  let read_response dec (s : Cohttp_eio.Body.t) =
+    match
+      Decoders_yojson.Basic.Decode.decode_string
+        (D.Response.with_capture dec)
+        (s |> Eio.Flow.read_all)
+    with
+    | Ok err -> Ok err
+    | Error e -> Error (`Error_decoding_response e)
+
+  let read_error (s : Cohttp_eio.Body.t) =
+    match
+      Decoders_yojson.Basic.Decode.decode_string
+        D.Response.(with_capture error)
+        (s |> Eio.Flow.read_all)
+    with
+    | Ok err -> Ok err
+    | Error e -> Error (`Error_decoding_response e)
+
+  let read (dec : 'a Decoders_yojson.Basic.Decode.decoder)
+      ((resp, body) : Http.Response.t * Cohttp_eio.Body.t) =
+    let status = Cohttp.Response.status resp in
+    if status = `OK then
+      read_response dec body |> CCResult.flat_map (fun ok -> Ok ok)
+    else
+      read_error body
+      |> CCResult.flat_map (fun err -> Error (`Error_response (status, err)))
+
+  let eval (c : Config.t) (req : Api.Request.eval_req_src) ~sw ~client =
+    let uri = build_uri c "/eval/by-src" in
+    let headers = default_headers c |> Cohttp.Header.of_list in
+    let body = make_body E.Request.eval_req_src req in
+    let res = Cohttp_eio.Client.call client ~sw `POST uri ~headers ~body in
+    read D.Response.eval_result res
+
+  let get_history (c : Config.t) ~client ~sw =
+    let uri = build_uri c "/history" in
+    let headers = default_headers c |> Cohttp.Header.of_list in
+    let _resp, body = Cohttp_eio.Client.get client ~sw uri ~headers in
+
+    (* Logs.debug (fun k -> k "%s" (body |> Eio.Flow.read_all)); *)
+    read_raw body
+
+  let get_status (c : Config.t) ~client ~sw =
+    let uri = build_uri c "/status" in
+    let headers = default_headers c |> Cohttp.Header.of_list in
+    let _resp, body = Cohttp_eio.Client.get client ~sw uri ~headers in
+    read_raw body
+
+  let instance_by_name (c : Config.t) req ~client ~sw =
+    let uri = build_uri c "/instance/by-name" in
+    let headers = default_headers c |> Cohttp.Header.of_list in
+    let body = make_body E.Request.instance_req_name req in
+    let res = Cohttp_eio.Client.call client ~sw `POST uri ~headers ~body in
+    read D.Response.instance_result res
+
+  let instance_by_src (c : Config.t) req ~client ~sw =
+    let uri = build_uri c "/instance/by-src" in
+    let headers = default_headers c |> Cohttp.Header.of_list in
+    let body = make_body E.Request.instance_req_src req in
+    let res = Cohttp_eio.Client.call client ~sw `POST uri ~headers ~body in
+    read D.Response.instance_result res
+
+  let reset (c : Config.t) ~client ~sw =
+    let uri = build_uri c "/reset" in
+    let headers = default_headers c |> Cohttp.Header.of_list in
+    let _res, body = Cohttp_eio.Client.call client ~sw `POST uri ~headers in
+    read_raw body
+
+  let shutdown (c : Config.t) ~client ~sw =
+    let uri = build_uri c "/shutdown" in
+    let headers = default_headers c |> Cohttp.Header.of_list in
+    let _res, body = Cohttp_eio.Client.call client ~sw `POST uri ~headers in
+    read_raw body
+
+  let verify_by_name (c : Config.t) req ~client ~sw =
+    let uri = build_uri c "/verify/by-name" in
+    let headers = default_headers c |> Cohttp.Header.of_list in
+    let body = make_body E.Request.verify_req_name req in
+    let res = Cohttp_eio.Client.call client ~sw `POST uri ~headers ~body in
+    read D.Response.verify_result res
+
+  let verify_by_src (c : Config.t) req ~client ~sw =
+    let uri = build_uri c "/verify/by-src" in
+    let headers = default_headers c |> Cohttp.Header.of_list in
+    let body = make_body E.Request.verify_req_src req in
+    let res = Cohttp_eio.Client.call client ~sw `POST uri ~headers ~body in
+    read D.Response.verify_result res
+
+  let decompose (c : Config.t) req ~client ~sw =
+    let uri = build_uri c "/decompose" in
+    let headers = default_headers c |> Cohttp.Header.of_list in
+    let body = make_body E.Request.decomp_req_src req in
+    let res = Cohttp_eio.Client.call client ~sw `POST uri ~headers ~body in
+    read D.Response.decompose_result res
+end