application.clj

(ns layouts.application
  (:require [hiccup.page :as h]
            [hourglass.helpers :as misc]))

(defn layout [page]
  (h/html5
    misc/pretty-head
      (misc/pretty-body page)))

(defn home []
  (layout
    [:h1 "Home sweet home"]))

(def login-form
  (layout
    [:div {:class "row"}
      [:div {:class "columns small-12"}
        [:h3 "Login"]
        [:div {:class "row"}
        [:form {:method "POST" :action "login" :class "columns small-4"}
          [:div "Username" [:input {:type "text" :name "username"}]]
          [:div "Password" [:input {:type "password" :name "password"}]]
          [:div [:input {:type "submit" :class "button" :value "Login"}]]]]]]))

(defn signup-form [flash]
  (layout
    [:div {:class "row"}
      [:div {:class "columns small-12"}
        [:h1 "Sign up"]
        [:div {:class "row"}
          [:form {:method "POST" :action "signup" :class "columns small-4"}
            [:div "Username" [:input {:type "text" :name "username" :required "required"}]]
            [:div "Password" [:input {:type "password" :name "password" :required "required"}]]
            [:div "Confirm" [:input {:type "password" :name "confirm" :required "required"}]]
        [:div
          [:input {:type "submit" :class "button" :value "Sign up"}]
          [:span {:style "padding:0 0 0 10px;color:red;"} flash]]]]]]))

handler.clj

(ns hourglass.handler
  (:use compojure.core,
        layouts.application)
  (:require [compojure.handler :as handler]
            [compojure.route :as route]
            [ring.util.response :as resp]
            [cemerick.friend :as friend]
            (cemerick.friend [workflows :as workflows]
                             [credentials :as creds])
            [clojure.string :as str]
            [hourglass.helpers :as misc]))

(def users {"root" {:username "root"
                    :password (creds/hash-bcrypt "admin_password")
                    :roles #{::admin}}
            "jane" {:username "jane"
                    :password (creds/hash-bcrypt "user_password")
                    :roles #{::user}}})

(defn- create-user
  [{:keys [username password] :as user-data}]
  (assoc {} :username username
         :password (creds/hash-bcrypt password)
         :roles #{::user}))

(defroutes app-routes
  (GET "/" [] (home))
  (GET "/signup" req (signup-form (:flash req)))
  (POST "/signup" {{:keys [username password confirm] :as params} :params :as req}
    (if (and (not-any? str/blank? [username password confirm]) (= password confirm))
      (let [user (create-user (select-keys params [:username :password]))]
        (friend/merge-authentication (resp/redirect "/dashboard") user))
      (assoc (resp/redirect (str (:context req) "/signup")) :flash "password don't match")))
  (GET "/dashboard" req (friend/authenticated (str "Hello, ")))
  (GET "/login" req login-form)
  (GET "/users" req (str users))
  (friend/logout (POST "/logout" request (resp/redirect "/")))
  (route/resources "/")
  (route/not-found "Not Found"))

(def app
  (handler/site
    (friend/authenticate
      app-routes
      {:allow-anon? true
       :login-uri "/login"
       :default-landing-uri "/"
       :unauthorized-handler #(-> (str "You do not have sufficient privileges to access " (:uri %))
                                resp/response
                                (resp/status 401))
       :credential-fn #(creds/bcrypt-credential-fn users %)
       :workflows [(workflows/interactive-form)]})))

helpers.clj

(ns hourglass.helpers
  (:use [hiccup.page :only [include-css include-js]])
  (:require [clojure.string :as str])
  (:import java.net.URI))

(defn resolve-uri
  [context uri]
  (let [context (if (instance? URI context) context (URI. context))] 
    (.resolve context uri)))

(defn context-uri
  [{:keys [context]} uri]
  (if-let [base (and context (str context "/"))]
    (str (resolve-uri base uri)) uri))

(def pretty-head
  [:head (include-css "//cdn.jsdelivr.net/foundation/4.2.3/css/foundation.min.css")
         (include-css "//cdnjs.cloudflare.com/ajax/libs/normalize/2.1.0/normalize.css")
         [:style {:type "text/css"} "ul { padding-left: 2em }"]])

(defn pretty-body
  [& content]
  [:body {:class "row"}
   (into [:div {:class "columns small-12"}] content)])