Skip to content

Instantly share code, notes, and snippets.

@greywolve
Created July 23, 2018 07:16
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save greywolve/6cbb0daa7a36fb14576b7a714c4274c9 to your computer and use it in GitHub Desktop.
Save greywolve/6cbb0daa7a36fb14576b7a714c4274c9 to your computer and use it in GitHub Desktop.
Apache Shiro style permissions in Clojure
(require '[clojure.set :as set])
(require '[clojure.string :as string])
(def wildcard :*)
(defn permission-string->permission [perm-str]
(->> (string/split perm-str #":")
(mapv (fn [s]
(->> (string/split s #",")
(map keyword)
set)))))
;; a user permission implies a resource permission if it is a superset or, or exactly equal to
;; the resource permission. This was ported from Shiro's WildcardPermission
(defn implies [user-perm resource-perm]
(let [user-perm (if (string? user-perm)
(permission-string->permission user-perm)
user-perm)
resource-perm (if (string? resource-perm)
(permission-string->permission resource-perm)
resource-perm)
resource-perm-count (count resource-perm)
user-perm-count (count user-perm)]
(loop [i 0]
(cond
(> i (dec user-perm-count)) true
(> i (dec resource-perm-count)) (let [user-parts (nth user-perm i)]
(if (not (contains? user-parts wildcard))
false
(recur (inc i))))
:else
(let [resource-parts (nth resource-perm i)
user-parts (nth user-perm i)]
(if (and (not (contains? user-parts wildcard))
(not (set/subset? resource-parts user-parts)))
false
(recur (inc i))))))))
(comment
(implies "lead:transition,edit" "lead:edit") ;; true
(implies "lead:transition,edit" "lead") ;; false, must be a superset
(implies "lead" "lead:edit") ;; true, any lead action
(implies "lead:transition:*" "lead:transition:assign-to-sales") ;; true
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment