gistfile1.clj

(ns payments.exceptions.http
  (:require [clojure.data.json :as json]
            [payments.utils :refer [log-stack-trace]])
  (:use [payments.macros :only [validate-bindings gen-record
                                gen-fn]]
        [slingshot.slingshot :only [throw+ try+]]))


(defmacro gen-http-exception-middleware [name status]
  (let [fnname (symbol (str name "-middleware"))
        ex (symbol (str name "-exception"))
        catcher '{message :message}
        error-body '{:error message}]
    `(defn ~fnname [app#]
       (fn [req#]
         (try+
          (app# req#)
          (catch ~ex ~catcher
            {:status ~status :body ~error-body}))))))

(defmacro gen-http-exception-thrower [name]
  (let [ename (symbol (str name "-exception."))
        symb (gensym)
        message [symb]]
    `(defn ~name ~message
       (log-stack-trace)
       (throw+ (~ename ~symb)))))

(defn gen-bodies [[name status]]
  `(do
     (gen-record ~name "-exception")
     (gen-http-exception-thrower ~name)
     (gen-http-exception-middleware ~name ~status)))

(defn gen-catch [[name status]]
  (let [error-body '{:error err}
        ex         (symbol (str name "-exception"))
        letb       '[message]
        err-obj    'err-obj]
    `(~ex {:status ~status :body {:error (str (.message ~err-obj))}})))

(defmacro defhttpexceptions [middlware-name bindings]
  (validate-bindings bindings)
  (let [bindings (partition 2 bindings)
        err      'e
        err-obj  'err-obj]
    `(do ~@(map gen-bodies bindings)
         (defn ~middlware-name [app#]
           (fn [req#]
             (try
              (app# req#)
              (catch clojure.lang.ExceptionInfo ~err
                (do
                  (let [~err-obj ((.getData ~err) :object)]
                    (condp instance? ~err-obj
                      ~@(flatten (map gen-catch bindings))
                      (throw ~err)))))))))))

(defhttpexceptions all-http-exceptions-middleware
  ;; This macro enables us to generate boilerplate required for:

  ;; * A type which is throwable containing additional information.
  ;; * A helper method which throws said type.
  ;; * Middleware which can be used in `defroutes' to catch said functions
  ;;   and interpolate the values into the response.

  ;; Example:

  ;; => (defhttpexceptions
  ;;     [not-found 404])

  ;; ;; Generates

  ;; (do
  ;;   (defrecord not-found-exception [message])
  ;;   (defn not-found [message]
  ;;    (throw+ (not-found-exception. message)))
  ;;   (defn not-found-middleware [app]
  ;;    (fn [req]
  ;;     (try+
  ;;      (app req)
  ;;      (catch not-found-exception {message :message}
  ;;       {:status 404 :body {:error message}})))))

  ;; This way we can do:

  ;; (-> routes
  ;;     not-found-middleware)

  ;; (def a-handler [req]
  ;;   (not-found "Some resource was not available"))

  ;; And have the middleware return a HTTP response such as:

  ;; HTTP/1.1 404 Not Found
  ;; Content-Type: application/json

  ;; {"error": "Some resource was not available"}

  [bad-request                     400
   unauthorised                    401
   payment-required                402
   forbidden                       403
   not-found                       404
   method-not-allowed              405
   not-acceptable                  406
   proxy-authentication-required   407
   request-timeout                 408
   conflict                        409
   gone                            410
   length-required                 411
   precondition-failed             412
   payload-too-large               413
   uri-too-long                    414
   unsupported-media-type          415
   range-not-satisfiable           416
   expectation-failed              417
   unprocessable-entity            422
   locked                          423
   failed-dependency               424
   upgrade-required                426
   precondition-required           428
   too-many-requests               429
   request-header-fields-too-large 431
   internal-server-error           500
   not-implemented                 501
   bad-gateway                     502
   service-unavailable             503
   gateway-time-out                504
   http-version-not-supported      505
   insufficient-storage            507
   network-authentication-required 511])