open! Lwt.Syntax
open! Lwt.Infix
open! Flesh

let program (stream, push) config (features : Stream.features) =
  let+ _auth = Sasl.authenticate (stream, push) config features.mechanisms
  in begin 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!"
     end;
     Portal.close (stream, push)

let main =
  let config : Sasl.auth_config = {
      jid = (Sys.getenv "FLESH_JID");
      password = (Sys.getenv "FLESH_PASSWORD");
      preferred_mechanisms = [Sasl.PLAIN]
    }
  in let domain = (List.nth (String.split_on_char '@' config.jid) 1) in
     let* stream, push = Portal.connect domain in
     let* features = Stream.negotiate domain (stream, push) in
     Lwt.catch
       (fun () -> program (stream, push) config features >|= (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
            | Xml.InvalidStanza stanza -> "Invalid stanza: " ^ stanza
            | _ -> "... and so I stumble back to bed.");
         Lwt.fail exn)