Repository: CSCfi/rems
Pull request #1131 (2019-04-16 07:52:50)

Improve validation
Improve validation errors for cases where type is not set. Also test the validation. Mostly for REMS implementers.


Patch:
diff --git a/src/clj/rems/application/commands.clj b/src/clj/rems/application/commands.clj
index 8385cf8f8..6a983b9db 100644
--- a/src/clj/rems/application/commands.clj
+++ b/src/clj/rems/application/commands.clj
@@ -1,6 +1,9 @@
 (ns rems.application.commands
-  (:require [rems.util :refer [getx]]
-            [schema.core :as s])
+  (:require [clojure.test :refer :all]
+            [rems.util :refer [getx]]
+            [schema.core :as s]
+            [schema-refined.core :as r]
+            [rems.util :refer [assert-ex try-catch-ex]])
   (:import (org.joda.time DateTime)))
 
 ;; can't use defschema for this alias since s/Str is just String, which doesn't have metadata
@@ -112,8 +115,31 @@
    :application.command/uninvite-member UninviteMemberCommand
    #_:application.command/withdraw})
 
+(s/defschema Command
+  (merge (apply r/StructDispatch :type (flatten (seq command-schemas)))
+         CommandInternal))
+
 (defn validate-command [cmd]
-  (let [type (:type cmd)
-        schema (merge CommandInternal
-                      (getx command-schemas type))]
-    (s/validate schema cmd)))
+  (assert-ex (contains? command-schemas (:type cmd)) {:error {:type ::unknown-type}
+                                                      :value cmd})
+  (s/validate Command cmd))
+
+(deftest test-validate-command
+  (testing "check specific command schema"
+    (is (validate-command {:application-id 42
+                           :type :application.command/submit
+                           :time (DateTime.)
+                           :actor "applicant"})))
+  (testing "missing event specific key"
+    (is (= {:actor 'missing-required-key}
+           (:error
+            (try-catch-ex
+             (validate-command {:application-id 42
+                                :type :application.command/submit
+                                :time (DateTime.)}))))))
+  (testing "unknown event type"
+    (is (= {:type ::unknown-type}
+           (:error
+            (try-catch-ex
+             (validate-command
+              {:type :does-not-exist})))))))
diff --git a/src/clj/rems/application/events.clj b/src/clj/rems/application/events.clj
index 7b66f33b6..aa8150777 100644
--- a/src/clj/rems/application/events.clj
+++ b/src/clj/rems/application/events.clj
@@ -1,7 +1,8 @@
 (ns rems.application.events
   (:require [clojure.test :refer :all]
             [schema-refined.core :as r]
-            [schema.core :as s])
+            [schema.core :as s]
+            [rems.util :refer [assert-ex try-catch-ex]])
   (:import (org.joda.time DateTime)))
 
 ;; can't use defschema for this alias since s/Str is just String, which doesn't have metadata
@@ -134,6 +135,8 @@
   (apply r/dispatch-on :event/type (flatten (seq event-schemas))))
 
 (defn validate-event [event]
+  (assert-ex (contains? event-schemas (:event/type event)) {:error {:event/type ::unknown-type}
+                                                            :value event})
   (s/validate Event event))
 
 (defn validate-events [events]
@@ -167,10 +170,33 @@
                      :event/actor "foo"
                      :application/id 123}))))
   (testing "unknown event type"
-    ;; TODO: improve error message to show the actual and expected event types
     (is (= "(not (some-matching-condition? a-clojure.lang.PersistentArrayMap))"
            (pr-str (s/check Event
                             {:event/type :foo
                              :event/time (DateTime.)
                              :event/actor "foo"
                              :application/id 123}))))))
