diff options
Diffstat (limited to '')
-rw-r--r-- | bin/leda.ml | 4 | ||||
-rw-r--r-- | gemini/dune | 2 | ||||
-rw-r--r-- | gemini/geminiTransaction.ml | 27 | ||||
-rw-r--r-- | gemini/geminiTransaction.mli | 2 |
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 |