diff options
| -rw-r--r-- | test/dune | 3 | ||||
| -rw-r--r-- | test/hello.ml | 31 | ||||
| -rw-r--r-- | test/js/dune | 2 | ||||
| -rw-r--r-- | test/js/websockets_hello.ml | 32 | ||||
| -rw-r--r-- | test/native/dune | 2 | ||||
| -rw-r--r-- | test/native/native_hello.ml | 33 |
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 |