Added rest-support

src/adl_support/core.clj

@@ -52,6 +52,8 @@
 
 
 (defn massage-value
+  "Return a map with one key, this `k` as a keyword, whose value is the binding of
+  `k` in map `m`, as read by read."
   [k m]
   (let [v (m k)
         vr (if
@@ -72,20 +74,19 @@
   helpful. Massage these `params` and `form-params` to eliminate these problems.
   We must take key field values out of just params, but if form-params are present
   we should take all other values out of form-params - because we need the key to
-  load the form in the first place. `form-params` always override `params`"
+  load the form in the first place. `form-params` always override `params`.
+
+  **NOTE THAT** the parameter `key-fields` is deprecated and ignored."
   ([params form-params key-fields]
    (let
-     [ks (set (map keyword key-fields))
-      p (reduce
+     [p (reduce
           merge
           {}
           (map
             #(massage-value % params)
-          (filter
-           #(ks (keyword %))
-           (keys params))))]
+            (keys params)))]
      (if
-       (empty? form-params)
+       (empty? (keys form-params))
        p
        (reduce
          merge
@@ -141,3 +142,34 @@
        ~error-return)))
 
 
+(defmacro do-or-return-reason
+  "Clojure stacktraces are unreadable. We have to do better; evaluate
+  this `form` in a try-catch block; return a map. If the evaluation
+  succeeds, the map will have a key `:result` whose value is the result;
+  otherwise it will have a key `:error` which will be bound to the most
+  sensible error message we can construct."
+  ;; TODO: candidate for moving to adl-support.core
+  [form]
+  `(try
+     {:result ~form}
+     (catch Exception any#
+       (clojure.tools.logging/error
+         (str (.getName (.getClass any#))
+              ": "
+              (.getMessage any#)
+              (with-out-str
+                (-> any# .printStackTrace))))
+       {:error
+        (s/join
+          "\n\tcaused by: "
+          (reverse
+            (loop [ex# any# result# ()]
+              (if-not (nil? ex#)
+                (recur
+                  (.getCause ex#)
+                  (cons (str
+                          (.getName (.getClass ex#))
+                          ": "
+                          (.getMessage ex#)) result#))
+                result#))))})))
+

src/adl_support/rest_support.clj

@@ -0,0 +1,78 @@
+(ns adl-support.rest-support
+  (:require [clojure.core.memoize :as memo]
+            [clojure.data.json :as json]
+            [clojure.java.io :as io]
+            [clojure.string :refer [split]]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; adl-support.core: functions used by ADL-generated code: REST support.
+;;;;
+;;;; This program is free software; you can redistribute it and/or
+;;;; modify it under the terms of the MIT-style licence provided; see LICENSE.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; License for more details.
+;;;;
+;;;; Copyright (C) 2018 Simon Brooke
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defmacro if-valid-user
+  "Evaluate this `form` only if there is a valid user in the session of
+  this `request`; otherwise return the `error-return` value."
+  ;; TODO: candidate for moving to adl-support.core
+  ([form request error-return]
+   `(log/debug "if-valid-user: " (-> ~request :session :user))
+   `(if
+      (-> ~request :session :user)
+      ~form
+      ~error-return))
+  ([form request]
+   (if-valid-user form request nil)))
+
+
+(defmacro valid-user-or-forbid
+  "Evaluate this `form` only if there is a valid user in the session of
+  this `request`; otherwise return an HTTP forbidden response."
+  ;; TODO: candidate for moving to adl-support.core
+  [form request]
+  `(if-valid-user
+    ~form
+    ~request
+    {:status 403
+     :body (json/write-str "You must be logged in to do that")}))
+
+
+(defmacro with-params-or-error
+  "Evaluate this `form` only if these `params` contain all these `required` keys;
+  otherwise return an HTTP 400 response."
+  ;; TODO: candidate for moving to adl-support.core
+  [form params required]
+  `(if-not
+     (some #(not (% ~params)) ~required)
+     ~form
+     {:status 400
+      :body (json/write-str (str "The following params are required: " ~required))}))
+
+
+;; (with-params-or-error (/ 1 0) {:a 1 :b 2} #{:a :b :c})
+;; (with-params-or-error "hello" {:a 1 :b 2} #{:a :b })
+
+(defmacro do-or-server-fail
+  "Evaluate this `form`; if it succeeds, return an HTTP response with this
+  status code and the JSON-formatted result as body; if it fails, return an
+  HTTP 500 response."
+  [form status]
+  `(let [r# (do-or-return-reason ~form)]
+     (if
+       (some #(= :result %) (keys r#)) ;; :result might legitimately be bound to nil
+       {:status ~status
+        :body (:result r#)}
+       {:status 500
+             :body r#})))
+
+

test/adl_support/core_test.clj

@@ -40,5 +40,12 @@
       (is (= expected actual) "params and form-params differ"))
     (let [expected {:id 67 :offset 0 :limit 50}
           actual (massage-params {:id 60} {:id "67" :offset "0" :limit "50"} #{:id})]
-      (is (= expected actual) "Limit and offset in form-params"))
+      (is (= expected actual) "prefer values from form-params"))
+    (let [expected {:id 67 :offset 0 :limit 50}
+          actual (massage-params {:params {:id "67" :offset "0" :limit "50"} :form-params {}})]
+      (is (= expected actual) "Request with no form params"))
+    (let [expected {:id 67 :offset 0 :limit 50}
+          actual (massage-params {:params {:id "0" :offset "1000" :limit "150"}
+                                  :form-params {:id "67" :offset "0" :limit "50"}})]
+      (is (= expected actual) "Request with form params, params and form params differ"))
       ))

test/adl_support/rest_support_test.clj

@@ -0,0 +1,38 @@
+(ns adl-support.core-test
+  (:require [clojure.test :refer :all]
+            [adl-support.rest_support :refer :all]))
+
+
+(deftest if-valid-user-tests
+  (testing "correct handling of if-valid-user"
+    (let [expected "hello"
+          actual (if-valid-user "hello" {:session {:user {:id 4}}} "goodbye")]
+      (is (= expected actual) "User in session"))
+    (let [expected "goodbye"
+          actual (if-valid-user "hello" {:session {}} "goodbye")]
+      (is (= expected actual) "No user in session"))))
+
+
+(deftest valid-user-or-forbid-tests
+  (testing "valid-user-or-forbid"
+    (let [expected "hello"
+          actual (valid-user-or-forbid "hello" {:session {:user {:id 4}}})]
+      (is (= expected actual) "User in session"))
+    (let [expected 403
+          actual (:status (valid-user-or-forbid "hello" {:session {:user {:id 4}}}))]
+      (is (= expected actual) "No user in session"))))
+
+
+(deftest with-params-or-error-tests
+  (let [expected "hello"
+        actual (with-params-or-error "hello" {:a 1 :b 2} #{:a :b})]
+    (is (= expected actual) "All requirements satisfied"))
+  (let [expected "hello"
+        actual (with-params-or-error "hello" {:a 1 :b 2 :c 3} #{:a :b})]
+    (is (= expected actual) "Unrequired parameter present"))
+  (let [expected 400
+        actual (:status (with-params-or-error "hello" {:a 1 :b 2} #{:a :b :c}))]
+    (is (= expected actual) "Some requirements unsatisfied"))
+  (let [expected 400
+        actual (:status (with-params-or-error (/ 1 0) {:a 1 :b 2} #{:a :b :c}))]
+    (is (= expected actual) "Exception should not be throwen")))