open Lwt.Syntax
open Lwt.Infix
open Lwt_react

type connection_step =
  | Starting_stream of string

type state =
  | Disconnected
  | Opening_portal of string
  | Connecting of Portal.t * connection_step
  | Connected of Portal.t * Stream.features

(** [create domain config] is a promise containing a signal representing the portal
    connected to the XMPP server located at [domain], and all its supported features.

    When calling the function, the portal will try to connect to the provided domain.

    Basically, it conforms to {{:
    https://datatracker.ietf.org/doc/html/rfc6120#section-4.3 }}, and gets the Portal in
    a "ready" state. *)
let create (domain : string) (config : Stream.config) : (state signal * (unit -> unit)) Lwt.t =
  let state, update = S.create Disconnected in
  let connect (portal : Portal.t) : unit Lwt.t =
    let open Stream in
    let needs_restart = function
      | Feature.Mechanisms _ | STARTTLS -> true
      | _ -> false
    in
    let+ features =
      let rec handle_features (features : Stream.features) : Stream.features Lwt.t =
        match features with
        | feature :: rest ->
           let* () = negotiate feature portal config
           in if needs_restart (Feature.unwrap feature)
              then start domain portal >>= handle_features
              else handle_features rest
        | features -> Lwt.return features
      in start domain portal >>= handle_features
    in update (Connected (portal, features))
  in
  let+ () = S.map_s
              (function
               | Opening_portal domain ->
                  let+ portal = Portal.connect domain
                  in update (Connecting (portal, Starting_stream domain))
               | Connecting (portal, _) -> connect portal
               | _ -> Lwt.return_unit)
              state >|= S.keep;
  in state, fun () -> update (Opening_portal domain)