open Lwt.Syntax
open Lwt_unix
open Markup

type t = (signal, async) stream * ((signal, sync) stream option -> unit)

exception MalformedStanza of Markup.location * Markup.Error.t

(** [xmpp_port domain] is the port where [domain]'s XMPP server is hosted.

    Currently, it falls back to 5222 (always), but should use SRV records in the near
    future. *)
let xmpp_port (_domain : string) : int = 5222

(** [tcp_stream domain] is a (stream, socket) tuple communicating with the XMPP server
    hosted on [domain] via plaintext TCP. *)
let tcp_stream (domain : string) : (string Lwt_stream.t * file_descr) Lwt.t =
  let get_socket {ai_addr; ai_family; _} =
    let sock = socket ai_family SOCK_STREAM 0
    in let+ () = Lwt_unix.connect sock ai_addr
       in sock
  and port_number = xmpp_port domain |> string_of_int in
  let* addrinfos = getaddrinfo domain port_number [AI_SOCKTYPE SOCK_STREAM]
  in let+ sock = List.map get_socket addrinfos |> Lwt.pick
     in let stream =
          Lwt_stream.from (fun () ->
              let bsize = 4096 in
              let buffer = Bytes.create bsize in
              let* len = read sock buffer 0 bsize
              in match len with
                 | 0 -> Lwt.return_none
                 | len -> Lwt.return_some (Bytes.sub_string buffer 0 len))
        in (stream, sock)

let connect (domain : string) =
  let+ tcp_stream, tcp_socket = tcp_stream domain
  in let push msg =
       let none () = close tcp_socket
       and some s () =
         write_string tcp_socket s 0 (String.length s) |> Lwt.map ignore
       in Option.fold ~none ~some msg |> Lwt.async
     in tcp_stream, push