summaryrefslogtreecommitdiff
path: root/test/hello.ml
blob: cd4f5bb09af1a92244fa8b2f1e3928052a104ac7 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
open! Lwt.Syntax
open! Lwt.Infix
open! Flesh
open! Session
open! Lwt_react

let main =
  let config : Stream.config = {
      starttls = {prefer = true};
      sasl = {
          jid = Jid.of_string (Sys.getenv "FLESH_JID");
          password = (Sys.getenv "FLESH_PASSWORD");
          preferred_mechanisms = [Sasl.PLAIN]
        };
      other = [];
    }
  in
  let waiter, wakener = Lwt.wait () in
  try%lwt let* { state; update } = create config in
             S.map (function
                 | Connected (portal, Logged_in _) -> portal.push None;
                                                      Lwt.wakeup wakener ()
                 | _ -> ())
               state |> S.keep;
             update (Connecting config.sasl.jid.domainpart);
             waiter
  with exn ->
    begin
      (* 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
         | Xml.InvalidStanza stanza -> "Invalid stanza: " ^ stanza
         | Portal.MalformedStanza err -> "Server sent malformed stanza: " ^ (Markup.Error.to_string err)
         | _ -> "... and so I stumble back to bed.");
      Lwt.fail exn
    end