feat(tests): move test program to common code

1 files changed, 31 insertions, 0 deletions

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)