Auth against github in noir app

github_auth.clj

;; [oauthentic "0.0.6"]
;; [clj-http "0.5.0"]

(ns octocloud.web.github-auth
  (use lstoll.utils
       oauthentic.ring
       [noir.core :only [defpage custom-handler pre-route]]
       [noir.response :only [redirect]])
  (require [clj-http.client :as http]
           [noir.session :as s]
           [clojure.string :as str]))

(defn github-api-json-get
  "Makes a request to the github API with an oauth token"
  [uri token]
  (:body (http/get (str "https://api.github.com/" uri)
                   {:as :json
                    :accept :json
                    :oauth-token token})))

(defn member-of-group?
  "Checks if the user is a member of the given 'group' on github (org|team)"
  [username grouptype groupname token]
  (let [target (str grouptype "s")]
    (try
      (some #(= (:login %) username)
            (github-api-json-get (str target "/" groupname "/members") token))
      (catch slingshot.ExceptionInfo e
        (let [statuscode (:status (:object (.getData e)))]
          (if (or (>= statuscode 400)
                  (<  statuscode 500))
            nil
            (throw e)))))))

(defn member-of-groups?
  "Checks if the user is a member of any of the passed in groups, by type"
  [username grouptype groupnames token]
  (some #{true}
        (map #(member-of-group? username grouptype % token)
             groupnames)))

(defn github-error-handler
  [req] (redirect "/"))

(defn login-handler
  [req] (assoc (redirect "/") :session {:oauthentic-token (req :oauthentic-token)}))

(defn entry-in-env
  "Checks if the give entry exists in a comma-separated environment variable"
  [entry, var]
  (some #{entry} (str/split (env var "") #",")))

(defn oauth-token-valid?
  [username, token]
  (try
    (github-api-json-get "user" token)
    (catch slingshot.ExceptionInfo e
      (let [statuscode (:status (:object (.getData e)))]
        (if (or (>= statuscode 400)
                (<  statuscode 500))
          nil
          (throw e))))))


(defn github-login-handler [req]
  (let [ _ (prn req)
        token (:access-token (:oauthentic-token req))
        user (github-api-json-get "user" token)
        login (:login user)]
    (if  (or (entry-in-env login "PERMITTED_USERS")
             (member-of-groups? login "org" (str/split (env "PERMITTED_ORGS" "") #",") token)
             ;; (member-of-groups? login "team" (str/split (env "PERMITTED_TEAMS" "") #",") token)
             )
      (do
        (s/put! :user user)
        (redirect "/" ))
      (redirect "/auth/denied" )))) ; not permitted

;; TODO - Upstream
(defn monkeypatched-oauthentic-handler
  "Handles x-forwarded-proto headers"
  [login-handler error-handler service-params]
  (fn [req]
    (let [scheme (if (get (:headers req) "x-forwarded-proto")
                   (get (:headers req) "x-forwarded-proto")
                   (:scheme req))
          port (if (= scheme "https")
                 443 ; Makes assumtions
                 (:server-port req))]
      ((oauthentic.ring/oauthentic-handler login-handler error-handler service-params)
       (assoc req :scheme scheme
                  :server-port port)))))

(def github-auth-handler
  (monkeypatched-oauthentic-handler
   github-login-handler
   github-error-handler
   {:authorization-url "https://github.com/login/oauth/authorize"
    :token-url "https://github.com/login/oauth/access_token"
    :client-id (env "OAUTH_CLIENT_ID")
    :client-secret (env "OAUTH_CLIENT_SECRET") }))

(defpage "/auth/logout" []
  (do
    (s/remove! :user)
    "<h1>Logged out</h1>"))

(defpage "/auth/denied" []
  "<h1>Your account does not grant you access to this service</h1><img src=\"http://f.cl.ly/items/1a2i1k2W1p472u0y1Z1I/cat-noway.gif\">")

(custom-handler "/auth/github" {:as req} (github-auth-handler req))

(pre-route "/*" req
           (if (and (= (get (:headers req) "x-forwarded-proto") "http")
                    (env "FORCE_SSL"))
             (redirect (str "https://" (:server-name req) (:uri req)))
             (let [uri (:uri req)]
               (when-not
                   (or (s/get :user)
                       (.startsWith uri "/auth")
                       (.startsWith uri "/css")
                       (.startsWith uri "/js")
                       (.startsWith uri "/img")
                       (.startsWith uri "/api"))
                 (redirect "/auth/github")))))