Revise with better understanding of lwt library

3 files changed, 36 insertions, 28 deletions

diff --git a/gemini/dune b/gemini/dune
index 7b93751..133054e 100644
--- a/gemini/dune
+++ b/gemini/dune
@@ -1,3 +1,4 @@
 (library
  (name gemini)
- (libraries base angstrom lwt tls.lwt uri))
+ (libraries base angstrom lwt lwt_ppx tls.lwt uri)
+ (preprocess (pps lwt_ppx)))
diff --git a/gemini/request.ml b/gemini/request.ml
index f67f6f2..282d6e7 100644
--- a/gemini/request.ml
+++ b/gemini/request.ml
@@ -1,10 +1,8 @@
-open Lwt.Infix
-
 module type GEMINI_TRANSACTION =
 sig
-  module M : MimeType.MIME_TYPE
+  type request
 
-  type mime_type = M.t
+  module M : MimeType.MIME_TYPE
 
   type status =
     | INPUT
@@ -29,11 +27,15 @@ sig
     | 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 request : string -> response option
+  val transaction : request -> response option Lwt.t
 end
 
 module GeminiTransaction (M : MimeType.MIME_TYPE) : GEMINI_TRANSACTION
@@ -41,6 +43,8 @@ module GeminiTransaction (M : MimeType.MIME_TYPE) : GEMINI_TRANSACTION
 struct
   exception InvalidRequest
 
+  type request = { host : string; port : int; url : string; }
+
   module M = M
 
   type mime_type = M.t
@@ -70,6 +74,19 @@ struct
 
   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
@@ -94,27 +111,13 @@ struct
     | 65 -> Some EXPIRED_CERT_REJECTED
     | _ -> None
 
-  let do_request host port request =
+  let transaction r =
     let authenticator ~host:_ _ = Ok None in
-    Lwt_main.run (
-      Tls_lwt.connect_ext
+    let ()= ignore r in
+    let%lwt (ic, oc) = Tls_lwt.connect_ext
         Tls.Config.(client ~authenticator ~ciphers:Ciphers.default ())
-        (host, port) >>= fun (ic, oc) ->
-      Lwt_io.(write oc request >>= fun () ->
-              read ic >>= Lwt.return))
-
-  let 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 s -> s
-      | _ -> raise InvalidRequest in
-    let port = match Uri.port url with
-      | Some p -> p
-      | _ -> 1965 in
-    let response = do_request host port r in
-    Some (PERM_FAIL, M.from_string "text/plain", response)
-
+        (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
diff --git a/gemini/request.mli b/gemini/request.mli
index b96a5ae..45049f1 100644
--- a/gemini/request.mli
+++ b/gemini/request.mli
@@ -1,5 +1,7 @@
 module type GEMINI_TRANSACTION =
 sig
+  type request
+
   module M : MimeType.MIME_TYPE
 
   type status =
@@ -29,9 +31,11 @@ sig
 
   type response = status * mime_type * string
 
+  val string_to_request : string -> request
+
   val int_to_status : int -> status option
 
-  val request : string -> response option
+  val transaction : request -> response option Lwt.t
 end
 
 module GeminiTransaction (M : MimeType.MIME_TYPE) : GEMINI_TRANSACTION with module M = M