From 4541e48f22aac7d3073d14bedc9aad69a092a375 Mon Sep 17 00:00:00 2001
From: Ryan Kavanagh <rak@rak.ac>
Date: Fri, 12 Jun 2020 22:36:10 -0400
Subject: Better error handling

---
 gemini/geminiTransaction.ml  | 23 +++++++++++++++++------
 gemini/geminiTransaction.mli |  8 +++++++-
 2 files changed, 24 insertions(+), 7 deletions(-)

(limited to 'gemini')

diff --git a/gemini/geminiTransaction.ml b/gemini/geminiTransaction.ml
index 9f079af..1221177 100644
--- a/gemini/geminiTransaction.ml
+++ b/gemini/geminiTransaction.ml
@@ -32,6 +32,12 @@ sig
     | FUTURE_CERT_REJECTED
     | EXPIRED_CERT_REJECTED
 
+  type session_error =
+    | TOO_MANY_REDIRECTS
+    | X_DOMAIN_REDIR of Uri.t * Uri.t
+    | UNKNOWN_RESPONSE of string
+    | MISC of string
+
   val make_request : ?authenticator:T.authenticator
     -> ?max_redirects:int -> string -> (request, string) Base.Result.t
 
@@ -49,7 +55,7 @@ sig
 
   val transaction : request -> (response, string) Base.Result.t Lwt.t
 
-  val session : request -> (response, string) Base.Result.t Lwt.t
+  val session : request -> (response, session_error) Base.Result.t Lwt.t
 end
 
 module GeminiTransaction (M : MimeType.MIME_TYPE) (T : TlsUtils.TLS_UTILS)
@@ -89,6 +95,12 @@ struct
     | FUTURE_CERT_REJECTED
     | EXPIRED_CERT_REJECTED
 
+  type session_error =
+    | TOO_MANY_REDIRECTS
+    | X_DOMAIN_REDIR of Uri.t * Uri.t
+    | UNKNOWN_RESPONSE of string
+    | MISC of string
+
   let url_of_string r =
     let url = Uri.of_string r in
     let open Base.Result.Monad_infix in
@@ -255,10 +267,9 @@ struct
         match update_request ~url
                 ~max_redirects:(req.max_redirects - 1) req with
         | Ok req -> session req
-        | Error m -> Lwt.return (Error m)
+        | Error m -> Lwt.return (Error (MISC m))
       else
-        Lwt.return (Error "Too many redirects")
-    | Ok r -> Lwt.return (Error ("Unhandled response "
-                                 ^ (header_of_response r)))
-    | Error m -> Lwt.return (Error m)
+        Lwt.return (Error TOO_MANY_REDIRECTS)
+    | Ok r -> Lwt.return (Error (UNKNOWN_RESPONSE (header_of_response r)))
+    | Error m -> Lwt.return (Error (MISC m))
 end
diff --git a/gemini/geminiTransaction.mli b/gemini/geminiTransaction.mli
index 4a89ab1..d103afe 100644
--- a/gemini/geminiTransaction.mli
+++ b/gemini/geminiTransaction.mli
@@ -32,6 +32,12 @@ sig
     | FUTURE_CERT_REJECTED
     | EXPIRED_CERT_REJECTED
 
+  type session_error =
+    | TOO_MANY_REDIRECTS
+    | X_DOMAIN_REDIR of Uri.t * Uri.t
+    | UNKNOWN_RESPONSE of string
+    | MISC of string
+
   val make_request : ?authenticator:T.authenticator
     -> ?max_redirects:int -> string -> (request, string) Base.Result.t
 
@@ -49,7 +55,7 @@ sig
 
   val transaction : request -> (response, string) Base.Result.t Lwt.t
 
-  val session : request -> (response, string) Base.Result.t Lwt.t
+  val session : request -> (response, session_error) Base.Result.t Lwt.t
 end
 
 module GeminiTransaction (M : MimeType.MIME_TYPE) (T : TlsUtils.TLS_UTILS)
-- 
cgit v1.2.3