webapp.rest-webapp.venice Maven / Gradle / Ivy
Go to download
Show more of this group Show more artifacts with this name
Show all versions of venice Show documentation
Show all versions of venice Show documentation
Venice, a sandboxed Lisp implemented in Java.
;; -----------------------------------------------------------------------------
;; Demo REST Service
;; -----------------------------------------------------------------------------
;;
(load-module :tomcat ['tomcat :as 'tc])
(load-module :ring)
; ensure the Tomcat libs are on the classpath
(tc/check-required-libs)
;; -----------------------------------------------------------------------------
;; ID generator
;; -----------------------------------------------------------------------------
(def id-cnt (atom 999))
(defn gen-id [] (str (swap! id-cnt inc)))
;; -----------------------------------------------------------------------------
;; Employee database
;; -----------------------------------------------------------------------------
(def employees (atom [ { :id (gen-id) :name "susan" :role "secretary" }
{ :id (gen-id) :name "john" :role "assistant" }
{ :id (gen-id) :name "mary" :role "team-lead" } ]))
(defn find-employee-by-id [id]
(first (filter #(= id (:id %)) @employees)))
(defn query-employees-by-name [name-glob-pattern]
(let [regex (str/replace-all name-glob-pattern "*" ".*")]
(filter #(match? (:name %) regex) @employees)))
(defn delete-employee-by-id [id]
(swap! employees #(filter (fn [e] (not (= id (:id e)))) %)))
(defn add-employee [employee]
(let [id (coalesce (:id employee) (gen-id))
e (assoc (select-keys employee [:name :role]) :id id)]
(delete-employee-by-id id)
(swap! employees #(conj % e))
e))
;; -----------------------------------------------------------------------------
;; Ring handler
;; -----------------------------------------------------------------------------
(defn find-employees [request]
(let [query (ring-util/get-request-parameter request "name")
items (if query (query-employees-by-name query) @employees)]
{ :status 200
:headers { "Content-Type" "application/json; charset=utf-8" }
:body (json/write-str items) }))
(defn get-employee [request]
(let [id (-> request :parameters :id)
employee (find-employee-by-id id)]
(if employee
{ :status 200
:headers { "Content-Type" "application/json; charset=utf-8" }
:body (json/write-str employee) }
{ :status 404
:headers { "Content-Type" "text/plain; charset=utf-8" }
:body "Employee with the id ~{id} not found!" })))
(defn create-employee [request]
(let [json? (ring-util/json-request? request)
body (if json? (json/slurp (:body request) :key-fn keyword) nil)
employee (if body {:name (:name body), :role (:role body)} nil)]
(cond
(not json?) { :status 400
:headers { "Content-Type" "text/plain; charset=utf-8" }
:body "Not a json request!" }
:else { :status 200
:headers { "Content-Type" "application/json; charset=utf-8" }
:body (json/write-str (add-employee employee)) } )))
(defn update-employee [request]
(let [id (-> request :parameters :id)
employee (find-employee-by-id id)
json? (ring-util/json-request? request)
body (if json? (json/slurp (:body request) :key-fn keyword) nil)
employee* (if body {:id id, :name (:name body), :role (:role body)} nil)]
(cond
(not json?) { :status 400
:headers { "Content-Type" "text/plain; charset=utf-8" }
:body "Not a json request!" }
(nil? employee) { :status 404
:headers { "Content-Type" "text/plain; charset=utf-8" }
:body "Employee with the id ~{id} not found!" }
:else { :status 200
:headers { "Content-Type" "application/json; charset=utf-8" }
:body (json/write-str (add-employee employee*)) } )))
(defn delete-employee [request]
(let [id (-> request :parameters :id)
employee (find-employee-by-id id)
_ (when employee (delete-employee-by-id id))]
(if employee
{ :status 200
:headers { "Content-Type" "text/plain; charset=utf-8" }
:body "Employee with the id ~{id} deleted!" }
{ :status 404
:headers { "Content-Type" "text/plain; charset=utf-8" }
:body "Employee with the id ~{id} not found!" })))
;; -----------------------------------------------------------------------------
;; Middleware configuration
;; -----------------------------------------------------------------------------
(def routes [[:get "/employees" find-employees]
[:get "/employees/:id" get-employee]
[:post "/employees" create-employee]
[:put "/employees/:id" update-employee]
[:delete "/employees/:id" delete-employee]])
(defn rest-servlet []
(ring/create-servlet (-> (ring/match-routes routes) ; >--+
; |
(ring-mw/mw-dump-response) ; ^ |
(ring-mw/mw-dump-request) ; | |
(ring-mw/mw-request-counter) ; | |
(ring-mw/mw-add-session 3600) ; | |
(ring-mw/mw-print-uri) ; | |
(ring-mw/mw-debug :on)))) ; +--+
;; Tomcat server options
(def tomcat-opts { :await? false ;; do not block - return after start
:base-dir "."
:port 8080 })
;; start Tomcat (wires Tomcat with the ring servlets)
(let [server (tc/start [ [ (rest-servlet)
{ :name "rest-servlet"
:mapping ["/employees" "/employees/*"] } ] ]
tomcat-opts)]
(defn stop [] (tc/shutdown server)))
;; -----------------------------------------------------------------------------
(println "Tomcat started on port ~(:port tomcat-opts).")
(println "Stop it by calling: (stop)")
;; -----------------------------------------------------------------------------
;; Curl commands for testing
;;
;; curl -i -X GET http://localhost:8080/employees
;; curl -i -X GET http://localhost:8080/employees/1000
;; curl -i -X DELETE http://localhost:8080/employees/1000
;; curl -i -X POST -H 'Content-Type: application/json' -d '{"name": "hanna", "role": "secretary"}' http://localhost:8080/employees
;; curl -i -X PUT -H 'Content-Type: application/json' -d '{"id": "1001", "name": "john", "role": "clerk"}' http://localhost:8080/employees/1001
;; -----------------------------------------------------------------------------
;; -----------------------------------------------------------------------------
;; Venice HTTP Client examples
;; -----------------------------------------------------------------------------
;; GET (find all employees)
(comment
;; run this Http client in another REPL.
(do
(load-module :http-client-j8 ['http-client-j8 :as 'hc])
(let [res (hc/send :get
"http://localhost:8080/employees"
:headers { "Accept" "application/json, text/plain" }
:debug true)
status (:http-status res)
mimetype (:content-type-mimetype res)
charset (:content-type-charset res)]
(println "Status:" status)
(println (hc/slurp-response res :json-parse-mode :pretty-print))))
)
;; GET (query employees with name matching "*a*")
(comment
;; run this Http client in another REPL.
(do
(load-module :http-client-j8 ['http-client-j8 :as 'hc])
(let [res (hc/send :get
"http://localhost:8080/employees?name=*a*"
:headers { "Accept" "application/json, text/plain" }
:debug true)
status (:http-status res)
mimetype (:content-type-mimetype res)
charset (:content-type-charset res)]
(println "Status:" status)
(println (hc/slurp-response res :json-parse-mode :pretty-print))))
)
; GET (find employee by id)
(comment
;; run this Http client in another REPL.
(do
(load-module :http-client-j8 ['http-client-j8 :as 'hc])
(let [res (hc/send :get
"http://localhost:8080/employees/1001"
:headers { "Accept" "application/json, text/plain" }
:debug true)
status (:http-status res)
mimetype (:content-type-mimetype res)
charset (:content-type-charset res)]
(println "Status:" status)
(println (hc/slurp-response res :json-parse-mode :pretty-print))))
)
;; POST (create employee)
(comment
;; run this Http client in another REPL.
(do
(load-module :http-client-j8 ['http-client-j8 :as 'hc])
(let [res (hc/send :post
"http://localhost:8080/employees"
:headers {"Accept" "application/json, text/plain"
"Content-Type" "application/json"}
:body (json/write-str { "name" "hanna",
"role" "secretary" })
:debug true)
status (:http-status res)
mimetype (:content-type-mimetype res)
charset (:content-type-charset res)]
(println "Status:" status)
(println (hc/slurp-response res :json-parse-mode :pretty-print))))
)
;; PUT (update employee)
(comment
;; run this Http client in another REPL.
(do
(load-module :http-client-j8 ['http-client-j8 :as 'hc])
(let [res (hc/send :put
"http://localhost:8080/employees/1001"
:headers {"Accept" "application/json, text/plain"
"Content-Type" "application/json"}
:body (json/write-str { "id" "1001",
"name" "john",
"role" "clerk" })
:debug true)
status (:http-status res)
mimetype (:content-type-mimetype res)
charset (:content-type-charset res)]
(println "Status:" status)
(println (hc/slurp-response res :json-parse-mode :pretty-print))))
)
;; DELETE (delete employee)
(comment
;; run this Http client in another REPL.
(do
(load-module :http-client-j8 ['http-client-j8 :as 'hc])
(let [res (hc/send :delete
"http://localhost:8080/employees/1000"
:headers { "Accept" "text/plain" }
:debug true)
status (:http-status res)
mimetype (:content-type-mimetype res)
charset (:content-type-charset res)]
(println "Status:" status)
(println (hc/slurp-response res :json-parse-mode :pretty-print))))
)