summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bin/leda.ml4
-rw-r--r--gemini/dune2
-rw-r--r--gemini/geminiTransaction.ml27
-rw-r--r--gemini/geminiTransaction.mli2
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