From abd5bb22a88c9e3c26205b9b9c7bcbc4923516f8 Mon Sep 17 00:00:00 2001
From: Milo Davis <davis.mil@husky.neu.edu>
Date: Mon, 4 Dec 2017 12:10:20 +0100
Subject: [PATCH] Error monad: Better error for non-object error encodings

---
 lib_data_encoding/data_encoding.ml  | 42 +++++++++++++++--------------
 lib_data_encoding/data_encoding.mli |  6 +++++
 lib_error_monad/error_monad.ml      |  5 ++++
 3 files changed, 33 insertions(+), 20 deletions(-)

diff --git a/lib_data_encoding/data_encoding.ml b/lib_data_encoding/data_encoding.ml
index ac6b7f321..be388dffc 100644
--- a/lib_data_encoding/data_encoding.ml
+++ b/lib_data_encoding/data_encoding.ml
@@ -550,18 +550,29 @@ module Encoding = struct
   let obj10 f10 f9 f8 f7 f6 f5 f4 f3 f2 f1 =
     raw_merge_objs (obj2 f10 f9) (obj8 f8 f7 f6 f5 f4 f3 f2 f1)
 
+  let rec is_obj : type a. a t -> bool = fun e ->
+    match e.encoding with
+    | Obj _ -> true
+    | Objs _ (* by construction *) -> true
+    | Conv { encoding = e } -> is_obj e
+    | Dynamic_size e  -> is_obj e
+    | Union (_,_,cases) ->
+        List.for_all (fun (Case { encoding = e }) -> is_obj e) cases
+    | Empty -> true
+    | Ignore -> true
+    | _ -> false
+
+  let rec is_tup : type a. a t -> bool = fun e ->
+    match e.encoding with
+    | Tup _ -> true
+    | Tups _ (* by construction *) -> true
+    | Conv { encoding = e } -> is_tup e
+    | Dynamic_size e  -> is_tup e
+    | Union (_,_,cases) ->
+        List.for_all (function Case { encoding = e} -> is_tup e) cases
+    | _ -> false
+
   let merge_objs o1 o2 =
-    let rec is_obj : type a. a t -> bool = fun e ->
-      match e.encoding with
-      | Obj _ -> true
-      | Objs _ (* by construction *) -> true
-      | Conv { encoding = e } -> is_obj e
-      | Dynamic_size e  -> is_obj e
-      | Union (_,_,cases) ->
-          List.for_all (fun (Case { encoding = e }) -> is_obj e) cases
-      | Empty -> true
-      | Ignore -> true
-      | _ -> false in
     if is_obj o1 && is_obj o2 then
       raw_merge_objs o1 o2
     else
@@ -592,15 +603,6 @@ module Encoding = struct
     raw_merge_tups (tup2 e10 e9) (tup8 e8 e7 e6 e5 e4 e3 e2 e1)
 
   let merge_tups t1 t2 =
-    let rec is_tup : type a. a t -> bool = fun e ->
-      match e.encoding with
-      | Tup _ -> true
-      | Tups _ (* by construction *) -> true
-      | Conv { encoding = e } -> is_tup e
-      | Dynamic_size e  -> is_tup e
-      | Union (_,_,cases) ->
-          List.for_all (function Case { encoding = e} -> is_tup e) cases
-      | _ -> false in
     if is_tup t1 && is_tup t2 then
       raw_merge_tups t1 t2
     else
diff --git a/lib_data_encoding/data_encoding.mli b/lib_data_encoding/data_encoding.mli
index 96a7113cd..21a0f4392 100644
--- a/lib_data_encoding/data_encoding.mli
+++ b/lib_data_encoding/data_encoding.mli
@@ -143,6 +143,12 @@ val result : 'a encoding -> 'b encoding -> ('a, 'b) result encoding
 val string_enum : (string * 'a) list -> 'a encoding
 
 
+(** Is the given encoding serialized as a JSON object? *)
+val is_obj : 'a encoding -> bool
+
+(** Does the given encoding encode a tuple? *)
+val is_tup : 'a encoding -> bool
+
 (** Create encodings that produce data of a fixed length when binary encoded.
     See the preamble for an explanation. *)
 module Fixed : sig
diff --git a/lib_error_monad/error_monad.ml b/lib_error_monad/error_monad.ml
index a70a7f1c6..537ed41ee 100644
--- a/lib_error_monad/error_monad.ml
+++ b/lib_error_monad/error_monad.ml
@@ -60,6 +60,11 @@ module Make() = struct
       invalid_arg
         (Printf.sprintf
            "register_error_kind: duplicate error name: %s" name) ;
+    if not (Data_encoding.is_obj encoding)
+    then invalid_arg
+        (Printf.sprintf
+           "Specified encoding for \"%s\" is not an object, but error encodings must be objects."
+           name) ;
     let encoding_case =
       let open Data_encoding in
       case