Add cohttp-lwt-jsoo test suite.

.github/workflows/workflow.yml

@@ -32,6 +32,7 @@ jobs:
           opam-pin: false
 
       - run: |
+          (cd cohttp_lwt_jsoo_test && yarn)
           opam pin add cohttp-async.dev . --no-action
           opam pin add cohttp-lwt-jsoo.dev . --no-action
           opam pin add cohttp-lwt-unix.dev . --no-action
@@ -58,3 +59,5 @@ jobs:
       - run: opam exec -- make build
 
       - run: opam exec -- make test
+
+      - run: opam exec -- make js-test

.gitignore

@@ -3,3 +3,4 @@ _build/
 *.install
 .merlin
 _opam/
+node_modules

CHANGES.md

@@ -2,6 +2,7 @@
 
 - lwt_jsoo: Fix `Lwt.wakeup_exn` `Invalid_arg` exception when a js
   stack overflow happens in the XHR completion handler (@mefyl #762).
+- lwt_jsoo: Add test suite (@mefyl #764).
 
 ## v4.0.0 (2021-03-24)
 

Makefile

@@ -6,6 +6,9 @@ build:
 test:
 	dune runtest
 
+js-test:
+	dune build @runjstest
+
 clean:
 	dune clean
 

cohttp-lwt-jsoo.opam

@@ -27,6 +27,8 @@ depends: [
   "cohttp" {= version}
   "cohttp-lwt" {= version}
   "lwt" {>= "3.0.0"}
+  "lwt_ppx" {with-test}
+  "conf-npm" {with-test}
   "js_of_ocaml" {>= "3.3.0"}
   "js_of_ocaml-ppx" {>= "3.3.0"}
   "js_of_ocaml-lwt" {>= "3.5.0"}

cohttp_lwt_jsoo_test/package.json

@@ -0,0 +1,10 @@
+{
+  "name": "ocaml-cohttp",
+  "version": "4.0.0",
+  "description": "An OCaml library for HTTP clients and servers",
+  "repository": "https://github.com/mirage/ocaml-cohttp",
+  "license": "ISC",
+  "dependencies": {
+    "xmlhttprequest": "^1.8.0"
+  }
+}

cohttp_lwt_jsoo_test/src/cohttp_lwt_jsoo_test.ml

@@ -0,0 +1,34 @@
+module Client = Cohttp_lwt_jsoo.Client
+module Js = Js_of_ocaml.Js
+
+let _Promise = Js.Unsafe.global##._Promise
+let ( let* ) = Lwt.( >>= )
+let ( let+ ) = Lwt.( >|= )
+
+let promise_of_lwt lwt =
+  new%js _Promise
+    (Js.wrap_callback (fun resolve reject ->
+         try%lwt
+           let+ res = lwt () in
+           Js.Unsafe.fun_call resolve [| Js.Unsafe.inject res |]
+         with e ->
+           let msg = Printexc.to_string e in
+           Js.Unsafe.fun_call reject
+             [| Js.Unsafe.inject (new%js Js.error_constr (Js.string msg)) |]))
+
+let () =
+  Js.export_all
+    (object%js
+       method request uri =
+         let f () =
+           let uri = Uri.of_string (Js.to_string uri) in
+           let* response, body = Client.get uri in
+           let+ body = Cohttp_lwt.Body.to_string body in
+           let status =
+             Cohttp.Response.status response |> Cohttp.Code.code_of_status
+           in
+           Js.array
+             [| Js.Unsafe.inject status; Js.Unsafe.inject @@ Js.string body |]
+         in
+         promise_of_lwt f
+    end)

cohttp_lwt_jsoo_test/src/dune

@@ -0,0 +1,15 @@
+(executable
+ (name cohttp_lwt_jsoo_test)
+ (modes js)
+ (libraries cohttp cohttp-lwt cohttp-lwt-jsoo lwt js_of_ocaml-lwt)
+ (preprocess
+  (pps lwt_ppx js_of_ocaml-ppx)))
+
+(rule
+ (alias runjstest)
+ (deps test.js cohttp_lwt_jsoo_test.bc.js)
+ (action
+  (setenv
+   NODE_PATH
+   "%{project_root}/cohttp_lwt_jsoo_test/node_modules"
+   (run ./test.js))))

cohttp_lwt_jsoo_test/src/test.js

@@ -0,0 +1,19 @@
+#!/usr/bin/env node
+
+const assert = require('assert');
+
+global.XMLHttpRequest = require("xmlhttprequest").XMLHttpRequest;
+const tests = require('./cohttp_lwt_jsoo_test.bc.js')
+
+async function main() {
+  {
+    const [status, body] = await tests.request("https://mirage.io");
+    assert(status == 200);
+  }
+  {
+    const [status, body] = await tests.request("https://this.domain.does.not.exist");
+    assert(status == 0);
+  }
+}
+
+main()

cohttp_lwt_jsoo_test/yarn.lock

@@ -0,0 +1,8 @@
+# THIS IS AN AUTOGENERATED FILE. DO NOT EDIT THIS FILE DIRECTLY.
+# yarn lockfile v1
+
+
+xmlhttprequest@^1.8.0:
+  version "1.8.0"
+  resolved "https://registry.yarnpkg.com/xmlhttprequest/-/xmlhttprequest-1.8.0.tgz#67fe075c5c24fef39f9d65f5f7b7fe75171968fc"
+  integrity sha1-Z/4HXFwk/vOfnWX197f+dRcZaPw=