We can now parse gemini transactions

4 files changed, 27 insertions, 8 deletions

diff --git a/bin/leda.ml b/bin/leda.ml
index 1438796..3aa7c58 100644
--- a/bin/leda.ml
+++ b/bin/leda.ml
@@ -10,6 +10,6 @@ let () =
     let req = R.make_request ~url:"gemini://gemini.circumlunar.space/\r\n" in
     let%lwt response = R.transaction req in
     match response with
-    | Some (_, _, s) -> Lwt_io.printl s
-    | _ -> Lwt_io.printl "ooops"
+    | Ok (_, _, s) -> Lwt_io.printl s
+    | Error m -> Lwt_io.printl m
     end
diff --git a/gemini/dune b/gemini/dune
index 133054e..3087c29 100644
--- a/gemini/dune
+++ b/gemini/dune
@@ -1,4 +1,4 @@
 (library
  (name gemini)
- (libraries base angstrom lwt lwt_ppx tls.lwt uri)
+ (libraries base angstrom angstrom-lwt-unix lwt lwt_ppx stdlib tls.lwt uri)
  (preprocess (pps lwt_ppx)))
diff --git a/gemini/geminiTransaction.ml b/gemini/geminiTransaction.ml
index e79e40d..86be965 100644
--- a/gemini/geminiTransaction.ml
+++ b/gemini/geminiTransaction.ml
@@ -35,7 +35,7 @@ sig
 
   val int_to_status : int -> status option
 
-  val transaction : request -> response option Lwt.t
+  val transaction : request -> (response, string) result Lwt.t
 end
 
 module GeminiTransaction (M : MimeType.MIME_TYPE) : GEMINI_TRANSACTION
@@ -111,13 +111,32 @@ struct
     | 65 -> Some EXPIRED_CERT_REJECTED
     | _ -> None
 
+  let status_parser : (status, string) result Angstrom.t =
+    let open Angstrom in
+    let status_of_string s =
+      match int_of_string_opt s with
+      | Some n -> (match int_to_status n with
+          | Some s -> Ok s
+          | None -> Error ("Invalid status: " ^ s))
+      | None -> Error ("Invalid status: " ^ s) in
+    lift status_of_string (take 2) <?> "status"
+
   let transaction r =
+    let open Angstrom in
+    let open ParseCommon.ParseCommon in
+    let open Angstrom_lwt_unix in
     let authenticator ~host:_ _ = Ok None in
-    let ()= ignore r in
+    let parser =
+      lift3 (fun status_result -> fun m -> fun r ->
+          Result.bind status_result (fun status -> Ok (status, M.from_string m, r)))
+        status_parser
+        (char ' ' *> take_till_cr)
+        (take_while (fun _ -> true) <* end_of_input)
+      <?> "transaction" 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))
+    let%lwt (_, parsed) = parse parser ic in
+    Lwt.return (Result.join parsed)
 end
diff --git a/gemini/geminiTransaction.mli b/gemini/geminiTransaction.mli
index f365f71..b97967b 100644
--- a/gemini/geminiTransaction.mli
+++ b/gemini/geminiTransaction.mli
@@ -35,7 +35,7 @@ sig
 
   val int_to_status : int -> status option
 
-  val transaction : request -> response option Lwt.t
+  val transaction : request -> (response, string) result Lwt.t
 end
 
 module GeminiTransaction (M : MimeType.MIME_TYPE) : GEMINI_TRANSACTION with module M = M