+
+(deftest test-validate-event
+  (testing "check specific event schema"
+    (is (validate-event {:event/type :application.event/submitted
+                         :event/time (DateTime.)
+                         :event/actor "foo"
+                         :application/id 123})))
+  (testing "missing event specific key"
+    (is (= {:application/comment 'missing-required-key}
+           (:error
+            (try-catch-ex
+             (validate-event {:event/type :application.event/approved
+                              :event/time (DateTime.)
+                              :event/actor "foo"
+                              :application/id 123}))))))
+  (testing "unknown event type"
+    (is (= {:event/type ::unknown-type}
+           (:error
+            (try-catch-ex
+             (validate-event
+              {:event/type :does-not-exist
+               :event/time (DateTime.)
+               :event/actor "foo"
+               :application/id 123})))))))
diff --git a/src/clj/rems/util.clj b/src/clj/rems/util.clj
index 9bbb1fa0f..15d59d4ca 100644
--- a/src/clj/rems/util.clj
+++ b/src/clj/rems/util.clj
@@ -82,3 +82,18 @@
 
 (defn atom? [x]
   (instance? Atom x))
+
+(defmacro assert-ex
+  "Like assert but throw the result with ex-info and not as string. "
+  ([x message]
+   `(when-not ~x
+      (throw (ex-info (str "Assert failed: " ~message "\n" (pr-str '~x))
+                      (merge ~message {:expression '~x}))))))
+
+(defmacro try-catch-ex
+  "Wraps the code in `try` and `catch` and automatically unwraps the possible exception `ex-data` into regular result."
+  [& body]
+  `(try
+     ~@body
+     (catch clojure.lang.ExceptionInfo e#
+       (ex-data e#))))


Test patch:
diff --git a/test/clj/rems/api/test_applications.clj b/test/clj/rems/api/test_applications.clj
index a45692fec..8e703d8ce 100644
--- a/test/clj/rems/api/test_applications.clj
+++ b/test/clj/rems/api/test_applications.clj
@@ -208,7 +208,8 @@
       (is (= {:success false
               :errors [{:type "forbidden"}]}
              (send-command "" {:type :application.command/approve
-                               :comment "" :application-id application-id}))
+                               :application-id application-id
+                               :comment ""}))
           "user should be forbidden to send command"))
 
     (testing "send command with a user that is not a handler"
diff --git a/test/clj/rems/db/test_applications.clj b/test/clj/rems/db/test_applications.clj
index 529ee6c24..c09aab2e5 100644
--- a/test/clj/rems/db/test_applications.clj
+++ b/test/clj/rems/db/test_applications.clj
@@ -15,6 +15,7 @@
             [rems.db.testing :refer [test-db-fixture rollback-db-fixture test-data-fixture]]
             [rems.db.workflow :as workflow]
             [rems.test-db :as test-db]
+            [rems.util :refer [try-catch-ex]]
             [schema-generators.generators :as sg])
   (:import (org.joda.time DateTime DateTimeZone)
            (clojure.lang ExceptionInfo)))
@@ -38,7 +39,9 @@
         (is (= event (-> event event->json json->event))))))
 
   (testing "event->json validates events"
-    (is (thrown-with-msg? ExceptionInfo #"Value does not match schema" (event->json {}))))
+    (is (not
+         (:rems.event/validate-event
+          (try-catch-ex (event->json {}))))))
 
   (testing "json->event validates events"
     (is (thrown-with-msg? ExceptionInfo #"Value does not match schema" (json->event "{}"))))
diff --git a/test/clj/rems/workflow/test_dynamic.clj b/test/clj/rems/workflow/test_dynamic.clj
index 5a2747471..aa1eb5696 100644
--- a/test/clj/rems/workflow/test_dynamic.clj
+++ b/test/clj/rems/workflow/test_dynamic.clj
@@ -3,7 +3,7 @@
             [clojure.test :refer :all]
             [rems.application.events :as events]
             [rems.application.model :as model]
-            [rems.util :refer [getx]]
+            [rems.util :refer [assert-ex getx]]
             [rems.workflow.dynamic :as dynamic])
   (:import [java.util UUID]
            [org.joda.time DateTime]))
@@ -29,13 +29,6 @@
   (events/validate-events events)
   (dynamic/apply-events application events))
 
-(defmacro assert-ex
-  "Like assert but throw the result with ex-info and not as string. "
-  ([x message]
-   `(when-not ~x
-      (throw (ex-info (str "Assert failed: " ~message "\n" (pr-str '~x))
-                      (merge ~message {:expression '~x}))))))
-
 (defn- fail-command
   ([application cmd]
    (fail-command application cmd nil))