summaryrefslogtreecommitdiff
path: root/gemini/geminiTransaction.ml
diff options
context:
space:
mode:
Diffstat (limited to 'gemini/geminiTransaction.ml')
-rw-r--r--gemini/geminiTransaction.ml27
1 files changed, 23 insertions, 4 deletions
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