From 06cb1301cd561d17276865a2729bc25bfc66bbe7 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Tue, 26 Dec 2017 22:40:34 +0200
Subject: [PATCH] Support route data validation in router

---
 modules/reitit-core/src/reitit/core.cljc |  5 +++
 modules/reitit-core/src/reitit/spec.cljc | 42 ++++++++++++++++++++++++
 test/cljc/reitit/spec_test.cljc          | 30 +++++++++++++++--
 3 files changed, 75 insertions(+), 2 deletions(-)

diff --git a/modules/reitit-core/src/reitit/core.cljc b/modules/reitit-core/src/reitit/core.cljc
index f7fe9c83..c471d6d6 100644
--- a/modules/reitit-core/src/reitit/core.cljc
+++ b/modules/reitit-core/src/reitit/core.cljc
@@ -336,9 +336,11 @@
   | `:path`      | Base-path for routes
   | `:routes`    | Initial resolved routes (default `[]`)
   | `:data`      | Initial route data (default `{}`)
+  | `:spec`      | clojure.spec definition for a route data, see `reitit.spec` on how to use this
   | `:expand`    | Function of `arg opts => data` to expand route arg to route data (default `reitit.core/expand`)
   | `:coerce`    | Function of `route opts => route` to coerce resolved route, can throw or return `nil`
   | `:compile`   | Function of `route opts => result` to compile a route handler
+  | `:validate`  | Function of `routes opts => side-effect` to validate route (data)
   | `:conflicts` | Function of `{route #{route}} => side-effect` to handle conflicting routes (default `reitit.core/throw-on-conflicts!`)
   | `:router`    | Function of `routes opts => router` to override the actual router implementation"
   ([raw-routes]
@@ -358,6 +360,9 @@
                   all-wilds? segment-router
                   :else mixed-router)]
 
+     (when-let [validate (:validate opts)]
+       (validate routes opts))
+
      (when-let [conflicts (:conflicts opts)]
        (when conflicting (conflicts conflicting)))
 
diff --git a/modules/reitit-core/src/reitit/spec.cljc b/modules/reitit-core/src/reitit/spec.cljc
index 0538ecad..d2a93e79 100644
--- a/modules/reitit-core/src/reitit/spec.cljc
+++ b/modules/reitit-core/src/reitit/spec.cljc
@@ -33,6 +33,14 @@
   (s/or :route ::route
         :routes (s/coll-of ::route :into [])))
 
+;;
+;; Default data
+;;
+
+(s/def ::name keyword?)
+(s/def ::handler fn?)
+(s/def ::default-data (s/keys :opt-un [::name ::handler]))
+
 ;;
 ;; router
 ;;
@@ -62,3 +70,37 @@
         :args (s/or :1arity (s/cat :data (s/spec ::raw-routes))
                     :2arity (s/cat :data (s/spec ::raw-routes), :opts ::opts))
         :ret ::router)
+
+;;
+;; Route data validator
+;;
+
+
+(defrecord Problem [path scope data spec problems])
+
+(defn problems-str [problems explain]
+  (apply str "Invalid route data:\n\n"
+         (mapv
+           (fn [{:keys [path scope data spec]}]
+             (str "-- On route --------------------\n\n"
+                  (pr-str path) (if scope (str " " (pr-str scope))) "\n\n" (explain spec data) "\n"))
+           problems)))
+
+(defn throw-on-problems! [problems explain]
+  (throw
+    (ex-info
+      (problems-str problems explain)
+      {:problems problems})))
+
+(defn validate-route-data [routes spec]
+  (->> (for [[p d _] routes]
+         (when-let [problems (and spec (s/explain-data spec d))]
+           (->Problem p nil d spec problems)))
+       (keep identity) (seq)))
+
+(defn validate-spec!
+  [routes {:keys [spec ::explain]
+           :or {explain s/explain-str
+                spec ::default-data}}]
+  (when-let [problems (validate-route-data routes spec)]
+    (throw-on-problems! problems explain)))
diff --git a/test/cljc/reitit/spec_test.cljc b/test/cljc/reitit/spec_test.cljc
index ece98bd1..6260088c 100644
--- a/test/cljc/reitit/spec_test.cljc
+++ b/test/cljc/reitit/spec_test.cljc
@@ -3,7 +3,8 @@
             [#?(:clj clojure.spec.test.alpha :cljs cljs.spec.test.alpha) :as stest]
             [clojure.spec.alpha :as s]
             [reitit.core :as r]
-            [reitit.spec :as spec])
+            [reitit.spec :as rs]
+            [expound.alpha :as e])
   #?(:clj
      (:import (clojure.lang ExceptionInfo))))
 
@@ -45,7 +46,7 @@
            ["/ipa"]])))
 
     (testing "routes conform to spec (can't spec protocol functions)"
-      (is (= true (s/valid? ::spec/routes (r/routes (r/router ["/ping"]))))))
+      (is (= true (s/valid? ::rs/routes (r/routes (r/router ["/ping"]))))))
 
     (testing "options"
 
@@ -75,3 +76,28 @@
         {:compile nil}
         {:conflicts nil}
         {:router nil}))))
+
+(deftest route-data-validation-test
+  (testing "validation is turned off by default"
+    (is (true? (r/router? (r/router
+                            ["/api" {:handler "identity"}])))))
+
+  (testing "with default spec validates :name and :handler"
+    (is (thrown-with-msg?
+          ExceptionInfo
+          #"Invalid route data"
+          (r/router
+            ["/api" {:handler "identity"}]
+            {:validate rs/validate-spec!})))
+    (is (thrown-with-msg?
+          ExceptionInfo
+          #"Invalid route data"
+          (r/router
+            ["/api" {:name "kikka"}]
+            {:validate rs/validate-spec!}))))
+
+  (testing "spec can be overridden"
+    (is (true? (r/router? (r/router
+                            ["/api" {:handler "identity"}]
+                            {:spec any?
+                             :validate rs/validate-spec!}))))))