From 7b8746607baf893dbabb81cd58394d299ecb4ae1 Mon Sep 17 00:00:00 2001
From: Ryan Kavanagh <rak@rak.ac>
Date: Mon, 8 Jun 2020 23:42:37 -0400
Subject: Refactor transactions to use conduit

---
 gemini/dune                 |  3 ++-
 gemini/geminiTransaction.ml | 23 +++++++++++++----------
 2 files changed, 15 insertions(+), 11 deletions(-)

(limited to 'gemini')

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 ->
-- 
cgit v1.2.3