Skip to content
Browse files

Split libraries out into lib-noir.

  • Loading branch information...
1 parent 563c300 commit 2ea3e9964e34bb91b234c8b160509cc8c9a06479 @Raynes Raynes committed Jun 23, 2012
Showing with 13 additions and 488 deletions.
  1. +3 −4 project.clj
  2. +0 −72 src/noir/cookies.clj
  3. +0 −87 src/noir/response.clj
  4. +10 −2 src/noir/server/handler.clj
  5. +0 −114 src/noir/session.clj
  6. +0 −29 src/noir/util/crypt.clj
  7. +0 −122 src/noir/validation.clj
  8. +0 −58 test/noir/test/core.clj
View
7 project.clj
@@ -1,14 +1,13 @@
-(defproject noir "1.3.0-beta8"
+(defproject noir "1.3.0-beta9"
:description "Noir - a clojure web framework"
:url "http://webnoir.org"
:codox {:exclude [noir.exception noir.content.defaults
noir.content.getting-started]}
:dependencies [[org.clojure/clojure "1.3.0"]
+ [lib-noir "0.1.0"]
[compojure "1.0.4"]
[bultitude "0.1.5"]
- [cheshire "4.0.0"]
- [ring "1.1.0"]
+ [ring "1.1.1"]
[hiccup "1.0.0"]
[clj-stacktrace "0.2.4"]
- [org.mindrot/jbcrypt "0.3m"]
[org.clojure/tools.macro "0.1.1"]])
View
72 src/noir/cookies.clj
@@ -1,72 +0,0 @@
-(ns noir.cookies
- "Stateful access to cookie values"
- (:refer-clojure :exclude [get remove])
- (:require [noir.util.crypt :as crypt])
- (:use ring.middleware.cookies))
-
-(declare ^:dynamic *cur-cookies*)
-(declare ^:dynamic *new-cookies*)
-
-(defn put!
- "Add a new cookie whose name is k and has the value v. If v is a string
- a cookie map is created with :path '/'. To set custom attributes, such as
- \"expires\", provide a map as v. Stores all keys as strings."
- [k v]
- (let [props (if (map? v)
- v
- {:value v :path "/"})]
- (swap! *new-cookies* assoc (name k) props)))
-
-(defn get
- "Get the value of a cookie from the request. k can either be a string or keyword.
- If this is a signed cookie, use get-signed, otherwise the signature will not be
- checked."
- ([k] (get k nil))
- ([k default]
- (let [str-k (name k)]
- (if-let [v (or (get-in @*new-cookies* [str-k :value])
- (get-in *cur-cookies* [str-k :value]))]
- v
- default))))
-
-(defn signed-name [k]
- "Construct the name of the signing cookie using a simple suffix."
- (str (name k) "__s"))
-
-(defn put-signed!
- "Adds a new cookie whose name is k and has the value v. In addition,
- adds another cookie that checks the authenticity of 'v'. Sign-key
- should be a secret that's user-wide, session-wide or site wide (worst)."
- [sign-key k v]
- (let [actual-v (if (map? v) (:value v) v)]
- (put! k v)
- (put! (signed-name k)
- (let [signed-v (crypt/sha1-sign-hex sign-key actual-v)]
- (if (map? v) ;; If previous value was a map with other attributes,
- (assoc v :value signed-v) ;; Place the signed value in a similar map,
- signed-v))))) ;; Otherwise just signed value.
-
-(defn get-signed
- "Get the value of a cookie from the request using 'get'. Verifies that a signing
- cookie also exists. If not, returns default or nil. "
- ([sign-key k] (get-signed sign-key k nil))
- ([sign-key k default]
- (let [v (get k)
- stored-sig (get (signed-name k)) ]
- (if (or (nil? stored-sig) ;; If signature not available,
- (nil? v) ;; or value is not found,
- (not= (crypt/sha1-sign-hex sign-key v) stored-sig)) ;; or sig mismatch,
- default ;; return default.
- v)))) ;; otherwise return the value.
-
-(defn noir-cookies [handler]
- (fn [request]
- (binding [*cur-cookies* (:cookies request)
- *new-cookies* (atom {})]
- (when-let [final (handler request)]
- (assoc final :cookies (merge (:cookies final) @*new-cookies*))))))
-
-(defn wrap-noir-cookies [handler]
- (-> handler
- (noir-cookies)
- (wrap-cookies)))
View
87 src/noir/response.clj
@@ -1,87 +0,0 @@
-(ns noir.response
- "Simple response helpers to change the content type, redirect, or return a canned response"
- (:refer-clojure :exclude [empty])
- (:require [cheshire.core :as json]
- [noir.options :as options]))
-
-(defn- ->map [c]
- (if-not (map? c)
- {:body c}
- c))
-
-(defn set-headers
- "Add a map of headers to the given response. Headers must have
- string keys:
-
- (set-headers {\"x-csrf\" csrf}
- (common/layout [:p \"hey\"]))"
- [headers content]
- (update-in (->map content) [:headers] merge headers))
-
-(defn content-type
- "Wraps the response with the given content type and sets the body to the content."
- [ctype content]
- (set-headers {"Content-Type" ctype} content))
-
-(defn xml
- "Wraps the response with the content type for xml and sets the body to the content."
- [content]
- (content-type "text/xml; charset=utf-8" content))
-
-(defn json
- "Wraps the response in the json content type and generates JSON from the content"
- [content]
- (content-type "application/json; charset=utf-8"
- (json/generate-string content)))
-
-(defn jsonp
- "Generates JSON for the given content and creates a javascript response for calling
- func-name with it."
- [func-name content]
- (content-type "application/json; charset=utf-8"
- (str func-name "(" (json/generate-string content) ");")))
-
-(defn status
- "Wraps the content in the given status code"
- [code content]
- (assoc (->map content) :status code))
-
-(defn redirect
- "A header redirect to a different URI. If given one argument,
- returns a 302 Found redirect. If given two arguments, the
- second argument should be a keyword indicating which redirect
- status to use. Choices are:
-
- :permanent -- A 301 permanent redirect.
- :found -- A 302 found redirect (default).
- :see-other -- A 303 see other redirect.
- :not-modified -- A 304 not modified redirect.
- :proxy -- A 305 proxy redirect.
- :temporary -- A 307 temporary redirect.
-
- To see what these redirects are for in detail, visit
- http://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html#sec10.3"
- [url & [type]]
- {:status (case type
- :permanent 301
- :found 302
- :see-other 303
- :not-modified 304
- :proxy 305
- :temporary 307
- 302)
- :headers {"Location" (options/resolve-url url)}
- :body ""})
-
-(defn empty
- "Return a successful, but completely empty response"
- []
- {:status 200
- :body ""})
-
-(defn clojure
- "Wraps the response in the `application/clojure` content-type
- and calls pr-str on the Clojure data stuctures passed in."
- [data]
- (content-type "application/clojure; charset=utf-8"
- (pr-str data)))
View
12 src/noir/server/handler.clj
@@ -2,7 +2,8 @@
"Handler generation functions used by noir.server and other ring handler libraries."
(:use [compojure.core :only [routes ANY]]
ring.middleware.reload
- ring.middleware.flash)
+ ring.middleware.flash
+ ring.middleware.session.memory)
(:import java.net.URLDecoder)
(:require [compojure.route :as c-route]
[hiccup.middleware :as hiccup]
@@ -99,14 +100,21 @@
[func & args]
(swap! middleware conj [func args]))
+(defn ^:private assoc-if [m k v]
+ (if (not (nil? v))
+ (assoc m k v)
+ m))
+
(defn wrap-noir-middleware
"Wrap a base handler in all of noir's middleware"
[handler opts]
(binding [options/*options* (options/compile-options opts)]
(-> handler
(hiccup/wrap-base-url (options/get :base-url))
(session/wrap-noir-flash)
- (session/wrap-noir-session)
+ (session/wrap-noir-session
+ (assoc-if {:store (options/get :session-store (memory-store session/mem))}
+ :cookie-attrs (options/get :session-cookie-attrs)))
(cookie/wrap-noir-cookies)
(validation/wrap-noir-validation)
(statuses/wrap-status-pages)
View
114 src/noir/session.clj
@@ -1,114 +0,0 @@
-(ns noir.session
- "Stateful session handling functions. Uses a memory-store by
- default, but can use a custom store by supplying a :session-store
- option to server/start."
- (:refer-clojure :exclude [get remove swap!])
- (:use ring.middleware.session
- ring.middleware.session.memory
- ring.middleware.flash)
- (:require [noir.options :as options]))
-
-;; ## Session
-
-(declare ^:dynamic *noir-session*)
-(defonce mem (atom {}))
-
-(defn put!
- "Associates the key with the given value in the session"
- [k v]
- (clojure.core/swap! *noir-session* assoc k v))
-
-(defn get
- "Get the key's value from the session, returns nil if it doesn't exist."
- ([k] (get k nil))
- ([k default]
- (clojure.core/get @*noir-session* k default)))
-
-(defn swap!
- "Replace the current session's value with the result of executing f with
- the current value and args."
- [f & args]
- (apply clojure.core/swap! *noir-session* f args))
-
-(defn clear!
- "Remove all data from the session and start over cleanly."
- []
- (reset! *noir-session* {}))
-
-(defn remove!
- "Remove a key from the session"
- [k]
- (clojure.core/swap! *noir-session* dissoc k))
-
-(defn get!
- "Destructive get from the session. This returns the current value of the key
- and then removes it from the session."
- ([k] (get! k nil))
- ([k default]
- (let [cur (get k default)]
- (remove! k)
- cur)))
-
-(defn noir-session [handler]
- "Store noir session keys in a :noir map, because other middleware that
- expects pure functions may delete keys, and simply merging won't work.
- Ring takes (not (contains? response :session) to mean: don't update session.
- Ring takes (nil? (:session resonse) to mean: delete the session.
- Because noir-session mutates :session, it needs to duplicate ring/wrap-session
- functionality to handle these cases."
- (fn [request]
- (binding [*noir-session* (atom (get-in request [:session :noir] {}))]
- (remove! :_flash)
- (when-let [resp (handler request)]
- (if (= (get-in request [:session :noir] {}) @*noir-session*)
- resp
- (if (contains? resp :session)
- (if (nil? (:session resp))
- resp
- (assoc-in resp [:session :noir] @*noir-session*))
- (assoc resp :session (assoc (:session request) :noir @*noir-session*))))))))
-
-
-(defn assoc-if [m k v]
- (if (not (nil? v))
- (assoc m k v)
- m))
-
-(defn wrap-noir-session [handler]
- (-> handler
- (noir-session)
- (wrap-session
- (assoc-if {:store (options/get :session-store (memory-store mem))}
- :cookie-attrs (options/get :session-cookie-attrs)))))
-
-;; ## Flash
-
-(declare ^:dynamic *noir-flash*)
-
-(defn flash-put!
- "Store a value that will persist for this request and the next."
- [k v]
- (clojure.core/swap! *noir-flash* assoc-in [:outgoing k] v))
-
-(defn flash-get
- "Retrieve the flash stored value."
- ([k]
- (flash-get k nil))
- ([k not-found]
- (let [in (get-in @*noir-flash* [:incoming k])
- out (get-in @*noir-flash* [:outgoing k])]
- (or out in not-found))))
-
-(defn noir-flash [handler]
- (fn [request]
- (binding [*noir-flash* (atom {:incoming (:flash request)})]
- (let [resp (handler request)
- outgoing-flash (:outgoing @*noir-flash*)]
- (if (and resp outgoing-flash)
- (assoc resp :flash outgoing-flash)
- resp)))))
-
-(defn wrap-noir-flash [handler]
- (-> handler
- (noir-flash)
- (wrap-flash)))
View
29 src/noir/util/crypt.clj
@@ -1,29 +0,0 @@
-
-(ns noir.util.crypt
- "Simple functions for hashing strings and comparing them. Typically used for storing passwords."
- (:refer-clojure :exclude [compare])
- (:import [org.mindrot.jbcrypt BCrypt]))
-
-(defn gen-salt
- ([size]
- (BCrypt/gensalt size))
- ([]
- (BCrypt/gensalt)))
-
-(defn encrypt
- "Encrypt the given string with a generated or supplied salt. Uses BCrypt for strong hashing."
- ;; generate a salt
- ([salt raw] (BCrypt/hashpw raw salt))
- ([raw] (encrypt (gen-salt) raw)))
-
-(defn compare
- "Compare a raw string with an already encrypted string"
- [raw encrypted]
- (BCrypt/checkpw raw encrypted))
-
-(defn sha1-sign-hex [sign-key v]
- "Using a signing key, compute the sha1 hmac of v and convert to hex."
- (let [mac (javax.crypto.Mac/getInstance "HmacSHA1")
- secret (javax.crypto.spec.SecretKeySpec. (.getBytes sign-key), "HmacSHA1")]
- (.init mac secret)
- (apply str (map (partial format "%02x") (.doFinal mac (.getBytes v))))))
View
122 src/noir/validation.clj
@@ -1,122 +0,0 @@
-(ns noir.validation
- "Functions for validating input and setting string errors on fields.
- All fields are simply keys, meaning this can be a general error storage and
- retrieval mechanism for the lifetime of a single request. Errors are not
- persisted and are cleaned out at the end of the request.")
-
-;; validation helpers
-
-(defn has-value?
- "Returns true if v is truthy and not an empty string."
- [v]
- (and v (not= v "")))
-
-(defn has-values?
- "Returns true if all members of the collection has-value? This works on maps as well."
- [coll]
- (let [vs (if (map? coll)
- (vals coll)
- coll)]
- (every? has-value? vs)))
-
-(defn not-nil?
- "Returns true if v is not nil"
- [v]
- (or v (false? v)))
-
-(defn min-length?
- "Returns true if v is greater than or equal to the given len"
- [v len]
- (>= (count v) len))
-
-(defn max-length?
- "Returns true if v is less than or equal to the given len"
- [v len]
- (<= (count v) len))
-
-(defn is-email?
- "Returns true if v is an email address"
- [v]
- (re-matches #"(?i)[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?" v))
-
-
-(defn valid-file?
- "Returns true if a valid file was supplied"
- [m]
- (and (:size m)
- (> (:size m) 0)
- (:filename m)))
-
-
-(defn valid-number?
- "Returns true if the string can be cast to a Long"
- [v]
- (try
- (Long/parseLong v)
- true
- (catch Exception e
- false)))
-
-
-(defn greater-than?
- "Returns true if the string represents a number > given."
- [v n]
- (and (valid-number? v)
- (> (Long/parseLong v) n)))
-
-
-(defn less-than?
- "Returns true if the string represents a number < given."
- [v n]
- (and (valid-number? v)
- (> (Long/parseLong v) n)))
-
-(declare ^:dynamic *errors*)
-
-;;errors and rules
-(defn get-errors
- "Get the errors for the given field. This will return a vector of all error strings or nil."
- [& [field]]
- (if field
- (get @*errors* field)
- (apply concat (vals @*errors*))))
-
-(defn set-error
- "Explicitly set an error for the given field. This can be used to
- create complex error cases, such as in a multi-step login process."
- [field error]
- (let [merge-map (if (get-errors field)
- {field error}
- {field [error]})]
- (swap! *errors* #(merge-with conj % merge-map))
- nil))
-
-(defn rule
- "If the passed? condition is not met, add the error text to the given field:
- (rule (not-nil? username) [:username \"Usernames must have a value.\"])"
- [passed? [field error]]
- (or passed?
- (do
- (set-error field error)
- false)))
-
-(defn errors?
- "For all fields given return true if any field contains errors. If none of the fields
- contain errors, return false. If no fields are supplied return true if any errors exist."
- [& field]
- (if-not (seq field)
- (not (empty? @*errors*))
- (some not-nil? (map get-errors field))))
-
-(defn on-error
- "If the given field has an error, execute func and return its value"
- [field func]
- (if-let [errs (get-errors field)]
- (func errs)))
-
-;;middleware
-
-(defn wrap-noir-validation [handler]
- (fn [request]
- (binding [*errors* (atom {})]
- (handler request))))
View
58 test/noir/test/core.clj
@@ -305,61 +305,3 @@
(is (= "woo" (session/get :noir3)))
(is (nil? (session/get :noir4)))
(is (= "noir" (session/get :noir4 "noir")))))
-
-;;; regresssion tests, assure noir-session works with middleware like friend
-;;; which expects ring requests/responses to be pure functions
-
-(deftest noir-session
- (let [base-map {:uri "/foo" :request-method :get }]
- ;; put session value in
- (is (= "bar" (get-in ((session/noir-session
- #(assoc-in % [:session :foo] "bar"))
- base-map)
- [:session :foo])))
- (let [base-map (assoc base-map :session {:foo "bar"})]
- ;; pass session value through
- (is (= "bar" (get-in ((session/noir-session identity)
- base-map)
- [:session :foo])))
- ;; change session value
- (is (= "baz" (get-in ((session/noir-session
- #(assoc-in % [:session :foo] "baz"))
- base-map)
- [:session :foo])))
- ;; dissoc session value
- (is (not (contains? (:session
- ((session/noir-session
- #(assoc % :session (dissoc (:session %) :foo)))
- base-map))
- :foo))))
- ;; dissocing one key doesn't affect any others
- (let [base-map (assoc base-map :session {:foo "bar" :quuz "auugh"})
- part-dissoc (:session
- ((session/noir-session
- #(assoc % :session (dissoc (:session %) :foo)))
- base-map))]
- (is (not (contains? part-dissoc :foo)))
- (is (= "auugh" (:quuz part-dissoc)))
- ;; changing one key doesn't affect any others
- (let [part-change (:session
- ((session/noir-session
- #(assoc-in % [:session :foo] "baz"))
- base-map))]
- (is (= "baz" (:foo part-change)))
- (is (= "auugh" (:quuz part-change)))))
- ;; delete whole session.
- ;; ring takes nil to mean delete session, so it must get passed through
- (is (nil? (:session ((session/noir-session
- #(assoc % :session nil))
- base-map))))
- ;; make sure the whole session goes away and stays away if deleted
- (is (not (contains? ((session/noir-session
- #(dissoc % :session))
- base-map)
- :session)))))
-
-
-
-
-
-

0 comments on commit 2ea3e99

Please sign in to comment.
Something went wrong with that request. Please try again.