From 3f610d86c6f091f6ed3a4e4426d3e6b0d6956a01 Mon Sep 17 00:00:00 2001
From: Ryan Kavanagh <rak@rak.ac>
Date: Tue, 2 Jun 2020 14:28:49 -0400
Subject: We can now parse gemini transactions

---
 gemini/dune                  |  2 +-
 gemini/geminiTransaction.ml  | 27 +++++++++++++++++++++++----
 gemini/geminiTransaction.mli |  2 +-
 3 files changed, 25 insertions(+), 6 deletions(-)

(limited to 'gemini')

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
-- 
cgit v1.2.3