summaryrefslogtreecommitdiff
path: root/gemini
diff options
context:
space:
mode:
authorRyan Kavanagh <rak@rak.ac>2020-06-02 14:28:49 -0400
committerRyan Kavanagh <rak@rak.ac>2020-06-07 11:39:58 -0400
commit3f610d86c6f091f6ed3a4e4426d3e6b0d6956a01 (patch)
tree4757fedbaa507daeed14f95550859d534d02f1e9 /gemini
parentSplit common parsing functions into separate function (diff)
We can now parse gemini transactions
Diffstat (limited to 'gemini')
-rw-r--r--gemini/dune2
-rw-r--r--gemini/geminiTransaction.ml27
-rw-r--r--gemini/geminiTransaction.mli2
3 files changed, 25 insertions, 6 deletions
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