module type GEMINI_TRANSACTION =
sig
  type request

  module M : MimeType.MIME_TYPE

  type status =
    | INPUT
    | SUCCESS
    | SUCCESS_EOCSS
    | REDIR_TEMP
    | REDIR_PERM
    | TEMP_FAIL
    | SERVER_UNAVAILABLE
    | CGI_ERROR
    | PROXY_ERROR
    | SLOW_DOWN
    | PERM_FAIL
    | NOT_FOUND
    | GONE
    | PROXY_REQ_REFUSED
    | BAD_REQ
    | CLIENT_CERT_REQUIRED
    | TRANSIENT_CERT_REQUESTED
    | AUTHORISED_CERT_REQUIRED
    | CERT_NOT_ACCEPTED
    | FUTURE_CERT_REJECTED
    | EXPIRED_CERT_REJECTED

  type mime_type = M.t

  type response = status * mime_type * string

  val string_to_request : string -> request

  val int_to_status : int -> status option

  val transaction : request -> response option Lwt.t
end

module GeminiTransaction (M : MimeType.MIME_TYPE) : GEMINI_TRANSACTION
  with module M = M =
struct
  exception InvalidRequest

  type request = { host : string; port : int; url : string; }

  module M = M

  type mime_type = M.t

  type status =
    | INPUT
    | SUCCESS
    | SUCCESS_EOCSS
    | REDIR_TEMP
    | REDIR_PERM
    | TEMP_FAIL
    | SERVER_UNAVAILABLE
    | CGI_ERROR
    | PROXY_ERROR
    | SLOW_DOWN
    | PERM_FAIL
    | NOT_FOUND
    | GONE
    | PROXY_REQ_REFUSED
    | BAD_REQ
    | CLIENT_CERT_REQUIRED
    | TRANSIENT_CERT_REQUESTED
    | AUTHORISED_CERT_REQUIRED
    | CERT_NOT_ACCEPTED
    | FUTURE_CERT_REJECTED
    | EXPIRED_CERT_REJECTED

  type response = status * mime_type * string

  let string_to_request r =
    let url = Uri.of_string r in
    let () = match Uri.scheme url with
      | Some "gemini" -> ()
      | _ -> raise InvalidRequest in
    let host = match Uri.host url with
      | Some h -> h
      | _ -> raise InvalidRequest in
    let port = match Uri.port url with
      | Some p -> p
      | _ -> 1965 in
    { host = host; port = port; url = r; }

  let int_to_status = function
    | 10 -> Some INPUT
    | 20 -> Some SUCCESS
    | 21 -> Some SUCCESS_EOCSS
    | 30 -> Some REDIR_TEMP
    | 31 -> Some REDIR_PERM
    | 40 -> Some TEMP_FAIL
    | 41 -> Some SERVER_UNAVAILABLE
    | 42 -> Some CGI_ERROR
    | 43 -> Some PROXY_ERROR
    | 44 -> Some SLOW_DOWN
    | 50 -> Some PERM_FAIL
    | 51 -> Some NOT_FOUND
    | 52 -> Some GONE
    | 53 -> Some PROXY_REQ_REFUSED
    | 54 -> Some BAD_REQ
    | 60 -> Some CLIENT_CERT_REQUIRED
    | 61 -> Some TRANSIENT_CERT_REQUESTED
    | 62 -> Some AUTHORISED_CERT_REQUIRED
    | 63 -> Some CERT_NOT_ACCEPTED
    | 64 -> Some FUTURE_CERT_REJECTED
    | 65 -> Some EXPIRED_CERT_REJECTED
    | _ -> None

  let transaction r =
    let authenticator ~host:_ _ = Ok None in
    let ()= ignore r in
    let%lwt (ic, oc) = Tls_lwt.connect_ext
        Tls.Config.(client ~authenticator ~ciphers:Ciphers.default ())
        (r.host, r.port) in
    let%lwt () = Lwt_io.write oc r.url in
    let%lwt response = Lwt_io.read ic in
    Lwt.return (Some (PERM_FAIL, M.from_string "text/plain", response))
end