diff options
| author | Ryan Kavanagh <rak@rak.ac> | 2020-06-08 23:42:37 -0400 |
|---|---|---|
| committer | Ryan Kavanagh <rak@rak.ac> | 2020-06-08 23:42:37 -0400 |
| commit | 7b8746607baf893dbabb81cd58394d299ecb4ae1 (patch) | |
| tree | 1966a32214e57981cec8e4fff4c5c0988ad8cb34 /gemini | |
| parent | Fix notty issues involving newlines (diff) | |
Refactor transactions to use conduit
Diffstat (limited to 'gemini')
| -rw-r--r-- | gemini/dune | 3 | ||||
| -rw-r--r-- | gemini/geminiTransaction.ml | 23 |
2 files changed, 15 insertions, 11 deletions
diff --git a/gemini/dune b/gemini/dune index 7e15878..2a39e4b 100644 --- a/gemini/dune +++ b/gemini/dune @@ -1,4 +1,5 @@ (library (name gemini) - (libraries base angstrom angstrom-lwt-unix lwt lwt_ppx mirage-crypto-pk ptime stdlib tls.lwt uri) + (libraries base angstrom angstrom-lwt-unix conduit conduit-lwt-unix lwt lwt_ppx + lwt_ssl mirage-crypto-pk ptime stdlib tls.lwt uri) (preprocess (pps lwt_ppx))) diff --git a/gemini/geminiTransaction.ml b/gemini/geminiTransaction.ml index 27208b7..4752b2d 100644 --- a/gemini/geminiTransaction.ml +++ b/gemini/geminiTransaction.ml @@ -228,18 +228,21 @@ struct let response_of_string = Angstrom.parse_string ~consume:All response_parser let transaction r = - let open Angstrom_lwt_unix in - let host = Base.Option.value_exn (Uri.host r.url) - ~message:"URL with no host?" in - let port = Base.Option.value_exn (Uri.port r.url) - ~message:"URL with no port?" in - let%lwt authenticator = r.authenticator in + let resolver = + let service : Resolver_lwt.service_fn = function + | "gemini" -> Lwt.return (Some ({ name = "gemini"; + port = 1965; + tls = true } : Resolver.service)) + | s -> Resolver_lwt_unix.system_service s in + let rewrites = [("", Resolver_lwt_unix.system_resolver)] in + Resolver_lwt.init ~service ~rewrites () in try%lwt - let%lwt (ic, oc) = Tls_lwt.connect_ext - Tls.Config.(client ~peer_name:host ~authenticator - ~ciphers:Ciphers.default ()) (host, port) in + let%lwt ctx = Conduit_lwt_unix.init () in + let%lwt endp = Resolver_lwt.resolve_uri ~uri:r.url resolver in + let%lwt client = Conduit_lwt_unix.endp_to_client ~ctx endp in + let%lwt (_flow, ic, oc) = Conduit_lwt_unix.connect ~ctx client in let%lwt () = Lwt_io.write oc (Uri.to_string r.url ^ "\r\n") in - let%lwt (_, parsed) = parse response_parser ic in + let%lwt (_, parsed) = Angstrom_lwt_unix.parse response_parser ic in Lwt.return parsed with | Tls_lwt.Tls_alert alert -> |