mirror of
https://github.com/penpot/penpot.git
synced 2025-08-04 11:38:19 +02:00
♻️ Refactor email validations & tokens service.
This commit is contained in:
parent
dda6a96407
commit
7d9fdc34be
20 changed files with 369 additions and 398 deletions
|
@ -25,6 +25,7 @@
|
|||
:database-uri "postgresql://127.0.0.1/uxbox"
|
||||
:database-username "uxbox"
|
||||
:database-password "uxbox"
|
||||
:secret-key "default"
|
||||
|
||||
:media-directory "resources/public/media"
|
||||
:assets-directory "resources/public/static"
|
||||
|
@ -77,6 +78,7 @@
|
|||
(s/def ::assets-directory ::us/string)
|
||||
(s/def ::media-uri ::us/string)
|
||||
(s/def ::media-directory ::us/string)
|
||||
(s/def ::secret-key ::us/string)
|
||||
(s/def ::sendmail-backend ::us/string)
|
||||
(s/def ::sendmail-backend-apikey ::us/string)
|
||||
(s/def ::sendmail-reply-to ::us/email)
|
||||
|
@ -133,6 +135,7 @@
|
|||
::assets-uri
|
||||
::media-directory
|
||||
::media-uri
|
||||
::secret-key
|
||||
::sendmail-reply-to
|
||||
::sendmail-from
|
||||
::sendmail-backend
|
||||
|
|
|
@ -9,24 +9,23 @@
|
|||
|
||||
(ns app.http.auth.gitlab
|
||||
(:require
|
||||
[clojure.data.json :as json]
|
||||
[clojure.tools.logging :as log]
|
||||
[lambdaisland.uri :as uri]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.config :as cfg]
|
||||
[app.db :as db]
|
||||
[app.services.tokens :as tokens]
|
||||
[app.services.mutations :as sm]
|
||||
[app.http.session :as session]
|
||||
[app.util.http :as http]))
|
||||
[app.services.mutations :as sm]
|
||||
[app.services.tokens :as tokens]
|
||||
[app.util.http :as http]
|
||||
[app.util.time :as dt]
|
||||
[clojure.data.json :as json]
|
||||
[clojure.tools.logging :as log]
|
||||
[lambdaisland.uri :as uri]))
|
||||
|
||||
|
||||
(def default-base-gitlab-uri "https://gitlab.com")
|
||||
|
||||
|
||||
(def scope "read_user")
|
||||
|
||||
|
||||
(defn- build-redirect-url
|
||||
[]
|
||||
(let [public (uri/uri (:public-uri cfg/config))]
|
||||
|
@ -100,10 +99,12 @@
|
|||
(log/error "unexpected error on parsing response body from gitlab access token request" e)
|
||||
nil))))
|
||||
|
||||
|
||||
(defn auth
|
||||
[req]
|
||||
(let [token (tokens/create! db/pool {:type :gitlab-oauth})
|
||||
(let [token (tokens/generate
|
||||
{:iss :gitlab-oauth
|
||||
:exp (dt/in-future "15m")})
|
||||
|
||||
params {:client_id (:gitlab-client-id cfg/config)
|
||||
:redirect_uri (build-redirect-url)
|
||||
:response_type "code"
|
||||
|
@ -115,31 +116,27 @@
|
|||
{:status 200
|
||||
:body {:redirect-uri (str uri)}}))
|
||||
|
||||
|
||||
(defn callback
|
||||
[req]
|
||||
(let [token (get-in req [:params :state])
|
||||
tdata (tokens/retrieve db/pool token)
|
||||
tdata (tokens/verify token {:iss :gitlab-oauth})
|
||||
info (some-> (get-in req [:params :code])
|
||||
(get-access-token)
|
||||
(get-user-info))]
|
||||
|
||||
(when (not= :gitlab-oauth (:type tdata))
|
||||
(ex/raise :type :validation
|
||||
:code ::tokens/invalid-token))
|
||||
|
||||
(when-not info
|
||||
(ex/raise :type :authentication
|
||||
:code ::unable-to-authenticate-with-gitlab))
|
||||
:code :unable-to-authenticate-with-gitlab))
|
||||
|
||||
(let [profile (sm/handle {::sm/type :login-or-register
|
||||
:email (:email info)
|
||||
:fullname (:fullname info)})
|
||||
uagent (get-in req [:headers "user-agent"])
|
||||
|
||||
tdata {:type :authentication
|
||||
:profile profile}
|
||||
token (tokens/create! db/pool tdata {:valid {:minutes 10}})
|
||||
token (tokens/generate
|
||||
{:iss :auth
|
||||
:exp (dt/in-future "15m")
|
||||
:profile-id (:id profile)})
|
||||
|
||||
uri (-> (uri/uri (:public-uri cfg/config))
|
||||
(assoc :path "/#/auth/verify-token")
|
||||
|
|
|
@ -9,16 +9,17 @@
|
|||
|
||||
(ns app.http.auth.google
|
||||
(:require
|
||||
[clojure.data.json :as json]
|
||||
[clojure.tools.logging :as log]
|
||||
[lambdaisland.uri :as uri]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.config :as cfg]
|
||||
[app.db :as db]
|
||||
[app.services.tokens :as tokens]
|
||||
[app.services.mutations :as sm]
|
||||
[app.http.session :as session]
|
||||
[app.util.http :as http]))
|
||||
[app.services.mutations :as sm]
|
||||
[app.services.tokens :as tokens]
|
||||
[app.util.http :as http]
|
||||
[app.util.time :as dt]
|
||||
[clojure.data.json :as json]
|
||||
[clojure.tools.logging :as log]
|
||||
[lambdaisland.uri :as uri]))
|
||||
|
||||
(def base-goauth-uri "https://accounts.google.com/o/oauth2/v2/auth")
|
||||
|
||||
|
@ -84,7 +85,8 @@
|
|||
|
||||
(defn auth
|
||||
[req]
|
||||
(let [token (tokens/create! db/pool {:type :google-oauth})
|
||||
(let [token (tokens/generate {:iss :google-oauth
|
||||
:exp (dt/in-future "15m")})
|
||||
params {:scope scope
|
||||
:access_type "offline"
|
||||
:include_granted_scopes true
|
||||
|
@ -102,28 +104,24 @@
|
|||
(defn callback
|
||||
[req]
|
||||
(let [token (get-in req [:params :state])
|
||||
tdata (tokens/retrieve db/pool token)
|
||||
tdata (tokens/verify token {:iss :google-oauth})
|
||||
info (some-> (get-in req [:params :code])
|
||||
(get-access-token)
|
||||
(get-user-info))]
|
||||
|
||||
(when (not= :google-oauth (:type tdata))
|
||||
(ex/raise :type :validation
|
||||
:code ::tokens/invalid-token))
|
||||
|
||||
(when-not info
|
||||
(ex/raise :type :authentication
|
||||
:code ::unable-to-authenticate-with-google))
|
||||
:code :unable-to-authenticate-with-google))
|
||||
|
||||
(let [profile (sm/handle {::sm/type :login-or-register
|
||||
:email (:email info)
|
||||
:fullname (:fullname info)})
|
||||
uagent (get-in req [:headers "user-agent"])
|
||||
|
||||
tdata {:type :authentication
|
||||
:profile profile}
|
||||
token (tokens/create! db/pool tdata {:valid {:minutes 10}})
|
||||
|
||||
token (tokens/generate
|
||||
{:iss :auth
|
||||
:exp (dt/in-future "15m")
|
||||
:profile-id (:id profile)})
|
||||
uri (-> (uri/uri (:public-uri cfg/config))
|
||||
(assoc :path "/#/auth/verify-token")
|
||||
(assoc :query (uri/map->query-string {:token token})))
|
||||
|
@ -133,4 +131,3 @@
|
|||
:headers {"location" (str uri)}
|
||||
:cookies (session/cookies sid)
|
||||
:body ""})))
|
||||
|
||||
|
|
|
@ -51,7 +51,7 @@
|
|||
(first))]
|
||||
(when-not (client/bind? conn (:dn user-entry) password)
|
||||
(ex/raise :type :authentication
|
||||
:code ::wrong-credentials))
|
||||
:code :wrong-credentials))
|
||||
(set/rename-keys user-entry {(keyword (:ldap-auth-avatar-attribute cfg/config)) :photo
|
||||
(keyword (:ldap-auth-fullname-attribute cfg/config)) :fullname
|
||||
(keyword (:ldap-auth-email-attribute cfg/config)) :email})))))
|
||||
|
|
|
@ -10,7 +10,14 @@
|
|||
(ns app.http.session
|
||||
(:require
|
||||
[app.db :as db]
|
||||
[app.services.tokens :as tokens]))
|
||||
[buddy.core.codecs :as bc]
|
||||
[buddy.core.nonce :as bn]))
|
||||
|
||||
(defn next-token
|
||||
[n]
|
||||
(-> (bn/random-nonce n)
|
||||
(bc/bytes->b64u)
|
||||
(bc/bytes->str)))
|
||||
|
||||
(defn extract-auth-token
|
||||
[request]
|
||||
|
@ -29,7 +36,7 @@
|
|||
|
||||
(defn create
|
||||
[profile-id user-agent]
|
||||
(let [id (tokens/next-token)]
|
||||
(let [id (next-token 64)]
|
||||
(db/insert! db/pool :http-session {:id id
|
||||
:profile-id profile-id
|
||||
:user-agent user-agent})
|
||||
|
|
|
@ -86,6 +86,13 @@
|
|||
|
||||
{:name "0023-adapt-old-pages-and-files"
|
||||
:fn mg0023/migrate}
|
||||
|
||||
{:name "0024-mod-profile-table"
|
||||
:fn (mg/resource "app/migrations/sql/0024-mod-profile-table.sql")}
|
||||
|
||||
{:name "0025-del-generic-tokens-table"
|
||||
:fn (mg/resource "app/migrations/sql/0025-del-generic-tokens-table.sql")}
|
||||
|
||||
]})
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
@ -0,0 +1,5 @@
|
|||
ALTER TABLE profile ADD COLUMN is_active boolean NOT NULL DEFAULT false;
|
||||
|
||||
UPDATE profile SET is_active = true WHERE pending_email is null;
|
||||
|
||||
ALTER TABLE profile DROP COLUMN pending_email;
|
|
@ -0,0 +1 @@
|
|||
DROP TABLE generic_token;
|
|
@ -28,7 +28,7 @@
|
|||
sem (System/currentTimeMillis)
|
||||
email (str "demo-" sem ".demo@nodomain.com")
|
||||
fullname (str "Demo User " sem)
|
||||
password (-> (bn/random-bytes 12)
|
||||
password (-> (bn/random-bytes 16)
|
||||
(bc/bytes->b64u)
|
||||
(bc/bytes->str))
|
||||
params {:id id
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
;; This Source Code Form is "Incompatible With Secondary Licenses", as
|
||||
;; defined by the Mozilla Public License, v. 2.0.
|
||||
;;
|
||||
;; Copyright (c) 2016-2020 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2020 UXBOX Labs SL
|
||||
|
||||
(ns app.services.mutations.profile
|
||||
(:require
|
||||
|
@ -35,7 +35,6 @@
|
|||
[cuerdas.core :as str]
|
||||
[datoteka.core :as fs]))
|
||||
|
||||
|
||||
;; --- Helpers & Specs
|
||||
|
||||
(s/def ::email ::us/email)
|
||||
|
@ -70,22 +69,22 @@
|
|||
[params]
|
||||
(when-not (:registration-enabled cfg/config)
|
||||
(ex/raise :type :restriction
|
||||
:code ::registration-disabled))
|
||||
:code :registration-disabled))
|
||||
|
||||
(when-not (email-domain-in-whitelist? (:registration-domain-whitelist cfg/config)
|
||||
(:email params))
|
||||
(ex/raise :type :validation
|
||||
:code ::email-domain-is-not-allowed))
|
||||
:code :email-domain-is-not-allowed))
|
||||
|
||||
(db/with-atomic [conn db/pool]
|
||||
(check-profile-existence! conn params)
|
||||
(let [profile (->> (create-profile conn params)
|
||||
(create-profile-relations conn))
|
||||
payload {:type :verify-email
|
||||
:profile-id (:id profile)
|
||||
:email (:email profile)}
|
||||
|
||||
token (tokens/create! conn payload {:valid {:days 30}})]
|
||||
token (tokens/generate
|
||||
{:iss :verify-email
|
||||
:exp (dt/in-future "48h")
|
||||
:profile-id (:id profile)
|
||||
:email (:email profile)})]
|
||||
|
||||
(emails/send! conn emails/register
|
||||
{:to (:email profile)
|
||||
|
@ -104,7 +103,7 @@
|
|||
result (db/exec-one! conn [sql:profile-existence email])]
|
||||
(when (:val result)
|
||||
(ex/raise :type :validation
|
||||
:code ::email-already-exists))
|
||||
:code :email-already-exists))
|
||||
params))
|
||||
|
||||
(defn- derive-password
|
||||
|
@ -119,16 +118,17 @@
|
|||
"Create the profile entry on the database with limited input
|
||||
filling all the other fields with defaults."
|
||||
[conn {:keys [id fullname email password demo?] :as params}]
|
||||
(let [id (or id (uuid/next))
|
||||
demo? (if (boolean? demo?) demo? false)
|
||||
paswd (derive-password password)]
|
||||
(let [id (or id (uuid/next))
|
||||
demo? (if (boolean? demo?) demo? false)
|
||||
active? (if demo? true false)
|
||||
password (derive-password password)]
|
||||
(db/insert! conn :profile
|
||||
{:id id
|
||||
:fullname fullname
|
||||
:email (str/lower email)
|
||||
:pending-email (if demo? nil email)
|
||||
:photo ""
|
||||
:password paswd
|
||||
:password password
|
||||
:is-active active?
|
||||
:is-demo demo?})))
|
||||
|
||||
(defn- create-profile-relations
|
||||
|
@ -165,17 +165,21 @@
|
|||
(letfn [(check-password [profile password]
|
||||
(when (= (:password profile) "!")
|
||||
(ex/raise :type :validation
|
||||
:code ::account-without-password))
|
||||
:code :account-without-password))
|
||||
(:valid (verify-password password (:password profile))))
|
||||
|
||||
(validate-profile [profile]
|
||||
(when-not (:is-active profile)
|
||||
(ex/raise :type :validation
|
||||
:code :wrong-credentials))
|
||||
(when-not profile
|
||||
(ex/raise :type :validation
|
||||
:code ::wrong-credentials))
|
||||
:code :wrong-credentials))
|
||||
(when-not (check-password profile password)
|
||||
(ex/raise :type :validation
|
||||
:code ::wrong-credentials))
|
||||
:code :wrong-credentials))
|
||||
profile)]
|
||||
|
||||
(db/with-atomic [conn db/pool]
|
||||
(let [prof (-> (retrieve-profile-by-email conn email)
|
||||
(validate-profile)
|
||||
|
@ -185,8 +189,8 @@
|
|||
|
||||
(def sql:profile-by-email
|
||||
"select * from profile
|
||||
where email=? and deleted_at is null
|
||||
for update")
|
||||
where email=?
|
||||
and deleted_at is null")
|
||||
|
||||
(defn- retrieve-profile-by-email
|
||||
[conn email]
|
||||
|
@ -207,7 +211,7 @@
|
|||
{:id (uuid/next)
|
||||
:fullname fullname
|
||||
:email (str/lower email)
|
||||
:pending-email nil
|
||||
:is-active true
|
||||
:photo ""
|
||||
:password "!"
|
||||
:is-demo false}))
|
||||
|
@ -251,7 +255,7 @@
|
|||
(let [profile (profile/retrieve-profile-data conn profile-id)]
|
||||
(when-not (:valid (verify-password old-password (:password profile)))
|
||||
(ex/raise :type :validation
|
||||
:code ::old-password-not-match))))
|
||||
:code :old-password-not-match))))
|
||||
|
||||
(s/def ::update-profile-password
|
||||
(s/keys :req-un [::profile-id ::password ::old-password]))
|
||||
|
@ -317,8 +321,6 @@
|
|||
|
||||
;; --- Mutation: Request Email Change
|
||||
|
||||
(declare select-profile-for-update)
|
||||
|
||||
(s/def ::request-email-change
|
||||
(s/keys :req-un [::email]))
|
||||
|
||||
|
@ -326,20 +328,16 @@
|
|||
[{:keys [profile-id email] :as params}]
|
||||
(db/with-atomic [conn db/pool]
|
||||
(let [email (str/lower email)
|
||||
profile (select-profile-for-update conn profile-id)
|
||||
payload {:type :change-email
|
||||
:profile-id profile-id
|
||||
:email email}
|
||||
|
||||
token (tokens/create! conn payload)]
|
||||
profile (db/get-by-id conn :profile profile-id)
|
||||
token (tokens/generate
|
||||
{:iss :change-email
|
||||
:exp (dt/in-future "15m")
|
||||
:profile-id profile-id
|
||||
:email email})]
|
||||
|
||||
(when (not= email (:email profile))
|
||||
(check-profile-existence! conn params))
|
||||
|
||||
(db/update! conn :profile
|
||||
{:pending-email email}
|
||||
{:id profile-id})
|
||||
|
||||
(emails/send! conn emails/change-email
|
||||
{:to (:email profile)
|
||||
:name (:fullname profile)
|
||||
|
@ -357,65 +355,51 @@
|
|||
;; Generic mutation for perform token based verification for auth
|
||||
;; domain.
|
||||
|
||||
(defmulti process-token (fn [conn claims] (:iss claims)))
|
||||
|
||||
(s/def ::verify-profile-token
|
||||
(s/keys :req-un [::token]))
|
||||
|
||||
(sm/defmutation ::verify-profile-token
|
||||
[{:keys [token] :as params}]
|
||||
(letfn [(handle-email-change [conn tdata]
|
||||
(let [profile (select-profile-for-update conn (:profile-id tdata))]
|
||||
(when (not= (:email tdata)
|
||||
(:pending-email profile))
|
||||
(ex/raise :type :validation
|
||||
:code ::email-does-not-match))
|
||||
(check-profile-existence! conn {:email (:pending-email profile)})
|
||||
(db/update! conn :profile
|
||||
{:pending-email nil
|
||||
:email (:pending-email profile)}
|
||||
{:id (:id profile)})
|
||||
|
||||
tdata))
|
||||
|
||||
(handle-email-verify [conn tdata]
|
||||
(let [profile (select-profile-for-update conn (:profile-id tdata))]
|
||||
(when (or (not= (:email profile)
|
||||
(:pending-email profile))
|
||||
(not= (:email profile)
|
||||
(:email tdata)))
|
||||
(ex/raise :type :validation
|
||||
:code ::tokens/invalid-token))
|
||||
|
||||
(db/update! conn :profile
|
||||
{:pending-email nil}
|
||||
{:id (:id profile)})
|
||||
tdata))]
|
||||
|
||||
(db/with-atomic [conn db/pool]
|
||||
(let [tdata (tokens/retrieve conn token {:delete true})]
|
||||
(tokens/delete! conn token)
|
||||
(case (:type tdata)
|
||||
:change-email (handle-email-change conn tdata)
|
||||
:verify-email (handle-email-verify conn tdata)
|
||||
:authentication tdata
|
||||
(ex/raise :type :validation
|
||||
:code ::tokens/invalid-token))))))
|
||||
|
||||
;; --- Mutation: Cancel Email Change
|
||||
|
||||
(s/def ::cancel-email-change
|
||||
(s/keys :req-un [::profile-id]))
|
||||
|
||||
(sm/defmutation ::cancel-email-change
|
||||
[{:keys [profile-id] :as params}]
|
||||
(db/with-atomic [conn db/pool]
|
||||
(let [profile (select-profile-for-update conn profile-id)]
|
||||
(when (= (:email profile)
|
||||
(:pending-email profile))
|
||||
(ex/raise :type :validation
|
||||
:code ::unexpected-request))
|
||||
(let [claims (tokens/verify token)]
|
||||
(process-token conn claims))))
|
||||
|
||||
(defmethod process-token :change-email
|
||||
[conn {:keys [profile-id email] :as claims}]
|
||||
(let [profile (select-profile-for-update conn profile-id)]
|
||||
(check-profile-existence! conn {:email email})
|
||||
(db/update! conn :profile
|
||||
{:email email}
|
||||
{:id profile-id})
|
||||
claims))
|
||||
|
||||
(defmethod process-token :verify-email
|
||||
[conn {:keys [profile-id] :as claims}]
|
||||
(let [profile (select-profile-for-update conn profile-id)]
|
||||
(when (:is-active profile)
|
||||
(ex/raise :type :validation
|
||||
:code :email-already-validated))
|
||||
(when (not= (:email profile)
|
||||
(:email claims))
|
||||
(ex/raise :type :validation
|
||||
:code :invalid-token))
|
||||
|
||||
(db/update! conn :profile
|
||||
{:is-active true}
|
||||
{:id (:id profile)})
|
||||
claims))
|
||||
|
||||
(defmethod process-token :auth
|
||||
[conn claims]
|
||||
claims)
|
||||
|
||||
(defmethod process-token :default
|
||||
[conn claims]
|
||||
(ex/raise :type :validation
|
||||
:code :invalid-token))
|
||||
|
||||
(db/update! conn :profile {:pending-email nil} {:id profile-id})
|
||||
nil)))
|
||||
|
||||
;; --- Mutation: Request Profile Recovery
|
||||
|
||||
|
@ -425,9 +409,10 @@
|
|||
(sm/defmutation ::request-profile-recovery
|
||||
[{:keys [email] :as params}]
|
||||
(letfn [(create-recovery-token [conn {:keys [id] :as profile}]
|
||||
(let [payload {:type :password-recovery-token
|
||||
:profile-id id}
|
||||
token (tokens/create! conn payload)]
|
||||
(let [token (tokens/generate
|
||||
{:iss :password-recovery
|
||||
:exp (dt/in-future "15m")
|
||||
:profile-id id})]
|
||||
(assoc profile :token token)))
|
||||
|
||||
(send-email-notification [conn profile]
|
||||
|
@ -453,23 +438,16 @@
|
|||
(sm/defmutation ::recover-profile
|
||||
[{:keys [token password]}]
|
||||
(letfn [(validate-token [conn token]
|
||||
(let [tpayload (tokens/retrieve conn token)]
|
||||
(when (not= (:type tpayload) :password-recovery-token)
|
||||
(ex/raise :type :validation
|
||||
:code ::tokens/invalid-token))
|
||||
(:profile-id tpayload)))
|
||||
(let [tdata (tokens/verify token {:iss :password-recovery})]
|
||||
(:profile-id tdata)))
|
||||
|
||||
(update-password [conn profile-id]
|
||||
(let [pwd (derive-password password)]
|
||||
(db/update! conn :profile {:password pwd} {:id profile-id})))
|
||||
|
||||
(delete-token [conn token]
|
||||
(db/delete! conn :generic-token {:token token}))]
|
||||
(db/update! conn :profile {:password pwd} {:id profile-id})))]
|
||||
|
||||
(db/with-atomic [conn db/pool]
|
||||
(->> (validate-token conn token)
|
||||
(update-password conn))
|
||||
(delete-token conn token)
|
||||
nil)))
|
||||
|
||||
|
||||
|
@ -515,6 +493,6 @@
|
|||
(let [rows (db/exec! conn [sql:teams-ownership-check profile-id])]
|
||||
(when-not (empty? rows)
|
||||
(ex/raise :type :validation
|
||||
:code ::owner-teams-with-people
|
||||
:code :owner-teams-with-people
|
||||
:hint "The user need to transfer ownership of owned teams."
|
||||
:context {:teams (mapv :team-id rows)}))))
|
||||
|
|
|
@ -9,70 +9,59 @@
|
|||
|
||||
(ns app.services.tokens
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]
|
||||
[buddy.core.codecs :as bc]
|
||||
[buddy.core.nonce :as bn]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.spec :as us]
|
||||
[app.config :as cfg]
|
||||
[app.db :as db]
|
||||
[app.util.time :as dt]
|
||||
[app.db :as db]))
|
||||
[app.util.transit :as t]
|
||||
[buddy.core.codecs :as bc]
|
||||
[buddy.core.kdf :as bk]
|
||||
[buddy.core.nonce :as bn]
|
||||
[buddy.sign.jwe :as jwe]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.logging :as log]))
|
||||
|
||||
(defn next-token
|
||||
([] (next-token 96))
|
||||
([n]
|
||||
(-> (bn/random-bytes n)
|
||||
(bc/bytes->b64u)
|
||||
(bc/bytes->str))))
|
||||
(defn- derive-tokens-secret
|
||||
[key]
|
||||
(when (= key "default")
|
||||
(log/warn "Using default APP_SECRET_KEY, the system will generate insecure tokens."))
|
||||
(let [engine (bk/engine {:key key
|
||||
:salt "tokens"
|
||||
:alg :hkdf
|
||||
:digest :blake2b-512})]
|
||||
(bk/get-bytes engine 32)))
|
||||
|
||||
(def default-duration
|
||||
(dt/duration {:hours 48}))
|
||||
(def secret
|
||||
(delay (derive-tokens-secret (:secret-key cfg/config))))
|
||||
|
||||
(defn- decode-row
|
||||
[{:keys [content] :as row}]
|
||||
(when row
|
||||
(cond-> row
|
||||
(db/pgobject? content)
|
||||
(assoc :content (db/decode-transit-pgobject content)))))
|
||||
(defn generate
|
||||
[claims]
|
||||
(let [payload (t/encode claims)]
|
||||
(jwe/encrypt payload @secret {:alg :a256kw :enc :a256gcm})))
|
||||
|
||||
(defn create!
|
||||
([conn payload] (create! conn payload {}))
|
||||
([conn payload {:keys [valid] :or {valid default-duration}}]
|
||||
(let [token (next-token)
|
||||
until (dt/plus (dt/now) (dt/duration valid))]
|
||||
(db/insert! conn :generic-token
|
||||
{:content (db/tjson payload)
|
||||
:token token
|
||||
:valid-until until})
|
||||
token)))
|
||||
|
||||
(defn delete!
|
||||
[conn token]
|
||||
(db/delete! conn :generic-token {:token token}))
|
||||
|
||||
(defn retrieve
|
||||
([conn token] (retrieve conn token {}))
|
||||
([conn token {:keys [delete] :or {delete false}}]
|
||||
(let [row (->> (db/query conn :generic-token {:token token})
|
||||
(map decode-row)
|
||||
(first))]
|
||||
|
||||
(when-not row
|
||||
(defn verify
|
||||
([token] (verify token nil))
|
||||
([token params]
|
||||
(let [payload (jwe/decrypt token @secret {:alg :a256kw :enc :a256gcm})
|
||||
claims (t/decode payload)]
|
||||
(when (and (dt/instant? (:exp claims))
|
||||
(dt/is-before? (:exp claims) (dt/now)))
|
||||
(ex/raise :type :validation
|
||||
:code ::invalid-token))
|
||||
|
||||
;; Validate the token expiration
|
||||
(when (> (inst-ms (dt/now))
|
||||
(inst-ms (:valid-until row)))
|
||||
:code :invalid-token
|
||||
:reason :token-expired
|
||||
:params params
|
||||
:claims claims))
|
||||
(when (and (contains? params :iss)
|
||||
(not= (:iss claims)
|
||||
(:iss params)))
|
||||
(ex/raise :type :validation
|
||||
:code ::invalid-token))
|
||||
|
||||
(when delete
|
||||
(db/delete! conn :generic-token {:token token}))
|
||||
|
||||
(-> row
|
||||
(dissoc :content)
|
||||
(merge (:content row))))))
|
||||
:code :invalid-token
|
||||
:reason :invalid-issuer
|
||||
:claims claims
|
||||
:params params))
|
||||
claims)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -29,9 +29,17 @@
|
|||
{:pre [(string? s)]}
|
||||
(Instant/parse s))
|
||||
|
||||
(defn now
|
||||
[]
|
||||
(Instant/now))
|
||||
(defn instant?
|
||||
[v]
|
||||
(instance? Instant v))
|
||||
|
||||
(defn is-after?
|
||||
[da db]
|
||||
(.isAfter ^Instant da ^Instant db))
|
||||
|
||||
(defn is-before?
|
||||
[da db]
|
||||
(.isBefore ^Instant da ^Instant db))
|
||||
|
||||
(defn plus
|
||||
[d ta]
|
||||
|
@ -65,6 +73,14 @@
|
|||
:else
|
||||
(obj->duration ms-or-obj)))
|
||||
|
||||
(defn now
|
||||
[]
|
||||
(Instant/now))
|
||||
|
||||
(defn in-future
|
||||
[v]
|
||||
(plus (now) (duration v)))
|
||||
|
||||
(defn duration-between
|
||||
[t1 t2]
|
||||
(Duration/between t1 t2))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue