From f159347646dad0f81d21ed052360dbc606f6d52c Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Mon, 5 Mar 2012 16:55:14 -0500
Subject: [PATCH] Improve error messages from declaration of resources

---
 amqp_relay.ml | 16 ++++++++++++++--
 factory.ml    | 25 ++++++++++++++-----------
 2 files changed, 28 insertions(+), 13 deletions(-)

diff --git a/amqp_relay.ml b/amqp_relay.ml
index 8f7f6e8..e69f800 100644
--- a/amqp_relay.ml
+++ b/amqp_relay.ml
@@ -155,14 +155,26 @@ let issue_banner cin cout =
     else true
   with End_of_file -> false
 
+let reference_to_logs = "See server logs for details"
+let extract_str v =
+  match v with
+  | Sexp.Str s -> s
+  | _ -> reference_to_logs
+
 let reply_to_declaration conn status ok_fn =
   match Message.message_of_sexp status with
   | Message.Create_ok info ->
       send_method conn 1 (ok_fn info)
   | Message.Create_failed reason ->
       (match reason with
-      | Sexp.Str s -> send_warning conn precondition_failed s
-      | _ -> send_warning conn precondition_failed "See server logs for details")
+      | Sexp.Arr [Sexp.Str "factory"; Sexp.Str "class-not-found"] ->
+	  send_error conn command_invalid "Object type not supported by server"
+      | Sexp.Arr [Sexp.Str "constructor"; Sexp.Str "class-mismatch"] ->
+	  send_error conn not_allowed "Redeclaration with different object type not permitted"
+      | Sexp.Arr [Sexp.Str who; explanation] ->
+	  send_warning conn precondition_failed (who^" failed: "^(extract_str explanation))
+      | _ ->
+	  send_warning conn precondition_failed reference_to_logs)
   | _ -> die internal_error "Declare reply malformed"
 
 let make_queue_declare_ok info =
diff --git a/factory.ml b/factory.ml
index 0e2581a..cbd5b65 100644
--- a/factory.ml
+++ b/factory.ml
@@ -19,20 +19,23 @@ let lookup_class name =
 let factory_handler n sexp =
   match Message.message_of_sexp sexp with
   | Message.Create (Str classname, arg, Str reply_sink, Str reply_name) ->
-      (match lookup_class classname with
-      | Some factory ->
-	  let reply =
-	    match factory arg with
+      let reply =
+	match lookup_class classname with
+	| Some factory ->
+	    (match factory arg with
 	    | Status.Ok info ->
-		Log.info "Node create ok" [Str classname; arg; Str reply_sink; Str reply_name];
+		Log.info "Node create ok"
+		  [Str classname; arg; Str reply_sink; Str reply_name; info];
 		Message.create_ok info
 	    | Status.Problem explanation ->
-		Log.info "Node create failed" [Str classname; arg; Str reply_sink; Str reply_name];
-		Message.create_failed explanation
-	  in
-	  Node.post_ignore reply_sink (Str reply_name) reply (Str "")
-      | None ->
-	  Log.warn "Node class not found" [Str classname])
+		Log.info "Node create failed"
+		  [Str classname; arg; Str reply_sink; Str reply_name; explanation];
+		Message.create_failed (Arr [Str "constructor"; explanation]))
+	| None ->
+	    Log.warn "Node class not found" [Str classname];
+	    Message.create_failed (Arr [Str "factory"; Str "class-not-found"])
+      in
+      Node.post_ignore reply_sink (Str reply_name) reply (Str "")
   | m ->
       Util.message_not_understood "factory" m