├── .gitignore ├── test └── patika │ └── core_test.clj ├── CHANGELOG.md ├── project.clj ├── LICENSE ├── README.md └── src └── patika └── core.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | profiles.clj 5 | pom.xml 6 | pom.xml.asc 7 | *.jar 8 | *.class 9 | /.lein-* 10 | /.nrepl-port 11 | .hgignore 12 | .hg/ 13 | .idea/ 14 | *.iml -------------------------------------------------------------------------------- /test/patika/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns patika.core-test 2 | (:require [clojure.test :refer :all] 3 | [patika.core :refer :all])) 4 | 5 | (deftest a-test 6 | (testing "FIXME, I fail." 7 | (is (= 0 1)))) 8 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/). 3 | 4 | ## [Unreleased] 5 | ### Changed 6 | - Add a new arity to `make-widget-async` to provide a different widget shape. 7 | 8 | ## [0.1.1] - 2020-03-27 9 | ### Changed 10 | - Documentation on how to make the widgets. 11 | 12 | ### Removed 13 | - `make-widget-sync` - we're all async, all the time. 14 | 15 | ### Fixed 16 | - Fixed widget maker to keep working when daylight savings switches over. 17 | 18 | ## 0.1.0 - 2020-03-27 19 | ### Added 20 | - Files from the new template. 21 | - Widget maker public API - `make-widget-sync`. 22 | 23 | [Unreleased]: https://github.com/your-name/patika/compare/0.1.1...HEAD 24 | [0.1.1]: https://github.com/your-name/patika/compare/0.1.0...0.1.1 25 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject patika "0.1.11" 2 | 3 | :description "Clojure routing library which is an abstraction over Liberator + Compojure" 4 | 5 | :url "https://github.com/ertugrulcetin/patika" 6 | 7 | :author "Ertuğrul Çetin" 8 | 9 | :license {:name "MIT License" :url "https://opensource.org/licenses/MIT"} 10 | 11 | :deploy-repositories [["clojars" {:sign-releases false :url "https://clojars.org/repo"}] 12 | ["releases" {:sign-releases false :url "https://clojars.org/repo"}] 13 | ["snapshots" {:sign-releases false :url "https://clojars.org/repo"}]] 14 | 15 | :dependencies [[org.clojure/clojure "1.10.1"] 16 | [org.clojure/data.json "1.0.0"] 17 | [org.clojure/tools.logging "1.0.0"] 18 | [org.clojure/java.classpath "1.0.0"] 19 | [org.clojure/tools.namespace "1.0.0"] 20 | [compojure "1.6.1"] 21 | [liberator "0.15.3"]]) -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Ertuğrul Çetin 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # patika 2 | 3 | Patika is a new Clojure routing library which is an abstraction over [Liberator](https://clojure-liberator.github.io/liberator/) + [Compojure](https://github.com/weavejester/compojure). 4 | 5 | ## Installation 6 | [![Clojars Project](https://clojars.org/patika/latest-version.svg)](https://clojars.org/patika) 7 | 8 | ## Usage 9 | ```clojure 10 | (require '[patika.core :refer [resource get-routes]]) 11 | ``` 12 | 13 | ## Let's work on a full example 14 | ```clojure 15 | (ns patika.api.common 16 | (:require [patika.core :refer [resource get-routes]] 17 | [compojure.core :as c] 18 | [compojure.route :as r] 19 | [ring.adapter.jetty :refer [run-jetty]] 20 | [liberator.representation :as rep])) 21 | 22 | 23 | ;; Response returns text/plain 24 | (resource hello 25 | :get ["/hello"] 26 | :content-type :text 27 | :handle-ok (fn [ctx] "Hello World")) 28 | 29 | 30 | ;; Response returns plain HTML 31 | (resource home 32 | :get ["/"] 33 | :content-type :html 34 | :handle-ok (fn [ctx] "Hello Patika!")) 35 | 36 | 37 | ;; Response returns JSON, no need manuel JSON transformation! 38 | (resource users 39 | :get ["/users"] 40 | :content-type :json 41 | :handle-ok (fn [ctx] [{:name "Ertuğrul" :age 28} {:name "Çetin" :age 22}])) 42 | 43 | 44 | ;; PUT example, response returns -> {:success? true} in JSON format 45 | (resource create-user 46 | :put ["/users"] 47 | :content-type :json 48 | :put! (fn [ctx] 49 | (let [data (clojure.walk/keywordize-keys (:request-data ctx))] 50 | (create-user! (:email data) (:password data)))) 51 | :handle-ok (fn [ctx] {:success? true})) 52 | 53 | 54 | ;; POST example, response returns -> {:success? true :user-id id} in JSON format 55 | ;; Also, manuel exception handling with :handle-exception 56 | (resource activate-user 57 | :post ["/users/:id" [id]] 58 | ;;You can use coercion like this ["/users/:id" [id :<< compojure.coercions/as-int]] 59 | :content-type :json 60 | :post! (fn [ctx] (activate-user-by-id id)) 61 | :handle-created (fn [ctx] {:success? true :user-id id}) 62 | ;;Optional, if you want to handle exception. If you don't set your own, default one will be used. 63 | :handle-exception (fn [ctx] (println "Error ocurred: " (:exception ctx)))) 64 | 65 | 66 | ;; Route with AUTHORIZATION -> :auth-fn 67 | (resource send-event 68 | :put ["/events"] 69 | :content-type :json 70 | ;;If :auth-fn returns TRUTHY value, then it proceeds. If not, client gets 401 HTTP error. 71 | :auth-fn (fn [ctx] (-> ctx :request :headers (get "x-auth-token"))) 72 | :put! #(create-event %) 73 | :handle-ok (fn [_] {:success? true})) 74 | 75 | 76 | ;; Redirect and Cookie Set example -> :redirect! and :as-response 77 | (resource dictionary 78 | :get ["/dictionary/:word" [word]] 79 | :content-type :html 80 | ;;If first value of vector returns `true` then there will be redirection to /word-does-not-exist path. 81 | :redirect! [(not (get dictionary-map word)) "/word-does-not-exist"] 82 | :handle-ok (fn [_] 83 | (let [details (get-word-details word) 84 | word-data {:word word 85 | :details details 86 | :body (generate-html)}] 87 | word-data)) 88 | :as-response (fn [word-data ctx] 89 | (-> (rep/as-response (:body word-data) ctx) 90 | (assoc-in [:headers "Set-Cookie"] (str "word=" (:word word-data) ";details=" (:details word-data)))))) 91 | 92 | 93 | ;; Uploading some file, multipart data 94 | (resource upload-file 95 | :post ["/upload"] 96 | :content-type :multipart 97 | :post! (fn [ctx] 98 | (let [file (-> ctx :request :params (get "file") :tempfile)] 99 | (with-open [rdr (io/reader file)] 100 | ...))) 101 | :handle-exception #(.getMessage (:exception %))) 102 | 103 | 104 | ;; Generating sitemap.xml 105 | (resource sitemap 106 | :get ["/sitemap.xml"] 107 | :content-type :xml 108 | :handle-ok (fn [_] (generate-sitemap-string))) 109 | 110 | 111 | ;; If provided routes do not exists, they will be redirected to this one. 112 | (c/defroutes not-found 113 | (r/not-found "404!")) 114 | 115 | 116 | (defn run-dev-server 117 | [port] 118 | ;;Scans namespaces then filters namespaces start with "patika.api." and registers routes automatically. 119 | ;;You can also manually register routes by using :resource-ns-vec 120 | ;;-> {:resource-ns-vec '[patika.api.common patika.api.users patika.api.segments ..]} 121 | (run-jetty (get-routes {:resource-ns-path "patika.api." 122 | :not-found-route 'patika.api.common/not-found}) 123 | {:port port :join? false})) 124 | 125 | 126 | (run-dev-server 3000) 127 | ``` 128 | 129 | 130 | ## License 131 | 132 | ``` 133 | MIT License 134 | 135 | Copyright (c) 2020 Ertuğrul Çetin 136 | 137 | Permission is hereby granted, free of charge, to any person obtaining a copy 138 | of this software and associated documentation files (the "Software"), to deal 139 | in the Software without restriction, including without limitation the rights 140 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 141 | copies of the Software, and to permit persons to whom the Software is 142 | furnished to do so, subject to the following conditions: 143 | 144 | The above copyright notice and this permission notice shall be included in all 145 | copies or substantial portions of the Software. 146 | 147 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 148 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 149 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 150 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 151 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 152 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 153 | SOFTWARE. 154 | ``` -------------------------------------------------------------------------------- /src/patika/core.clj: -------------------------------------------------------------------------------- 1 | (ns patika.core 2 | (:require [clojure.data.json :as json] 3 | [clojure.java.io :as io] 4 | [clojure.string :as str] 5 | [clojure.tools.logging :as log] 6 | [clojure.java.classpath :as classpath] 7 | [clojure.tools.namespace.find :as ns-find] 8 | [liberator.representation :as rep] 9 | [liberator.core :as liberator] 10 | [compojure.core :as compojure]) 11 | (:import (java.time ZoneId) 12 | (java.time.format DateTimeFormatter))) 13 | 14 | 15 | (def media-types 16 | {:text ["text/plain"] 17 | :json ["application/json" "application/json; charset=utf-8" "application/json; charset=UTF-8"] 18 | :html ["text/html" "text/html; charset=utf-8" "text/html; charset=UTF-8"] 19 | :xml ["text/xml" "text/xml; charset=utf-8" "text/xml; charset=UTF-8" "text/xml-external-parsed-entity"] 20 | :multipart ["application/octet-stream" "multipart/form-data" "multipart/mixed" "multipart/related"]}) 21 | 22 | 23 | (defn- datetime->zonedtimestr 24 | [datetime] 25 | (-> datetime 26 | (.atZone (ZoneId/systemDefault)) 27 | (.format (DateTimeFormatter/ISO_OFFSET_DATE_TIME)))) 28 | 29 | 30 | (extend-protocol rep/Representation 31 | clojure.lang.ExceptionInfo 32 | (as-response [this r] 33 | (let [m (Throwable->map this) 34 | result-map (select-keys m [:cause :data])] 35 | (assoc r :status 500 :body (json/write-str result-map))))) 36 | 37 | 38 | (extend-protocol 39 | json/JSONWriter 40 | 41 | java.util.UUID 42 | (-write [uuid* out] 43 | (json/-write (str uuid*) out)) 44 | 45 | java.time.LocalDateTime 46 | (-write [time* out] 47 | (json/-write (datetime->zonedtimestr time*) out))) 48 | 49 | 50 | (defn- body-as-string 51 | [ctx] 52 | (if-let [body (get-in ctx [:request :body])] 53 | (condp instance? body 54 | String body 55 | (slurp (io/reader body))))) 56 | 57 | 58 | (defn- check-content-type 59 | [ctx content-types] 60 | (if (#{:put :post} (get-in ctx [:request :request-method])) 61 | (or 62 | (some #{(get-in ctx [:request :headers "content-type"])} 63 | content-types) 64 | [false {:message "Unsupported Content-Type"}]) 65 | true)) 66 | 67 | 68 | (defn- parse-json 69 | [ctx key] 70 | (when (#{:put :post} (get-in ctx [:request :request-method])) 71 | (try 72 | (if-let [body (body-as-string ctx)] 73 | (let [data (json/read-str body)] 74 | [false {key data}]) 75 | {:message "No body"}) 76 | (catch Exception e 77 | (.printStackTrace e) 78 | {:message (format "IOException: %s" (.getMessage e))})))) 79 | 80 | 81 | (defn- get-exception-message 82 | [ctx] 83 | (let [ex (:exception ctx) 84 | msg (.getMessage ex)] 85 | (log/error ex) 86 | {:error msg})) 87 | 88 | 89 | (defn- authorized? 90 | [ctx] 91 | true) 92 | 93 | 94 | (defn- get-method-map 95 | [method] 96 | (if (= method :put) 97 | {:allowed-methods [:put] 98 | :new? false 99 | :respond-with-entity? true} 100 | {:allowed-methods [method]})) 101 | 102 | 103 | (defn- get-media-type-map 104 | [media-type] 105 | (case media-type 106 | :json {:available-media-types (:json media-types) 107 | :known-content-type? #(check-content-type % (:json media-types)) 108 | :malformed? #(parse-json % :request-data) 109 | :handle-exception #(get-exception-message %)} 110 | :text {:available-media-types (:text media-types) 111 | :handle-exception (fn [ctx] 112 | (let [ex (:exception ctx)] 113 | (log/error ex) 114 | "Something went wrong"))} 115 | :html {:available-media-types (:html media-types) 116 | :handle-exception (fn [ctx] 117 | (let [ex (:exception ctx)] 118 | (log/error ex) 119 | "Something went wrong"))} 120 | :xml {:available-media-types (:xml media-types) 121 | :handle-exception (fn [ctx] 122 | (let [ex (:exception ctx)] 123 | (log/error ex) 124 | "Something went wrong"))} 125 | :multipart {:available-media-types (:multipart media-types) 126 | :handle-exception (fn [ctx] 127 | (let [ex (:exception ctx) 128 | err-msg (.getMessage ex)] 129 | (log/error ex) 130 | err-msg))})) 131 | 132 | 133 | (defn- multi-params->map 134 | [params] 135 | (->> params 136 | (partition 2) 137 | (map vec) 138 | (into {}))) 139 | 140 | 141 | (defn- get-handle-ok-or-create-map 142 | [method media-type] 143 | (cond 144 | (and (= method :put) (= media-type :json)) 145 | {:handle-ok (fn [& args] {:success true})} 146 | 147 | (and (= method :post) (= media-type :json)) 148 | {:handle-created (fn [& args] {:success true})})) 149 | 150 | 151 | (defn- get-redirect-map-based-on-auth 152 | [m] 153 | (when-let [path (or (:redirect-auth m) (:redirect-not-auth m))] 154 | {:authorized? #(cond 155 | (and (:redirect-auth m) (authorized? %)) 156 | {:redirect-required? true 157 | :redirect-path (:redirect-auth m)} 158 | 159 | (and (:redirect-not-auth m) (not (authorized? %))) 160 | {:redirect-required? true 161 | :redirect-path (:redirect-not-auth m)} 162 | 163 | :else 164 | {:redirect-required? false}) 165 | :moved-temporarily? (fn [ctx] 166 | {:location (or (:redirect-path ctx) "/")})})) 167 | 168 | 169 | (defn- get-redirect-based-on-pred 170 | [m] 171 | (let [r (:redirect! m)] 172 | (if (fn? r) 173 | (let [result (atom nil) 174 | path (atom nil)] 175 | {:exists? (fn [ctx] 176 | (let [[result-i path-i] (r ctx)] 177 | (reset! result result-i) 178 | (reset! path path-i)) 179 | (not @result)) 180 | :existed? (fn [_] @result) 181 | :moved-temporarily? (fn [_] {:location (or @path "/")})}) 182 | (when-let [[result path] (:redirect! m)] 183 | {:exists? (fn [_] (not result)) 184 | :existed? (fn [_] result) 185 | :moved-temporarily? (fn [_] {:location (or path "/")})})))) 186 | 187 | 188 | (defn get-auth-and-redirect-maps 189 | [m] 190 | (let [auth-req (and (:auth-fn m) {:authorized? (:auth-fn m)}) 191 | redirect-auth (get-redirect-map-based-on-auth m) 192 | exit-maps {:exists? (fn [ctx] (not (:redirect-required? ctx))) 193 | :existed? (fn [ctx] (:redirect-required? ctx))} 194 | redirect (get-redirect-based-on-pred m)] 195 | (merge auth-req redirect-auth exit-maps redirect))) 196 | 197 | 198 | (defmacro resource 199 | [name method endpoint-and-binding _ media-type & opts] 200 | (let [resource-name (symbol (str "resource-" name))] 201 | `(compojure/defroutes ~(vary-meta resource-name assoc :resource? true) 202 | (~(case method 203 | :get `compojure/GET 204 | :post `compojure/POST 205 | :put `compojure/PUT 206 | :delete `compojure/DELETE) 207 | ~(first endpoint-and-binding) 208 | ~(if (seq (second endpoint-and-binding)) (second endpoint-and-binding) []) 209 | (let [method-map# ~(get-method-map method) 210 | type-map# ~(get-media-type-map media-type) 211 | m# ~(multi-params->map opts) 212 | handle-ok-maps# ~(get-handle-ok-or-create-map method media-type) 213 | auth-maps# (get-auth-and-redirect-maps m#) 214 | r# (merge method-map# type-map# handle-ok-maps# auth-maps# m#)] 215 | (liberator/resource r#)))))) 216 | 217 | 218 | (defn- find-ns-symbols 219 | [resource-ns-path] 220 | (for [ns-symb (ns-find/find-namespaces (classpath/system-classpath)) 221 | :when (str/starts-with? (name ns-symb) resource-ns-path)] 222 | ns-symb)) 223 | 224 | 225 | (defn- check-opts 226 | [opts] 227 | (cond 228 | (not (or (:resource-ns-path opts) 229 | (:resource-ns-vec opts))) 230 | (throw (Exception. ":resource-ns-path or :resource-ns-vec not defined! You need to define one of them.")) 231 | 232 | (and (not (:resource-ns-path opts)) (= [] (:resource-ns-vec opts))) 233 | (throw (Exception. ":resource-ns-vec is empty vector!")) 234 | 235 | (and (:not-found-route opts) (nil? (resolve (:not-found-route opts)))) 236 | (throw (Exception. "Could not resolve :not-found-route. Check your :not-found-route declaration.")))) 237 | 238 | 239 | (defn get-routes 240 | [opts] 241 | (check-opts opts) 242 | (let [ns-symbols (or (:resource-ns-vec opts) (find-ns-symbols (:resource-ns-path opts))) 243 | resource-vars (->> ns-symbols 244 | (map #(do (require %) %)) 245 | (reduce #(conj %1 (vals (ns-publics %2))) []) 246 | flatten 247 | (filter #(:resource? (meta %))) 248 | vec) 249 | all-routes (if-let [not-found-route (some-> (:not-found-route opts) resolve)] 250 | (conj resource-vars not-found-route) 251 | resource-vars)] 252 | (log/info (count all-routes) " routes found.") 253 | (apply compojure/routes all-routes))) --------------------------------------------------------------------------------