Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
649 lines (594 sloc) 27.4 KB
(ns w3a.example.service
(:require [buddy.hashers :as hashers]
[clojure.java.jdbc :as jdbc]
[io.pedestal.log :as log]
[io.pedestal.http :as http]
[io.pedestal.http.route :as route]
[io.pedestal.http.body-params :as body-params]
[io.pedestal.http.ring-middlewares :as middlewares]
[io.pedestal.http.route.definition :refer [defroutes]]
[io.pedestal.interceptor :as interceptor]
[io.pedestal.impl.interceptor :as impl-interceptor]
[net.cgrand.enlive-html :as html]
[net.thegeez.w3a.binding :as binding]
[net.thegeez.w3a.edn-wrap :as edn-wrap]
[net.thegeez.w3a.form :as form]
[net.thegeez.w3a.interceptor :refer [combine] :as w3ainterceptor]
[net.thegeez.w3a.link :as link]
[net.thegeez.w3a.pagination :as pagination]))
(def application-frame (html/html-resource "templates/application.html"))
(def breadcrumbs-html (-> (html/html-resource "templates/breadcrumbs.html")
(html/select [:ul.breadcrumb])))
(defn breadcrumbs [breadcrumbs]
(html/at breadcrumbs-html
[:ul [:li html/first-of-type]] (html/clone-for [crumb breadcrumbs]
[:li :a] (html/content (:title crumb))
[:li :a] (html/set-attr :href (:link crumb)))
[:ul [:li html/last-of-type]] (html/set-attr :class "active")))
(defn login-box-html [context]
(if-let [auth (get-in context [:response :data :auth])]
(html/transform-content
[:a#name] (html/content (:name auth))
[:a#user] (html/set-attr :href (:url auth))
[:form#logout] (html/do->
(html/prepend
(html/html [:input {:type "hidden"
:name "__anti-forgery-token"
:value (get-in context [:request :io.pedestal.http.csrf/anti-forgery-token])}]))
(html/set-attr :action (str (:logout auth)
"?return-to=" (get context :self)))))
(html/transform-content
[:li]
(html/content (html/html [:a {:href (link/link context ::login :query-params {:return-to (link/self context)})}
"Login"])))))
(defn flash-html [context]
(if-let [msg (get-in context [:response :data :flash :message])]
(html/before
(html/html [:div {:id "flash"
:class "alert alert-info"} msg]))
identity))
(def with-html
(interceptor/interceptor
{:leave (fn [context]
(cond-> context
(edn-wrap/for-html? context)
(->
(assoc-in [:response :headers "Content-Type"] "text/html")
(update-in [:response :body]
(fn [body]
(apply str (html/emit*
(html/at application-frame
[:#login-box]
(login-box-html context)
[:#content]
(flash-html context)
[:#content]
(html/before (breadcrumbs (get-in context [:response :data :breadcrumbs])))
[:#content]
(if-let [pagination (get-in context [:response :data :snippets])]
(html/before (pagination/html pagination))
identity)
[:#content] (html/html-content
(edn-wrap/html-edn context))
[:#content] (html/append
(map html/html (edn-wrap/forms-edn context)))))))))))}))
(def with-login-html
(interceptor/interceptor
{:leave (fn [context]
(cond-> context
(edn-wrap/for-html? context)
(->
(assoc-in [:response :headers "Content-Type"] "text/html")
(update-in [:response :body]
(fn [body]
(apply str (html/emit*
(html/at application-frame
[:.navbar] nil
[:#content]
(flash-html context)
[:#content] (html/before
(html/html [:h1 "w3a example login"]))
[:#content] (html/append (html/html [:div "Login with amy/amy or bob/bob"]))
[:#content] (html/append
(map html/html (edn-wrap/forms-edn context)))))))))))}))
(def home
(interceptor/interceptor
{:leave (fn [context]
(combine context
{:response
{:status 200
:data {:breadcrumbs (get-in context [:response ::link/breadcrumbs])
:links {:signup (link/link context ::signup)
:login (link/link context ::login)
:users (link/link context ::users)
:snippets (link/link context ::snippets)}}}}))}))
(defn user-resource [context data]
(let [{:keys [id]} data]
(-> data
(dissoc :id)
(assoc :url (link/link context ::user :params {:id id}))
(update-in [:snippets] (fn [snippets]
(map #(link/link context ::snippet :params {:id (:id %)}) snippets))))))
(defn get-users [db]
(jdbc/query db ["SELECT id, name, created_at, updated_at FROM users"]))
(def users
(interceptor/interceptor
{:leave (fn [context]
(combine
context
{:response
{:status 200
:data {:flash (get-in context [:request :flash])
:breadcrumbs (get-in context [:response ::link/breadcrumbs])
:signup (link/link context ::signup)
:users (->> (get-users (:database context))
(map (partial user-resource context)))}}}))}))
(def signup-binding
{:user
[{:id :name
:label "Name"
:type :string
:validator (fn [{{{:keys [name]} :params} :request :as context}]
(when (not (seq name))
{:name ["Name can't be empty"]}
))}
{:id :password
:label "Password"
:type :password
:validator (fn [{{{:keys [password]} :params} :request :as context}]
(when (not (seq password))
{:password ["Password can't be empty"]}
))}
{:id :password-confirm
:label "Password (repeat)"
:type :password
:validator (fn [{{{:keys [password password-confirm]} :params} :request :as context}]
(when-not (= password password-confirm)
{:password ["Passwords don't match"]
:password-confirm ["Passwords don't match"]}))}]})
(def signup
(interceptor/interceptor
{:leave (fn [context]
(combine context
{:response
{:status 200
:data {:flash (get-in context [:request :flash])
:breadcrumbs (get-in context [:response ::link/breadcrumbs])}}}))}))
(def signup-post
(interceptor/interceptor
{:leave (fn [context]
(let [values (get-in context [:request :values])
user {:name (:name values)
:password_encrypted (hashers/encrypt (:password values))}
id-or-errors
(try
(let [res (jdbc/insert! (:database context)
:users
(merge user
(let [now (.getTime (java.util.Date.))]
{:created_at now
:updated_at now})))]
(when-not (= 1 (count res))
(throw (Exception.)))
(:id (first (jdbc/query (:database context) ["SELECT id FROM users WHERE name = ?" (:name user)]))))
(catch Exception _
;; assume name unique violation
{:errors {:name ["Name already exists"]}}
))]
(if-let [errors (:errors id-or-errors)]
(combine context
{:response
{:status 400
:data {:user {:values values
:errors errors}}}})
(combine context
{:response
{:status 201
:headers {"Location" (link/link context ::user :params {:id id-or-errors})}
:flash {:message "User created"}}}))))}))
(def login-binding
{:user
[{:id :name
:label "Name"
:type :string
:validator (fn [{{{:keys [name]} :params} :request :as context}]
(when (not (seq name))
{:name ["Name can't be empty"]}
))}
{:id :password
:label "Password"
:type :password
:validator (fn [{{{:keys [password]} :params} :request :as context}]
(when (not (seq password))
{:password ["Password can't be empty"]}
))}]})
(def login
(interceptor/interceptor
{:leave (fn [context]
(combine context
{:response
{:status 200
:data {:flash (get-in context [:request :flash])}}}))}))
(defn get-auth [db values]
(let [{:keys [name password]} values]
(when-let [user (first (jdbc/query db ["SELECT * FROM users WHERE name = ?" name]))]
(when (hashers/check password (:password_encrypted user))
(dissoc user :password_encrypted)))))
(def login-post
(interceptor/interceptor
{:leave (fn [context]
(let [values (get-in context [:request :values])]
(if-let [auth (get-auth (:database context) values)]
(combine context
{:response
{:status 303
:headers {"Location"
(or (get-in context [:request :query-params :return-to])
(link/link context ::user :params {:id (:id auth)}))}
:session {:auth {:id (:id auth)}}
:flash {:message "Login successful"}}})
(combine context
{:response
{:status 303
:headers {"Location" (get-in context [:self])}
:flash {:message "Login failed"}}}))))}))
(def logout-post
(interceptor/interceptor
{:leave (fn [context]
(combine context
{:response
{:status 303
:headers {"Location" (or (get-in context [:request :query-params :return-to])
(link/link context ::home))}
:session {}
:flash {:message "Logout successful"}}}))}))
(defn get-user [db id]
(when-let [user (first (jdbc/query db ["SELECT id, name, created_at, updated_at FROM users WHERE id = ?" id]))]
(assoc user :snippets (jdbc/query db ["SELECT id FROM snippets WHERE owner = ?" (:id user)]))))
(def with-user-auth
(interceptor/interceptor
{:enter (fn [context]
(if-let [user (when-let [id (get-in context [:request :session :auth :id])]
(get-user (:database context) id))]
(combine context {:auth user})
context))}))
(defn auth-resource [context]
(let [{:keys [id] :as auth} (:auth context)]
(-> auth
(assoc :url (link/link context ::user :params {:id id})
:logout (link/link context ::logout-post))
(dissoc :snippets))))
(def with-login-data
(interceptor/interceptor
{:enter (fn [context]
(cond-> context
(:auth context)
(combine
(let [user (auth-resource context)]
{:response {:data {:auth user}}}))))}))
(def with-user
(interceptor/interceptor
{:enter (fn [context]
(let [id (get-in context [:request :path-params :id])]
(if-let [user (get-user (:database context) id)]
(assoc context :user user)
(impl-interceptor/terminate
(combine context
{:response
{:status 404
:body "not found"}})))))}))
(def add-username-breadcrumb
(interceptor/interceptor
{:enter (fn [context]
(let [user (:user context)
title (str "User " (:name user) "'s Page")]
(link/add-breadcrumb context title ::user)))}))
(def user
(interceptor/interceptor
{:leave (fn [context]
(combine context
{:response
{:status 200
:data {:flash (get-in context [:request :flash])
:breadcrumbs (get-in context [:response ::link/breadcrumbs])
:user (user-resource context (get-in context [:user]))}}}))}))
(defn get-snippets [db pagination]
(let [{:keys [page limit]} pagination
offset (* (dec page) limit)]
{:results
(->> (jdbc/query db ["SELECT s.*, u.name FROM snippets s JOIN users u ON s.owner = u.id"])
;; derby doesn't do LIMIT :(
(drop offset)
(take limit))
:count (:count (first (jdbc/query db ["SELECT count(*) as count FROM snippets s"])))}))
(defn snippet-auth-is-owner [context snippet]
(let [id (:id (:auth context))
owner (:owner snippet)]
(and id owner (= id owner))))
(def snippet-auth-owner-only
(interceptor/interceptor
{:enter (fn [context]
(if (snippet-auth-is-owner context (:snippet context))
context
(impl-interceptor/terminate
(combine context
{:response {:status 401
:body "not allowed"}}))))}))
(defn snippet-resource [context data]
(let [{:keys [id]} data]
(-> data
(dissoc :id)
(assoc :url (link/link context ::snippet :params {:id id}))
(assoc :user (link/link context ::user :params {:id (:owner data)}))
(cond->
(snippet-auth-is-owner context data)
(assoc :edit (link/link context ::snippet#edit :params {:id id})
:delete (link/link context ::snippet#delete :params {:id id}))))))
(defmethod form/render-binding :suffix-text-box
[def value errors]
(-> (form/render-binding (dissoc def :widget) value errors)
(update-in [3] conj [:div.input-group-addon (:widget/suffix def)])))
(defmethod form/render-binding :multi-checkbox
[def value errors]
(let [{:keys [id label type]} def
field-name (or label (name id))]
[:div
{:class (str "form-group"
(when errors
" has-error"))}
[:label.control-label
{:for (name id)}
field-name]
[:div
(for [[key val] (:widget/options def)]
(let [id (str (name id) "[" (name key) "]")]
[:div.checkbox
[:label {:for id}
[:input
(cond->
{:type "checkbox"
:name id
:id id}
(boolean (get value key))
(assoc :checked "checked") )]
val]]))]
(when errors
[:div.errors
(for [error errors]
[:span.help-block error])])]))
(def snippet-binding
{:snippet
[{:id :title
:label "Title"
:type :string
:widget :suffix-text-box
:widget/suffix "suffix"
:validator (fn [{{{:keys [title]} :params} :request :as context}]
(when (not (seq title))
{:title ["Title can't be empty"]}
))}
{:id :quality
:label "Quality"
:widget :multi-checkbox
:widget/options {:good "Good"
:fast "Fast"
:cheap "Cheap"}
:validator (fn [{{{:keys [quality]} :params} :request :as context}]
(when (= 3 (count quality))
{:quality ["Sorry can only pick two"]}))}]})
(def snippets
(interceptor/interceptor
{:leave (fn [context]
(combine context
{:response
{:status 200
:data {:flash (get-in context [:request :flash])
:breadcrumbs (get-in context [:response ::link/breadcrumbs])
:new (link/link context ::snippet#new)
:pagination (pagination/pagination-params context)
:snippets (let [pagination (pagination/pagination-params context)
{:keys [results count]} (get-snippets (:database context) pagination)]
(merge
{:results (map (partial snippet-resource context) results)
:count count}
(pagination/links context ::snippets pagination count)))}}}))}))
(def parse-path-param-id
(interceptor/interceptor
{:enter (fn [context]
(update-in context [:request :path-params :id]
#(try (Long/parseLong %)
(catch Exception _ nil))))}))
(defn normalize-snippet-values [values]
(-> values
(assoc :quality_fast (boolean (get-in values [:quality :fast])))
(assoc :quality_good (boolean (get-in values [:quality :good])))
(assoc :quality_cheap (boolean (get-in values [:quality :cheap])))
(dissoc :quality)))
(defn get-snippet [db id]
(let [snippet (first (jdbc/query db ["SELECT s.*, u.name AS owner_name FROM snippets s JOIN users u ON s.owner = u.id WHERE s.id = ?" id]))]
(-> snippet
(cond->
(:quality_good snippet)
(update-in [:quality] assoc :good true)
(:quality_fast snippet)
(update-in [:quality] assoc :fast true)
(:quality_cheap snippet)
(update-in [:quality] assoc :cheap true))
(dissoc :quality_good :quality_fast :quality_cheap))))
(def with-snippet
(interceptor/interceptor
{:enter (fn [context]
(let [id (get-in context [:request :path-params :id])]
(if-let [snippet (get-snippet (:database context) id)]
(combine context {:snippet (snippet-resource context snippet)})
(impl-interceptor/terminate
(combine context
{:response {:status 404
:body "not found"}})))))}))
(def snippet
(interceptor/interceptor
{:leave (fn [context]
(combine context
{:response
{:status 200
:data {:flash (get-in context [:request :flash])
:breadcrumbs (get-in context [:response ::link/breadcrumbs])
:snippet (get-in context [:snippet])}}}))}))
(def require-auth
(interceptor/interceptor
{:enter (fn [context]
(if (:auth context)
context
(impl-interceptor/terminate
(combine context
{:response {:status 303
:headers {"Location" (link/link context ::login
:params {:return-to (get-in context [:self])})}
:flash {:message "Authentication required"}}}))))}))
(def snippet#new
(interceptor/interceptor
{:enter (fn [context]
(let [name (get-in context [:request :path-params :name])]
(combine context
{:response {:status 200
:data {:breadcrumbs (get-in context [:response ::link/breadcrumbs])
:self (get-in context [:self])}}})))}))
(def snippet#new-post
(interceptor/interceptor
{:leave (fn [context]
(let [values (get-in context [:request :values])
values (normalize-snippet-values values)
id-or-errors
(try
(let [res (jdbc/insert! (:database context)
:snippets
(merge values
(let [now (.getTime (java.util.Date.))]
{:created_at now
:updated_at now
:owner (:id (:auth context))})))]
(when-not (= 1 (count res))
(throw (Exception.)))
(:id (first (jdbc/query (:database context) ["SELECT id FROM snippets WHERE title = ?" (:title values)]))))
(catch Exception e
;; assume title unique violation
{:errors {:title ["Title already exists"]}}
))]
(if-let [errors (:errors id-or-errors)]
(combine context
{:response
{:status 400
:data {:snippet {:values values
:errors errors}}}})
(combine context
{:response
{:status 201
:headers {"Location" (link/link context ::snippet :params {:id id-or-errors})}
:flash {:message "Snippet created"}}}))))}))
(def snippet#edit-post
(interceptor/interceptor
{:leave (fn [context]
(let [id (get-in context [:request :path-params :id])
values (get-in context [:request :values])
values (normalize-snippet-values values)
res (try
(jdbc/update! (:database context)
:snippets
(merge values
{:updated_at (.getTime (java.util.Date.))})
["id = ?" id])
nil
(catch Exception _
;; assume title unique violation
{:errors {:title ["Title already exists"]}}
))]
(if-let [errors (:errors res)]
(combine context
{:response
{:status 400
:data {:snippet {:values values
:errors errors}}}})
(combine context
{:response
{:status 201
:headers {"Location" (link/link context ::snippet :params {:id id})}
:flash {:message "Snippet updated"}}}))))}))
(def snippet#delete-post
(interceptor/interceptor
{:leave (fn [context]
(let [id (get-in context [:request :path-params :id])
res (jdbc/delete! (:database context)
:snippets
["id = ?" id])]
(combine context
{:response
{:status 201
:headers {"Location" (link/link context ::snippets)}
:flash {:message "Snippet deleted"}}})))}))
;; (io.pedestal.http.route/print-routes routes)
(defroutes
routes
[[["/"
^:interceptors [edn-wrap/wrap-edn
with-html
with-user-auth
with-login-data
(link/breadcrumb "Root" ::home)]
{:get home}
["/signup"
^:interceptors [(link/breadcrumb "User Signup" ::signup)
(binding/with-binding signup-binding)]
{:get signup
:post signup-post}]
["/login"
^:interceptors [(link/breadcrumb "Login" ::login)
with-login-html
(binding/with-binding login-binding)]
{:get login
:post login-post}]
["/logout" {:post logout-post}]
["/users"
^:interceptors [(link/breadcrumb "Users" ::users)]
{:get [::users users]}
["/:id"
^:interceptors [parse-path-param-id
with-user
add-username-breadcrumb]
{:get user}]]
["/snippets"
^:interceptors [(link/breadcrumb "Snippet List" ::snippets)]
{:get snippets}
["/new"
^:interceptors [(link/breadcrumb "Snippet Create" ::snippet#new)
require-auth
(binding/with-binding snippet-binding)]
{:get [::snippet#new snippet#new]
:post [::snippet#new-post snippet#new-post]}]
["/:id"
^:interceptors [parse-path-param-id
(link/breadcrumb "Snippet Instance" ::snippet)
with-snippet]
{:get snippet}
["/edit"
^:interceptors [(link/breadcrumb "Snippet Edit" ::snippet#edit)
snippet-auth-owner-only
(binding/with-binding snippet-binding)]
{:get [::snippet#edit snippet]
:post [::snippet#edit-post snippet#edit-post]}]
["/delete"
^:interceptors [(link/breadcrumb "Snippet Delete" ::snippet#delete)
snippet-auth-owner-only
(binding/with-binding nil)]
{:get [::snippet#delete snippet]
:post [::snippet#delete-post snippet#delete-post]}]]]]]])
(def bootstrap-webjars-resource-path "META-INF/resources/webjars/bootstrap/3.3.4")
(def jquery-webjars-resource-path "META-INF/resources/webjars/jquery/1.11.1")
(def service
{:env :prod
::http/router :linear-search ;; we have snippets/new and snippets/:id
::http/routes routes
::http/resource-path "/public"
::http/default-interceptors [(middlewares/resource bootstrap-webjars-resource-path)
(middlewares/resource jquery-webjars-resource-path)]
::http/type :jetty
})