feat(tests): move test program to common code

6 files changed, 39 insertions, 64 deletions

diff --git a/test/dune b/test/dune
new file mode 100644
index 0000000..48fdc82
--- /dev/null
+++ b/test/dune
@@ -0,0 +1,3 @@
+(library
+ (name hello)
+ (libraries lwt flesh portal))
diff --git a/test/hello.ml b/test/hello.ml
new file mode 100644
index 0000000..b397727
--- /dev/null
+++ b/test/hello.ml
@@ -0,0 +1,31 @@
+open! Lwt.Syntax
+open! Lwt.Infix
+open! Flesh
+
+let program (stream, push) config =
+  let+ _auth = Sasl.authenticate (stream, push) config
+  in match _auth with
+     | Error (NotAuthorized, Some (_, text)) -> print_endline ("Not authorized: " ^ text)
+     | Error (MalformedRequest, Some (_, text)) -> print_endline ("Malformed request: " ^ text)
+     | Error _ -> print_endline "Error!"
+     | Ok _ -> print_endline "Success!"
+
+let main =
+  let config : Sasl.auth_config = {
+      jid = (Sys.getenv "FLESH_JID");
+      password = (Sys.getenv "FLESH_PASSWORD");
+      preferred_mechanisms = [Stream.PLAIN]
+    }
+  in let domain = (List.nth (String.split_on_char '@' config.jid) 1) in
+     let* stream, push = Stream.start domain in
+     Lwt.catch
+       (fun () -> program (stream, push) config >|= (fun () -> push None))
+       (fun exn ->
+         push None;
+         (* I suspect JavaScript's [wrap_callback] swallows the Exceptions thrown by
+            OCaml, so... The next best thing is probably printing something. *)
+         print_endline
+           (match exn with
+            | Stream.InvalidStanza stanza -> "Invalid stanza: " ^ stanza
+            | _ -> "... and so I stumble back to bed.");
+         Lwt.fail exn)
diff --git a/test/js/dune b/test/js/dune
index f6cc084..00dfecc 100644
--- a/test/js/dune
+++ b/test/js/dune
@@ -1,6 +1,6 @@
 (test
  (name websockets_hello)
- (libraries portal_ws lwt js_of_ocaml flesh)
+ (libraries portal_ws lwt js_of_ocaml flesh hello)
  (modes js)
  (preprocess (pps js_of_ocaml-ppx))
  (deps node_modules)
diff --git a/test/js/websockets_hello.ml b/test/js/websockets_hello.ml
index edcfb62..d82265b 100644
--- a/test/js/websockets_hello.ml
+++ b/test/js/websockets_hello.ml
@@ -1,7 +1,5 @@
-open! Lwt.Syntax
-open! Lwt.Infix
 open! Js_of_ocaml
-open! Flesh
+open! Hello
 
 (* https://stackoverflow.com/questions/34929382/what-are-the-differences-between-lwt-async-and-lwt-main-run-on-ocaml-node-js *)
 let rec run t =
@@ -17,31 +15,5 @@ let rec run t =
         then next_tick (fun () -> run t)
         else ()
 
-let main (stream, push) config =
-  let+ _auth = Sasl.authenticate (stream, push) config
-  in match _auth with
-     | Error (NotAuthorized, Some (_, text)) -> print_endline ("Not authorized: " ^ text)
-     | Error (MalformedRequest, Some (_, text)) -> print_endline ("Malformed request: " ^ text)
-     | Error _ -> print_endline "Error!"
-     | Ok _ -> print_endline "Success!"
-
 let () =
-  run @@
-    let config : Sasl.auth_config = {
-        jid = (Sys.getenv "FLESH_JID");
-        password = (Sys.getenv "FLESH_PASSWORD");
-        preferred_mechanisms = [Stream.PLAIN]
-      }
-    in let domain = (List.nth (String.split_on_char '@' config.jid) 1) in
-       let* stream, push = Stream.start domain in
-       Lwt.catch
-         (fun () -> main (stream, push) config >|= (fun () -> push None))
-         (fun exn ->
-           push None;
-           (* I suspect JavaScript's [wrap_callback] swallows the Exceptions thrown by
-              OCaml, so... The next best thing is probably printing something. *)
-           print_endline
-             (match exn with
-              | Stream.InvalidStanza stanza -> "Invalid stanza: " ^ stanza
-              | _ -> "... and so I stumble back to bed.");
-           Lwt.fail exn)
+  run @@ Hello.main
diff --git a/test/native/dune b/test/native/dune
index faa247d..13238ff 100644
--- a/test/native/dune
+++ b/test/native/dune
@@ -1,3 +1,3 @@
 (test
  (name native_hello)
- (libraries portal_tcp markup flesh))
+ (libraries portal_tcp flesh hello))
diff --git a/test/native/native_hello.ml b/test/native/native_hello.ml
index a5f9323..955642c 100644
--- a/test/native/native_hello.ml
+++ b/test/native/native_hello.ml
@@ -1,33 +1,2 @@
-open! Lwt.Syntax
-open! Lwt.Infix
-open! Flesh
-
-let main (stream, push) config =
-  let+ _auth = Sasl.authenticate (stream, push) config
-  in match _auth with
-     | Error (NotAuthorized, Some (_, text)) -> print_endline ("Not authorized: " ^ text)
-     | Error (MalformedRequest, Some (_, text)) -> print_endline ("Malformed request: " ^ text)
-     | Error _ -> print_endline "Error!"
-     | Ok _ -> print_endline "Success!"
-
-
 let () =
-  Lwt_main.run @@
-    let config : Sasl.auth_config = {
-        jid = (Sys.getenv "FLESH_JID");
-        password = (Sys.getenv "FLESH_PASSWORD");
-        preferred_mechanisms = [Stream.PLAIN]
-      }
-    in let domain = (List.nth (String.split_on_char '@' config.jid) 1) in
-       let* stream, push = Stream.start domain in
-       Lwt.catch
-         (fun () -> main (stream, push) config >|= (fun () -> push None))
-         (fun exn ->
-           push None;
-           (* I suspect JavaScript's [wrap_callback] swallows the Exceptions thrown by
-              OCaml, so... The next best thing is probably printing something. *)
-           print_endline
-             (match exn with
-              | Stream.InvalidStanza stanza -> "Invalid stanza: " ^ stanza
-              | _ -> "... and so I stumble back to bed.");
-           Lwt.fail exn)
+  Lwt_main.run @@ Hello.main