♻️ Refactor session management

backend/deps.edn

@@ -20,7 +20,7 @@
   io.lettuce/lettuce-core {:mvn/version "6.1.8.RELEASE"}
   java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
-  funcool/yetti {:git/tag "v9.3" :git/sha "c6e2d0d"
+  funcool/yetti {:git/tag "v9.8" :git/sha "fbe1d7d"
                  :git/url "https://github.com/funcool/yetti.git"
                  :exclusions [org.slf4j/slf4j-api]}
 

backend/src/app/config.clj

@@ -42,8 +42,7 @@
     data))
 
 (def defaults
-  {
+  {:database-uri "postgresql://postgres/penpot"
-   :database-uri "postgresql://postgres/penpot"
    :database-username "penpot"
    :database-password "penpot"
 
@@ -101,10 +100,14 @@
 (s/def ::blocking-executor-parallelism ::us/integer)
 (s/def ::worker-executor-parallelism ::us/integer)
 
+(s/def ::authenticated-cookie-domain ::us/string)
+(s/def ::authenticated-cookie-name ::us/string)
+(s/def ::auth-token-cookie-name ::us/string)
+(s/def ::auth-token-cookie-max-age ::dt/duration)
+
 (s/def ::secret-key ::us/string)
 (s/def ::allow-demo-users ::us/boolean)
 (s/def ::assets-path ::us/string)
-(s/def ::authenticated-cookie-domain ::us/string)
 (s/def ::database-password (s/nilable ::us/string))
 (s/def ::database-uri ::us/string)
 (s/def ::database-username (s/nilable ::us/string))
@@ -140,7 +143,6 @@
 (s/def ::http-server-max-multipart-body-size ::us/integer)
 (s/def ::http-server-io-threads ::us/integer)
 (s/def ::http-server-worker-threads ::us/integer)
-(s/def ::http-session-idle-max-age ::dt/duration)
 (s/def ::http-session-updater-batch-max-age ::dt/duration)
 (s/def ::http-session-updater-batch-max-size ::us/integer)
 (s/def ::initial-project-skey ::us/string)
@@ -206,6 +208,9 @@
                    ::allow-demo-users
                    ::audit-log-archive-uri
                    ::audit-log-gc-max-age
+                   ::auth-token-cookie-name
+                   ::auth-token-cookie-max-age
+                   ::authenticated-cookie-name
                    ::authenticated-cookie-domain
                    ::database-password
                    ::database-uri
@@ -246,7 +251,6 @@
                    ::http-server-max-multipart-body-size
                    ::http-server-io-threads
                    ::http-server-worker-threads
-                   ::http-session-idle-max-age
                    ::http-session-updater-batch-max-age
                    ::http-session-updater-batch-max-size
                    ::initial-project-skey

backend/src/app/http/session.clj

@@ -7,33 +7,35 @@
 (ns app.http.session
   (:require
    [app.common.data :as d]
-   [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.config :as cfg]
+   [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
-   [app.metrics :as mtx]
-   [app.util.async :as aa]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [clojure.core.async :as a]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.core :as p]
    [promesa.exec :as px]
    [yetti.request :as yrq]))
 
-;; A default cookie name for storing the session. We don't allow to configure it.
+;; A default cookie name for storing the session.
-(def token-cookie-name "auth-token")
+(def default-auth-token-cookie-name "auth-token")
 
-;; A cookie that we can use to check from other sites of the same domain if a user
+;; A cookie that we can use to check from other sites of the same
-;; is registered. Is not intended for on premise installations, although nothing
+;; domain if a user is authenticated.
-;; prevents using it if some one wants to.
+(def default-authenticated-cookie-name "authenticated")
-(def authenticated-cookie-name "authenticated")
+
+;; Default value for cookie max-age
+(def default-cookie-max-age (dt/duration {:days 7}))
+
+;; Default age for automatic session renewal
+(def default-renewal-max-age (dt/duration {:hours 6}))
 
 (defprotocol ISessionStore
   (read-session [store key])
   (write-session [store key data])
+  (update-session [store data])
   (delete-session [store key]))
 
 (defn- make-database-store
@@ -47,18 +49,25 @@
       (px/with-dispatch executor
         (let [profile-id (:profile-id data)
               user-agent (:user-agent data)
-              now        (dt/now)
+              created-at (or (:created-at data) (dt/now))
-
               token      (tokens :generate {:iss "authentication"
-                                            :iat now
+                                            :iat created-at
                                             :uid profile-id})
               params     {:user-agent user-agent
                           :profile-id profile-id
-                          :created-at now
+                          :created-at created-at
-                          :updated-at now
+                          :updated-at created-at
                           :id token}]
-          (db/insert! pool :http-session params)
+          (db/insert! pool :http-session params))))
-          token)))
+
+    (update-session [_ data]
+      (let [updated-at (dt/now)]
+        (px/with-dispatch executor
+          (db/update! pool :http-session
+                      {:updated-at updated-at}
+                      {:id (:id data)})
+          (assoc data :updated-at updated-at))))
+
 
     (delete-session [_ token]
       (px/with-dispatch executor
@@ -76,15 +85,23 @@
         (p/do
           (let [profile-id (:profile-id data)
                 user-agent (:user-agent data)
+                created-at (or (:created-at data) (dt/now))
                 token      (tokens :generate {:iss "authentication"
-                                              :iat (dt/now)
+                                              :iat created-at
                                               :uid profile-id})
                 params     {:user-agent user-agent
+                            :created-at created-at
+                            :updated-at created-at
                             :profile-id profile-id
                             :id token}]
 
             (swap! cache assoc token params)
-            token)))
+            params)))
+
+      (update-session [_ data]
+        (let [updated-at (dt/now)]
+          (swap! cache update (:id data) assoc :updated-at updated-at)
+          (assoc data :updated-at updated-at)))
 
       (delete-session [_ token]
         (p/do
@@ -107,77 +124,123 @@
 ;; --- IMPL
 
 (defn- create-session!
-  [store request profile-id]
+  [store profile-id user-agent]
-  (let [params {:user-agent (yrq/get-header request "user-agent")
+  (let [params {:user-agent user-agent
                 :profile-id profile-id}]
     (write-session store nil params)))
 
+(defn- update-session!
+  [store session]
+  (update-session store session))
+
 (defn- delete-session!
   [store {:keys [cookies] :as request}]
-  (when-let [token (get-in cookies [token-cookie-name :value])]
+  (let [name (cf/get :auth-token-cookie-name default-auth-token-cookie-name)]
-    (delete-session store token)))
+    (when-let [token (get-in cookies [name :value])]
+      (delete-session store token))))
 
 (defn- retrieve-session
   [store request]
-  (when-let [cookie (yrq/get-cookie request token-cookie-name)]
+  (let [cookie-name (cf/get :auth-token-cookie-name default-auth-token-cookie-name)]
-    (-> (read-session store (:value cookie))
+    (when-let [cookie (yrq/get-cookie request cookie-name)]
-        (p/then (fn [session]
+      (read-session store (:value cookie)))))
-                  (when session
-                    {:session-id (:id session)
-                     :profile-id (:profile-id session)}))))))
 
-(defn- add-cookies
+(defn assign-auth-token-cookie
-  [response token]
+  [response {token :id updated-at :updated-at}]
-  (let [cors?   (contains? cfg/flags :cors)
+  (let [max-age    (cf/get :auth-token-cookie-max-age default-cookie-max-age)
-        secure? (contains? cfg/flags :secure-session-cookies)
+        created-at (or updated-at (dt/now))
-        authenticated-cookie-domain (cfg/get :authenticated-cookie-domain)]
+        renewal    (dt/plus created-at default-renewal-max-age)
-    (update response :cookies
+        expires    (dt/plus created-at max-age)
-            (fn [cookies]
+        secure?    (contains? cf/flags :secure-session-cookies)
-              (cond-> cookies
+        cors?      (contains? cf/flags :cors)
-                :always
+        name       (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
-                (assoc token-cookie-name {:path "/"
+        comment    (str "Renewal at: " (dt/format-instant renewal :rfc1123))
-                                          :http-only true
+        cookie     {:path "/"
-                                          :value token
+                    :http-only true
-                                          :same-site (if cors? :none :lax)
+                    :expires expires
-                                          :secure secure?})
+                    :value token
+                    :comment comment
+                    :same-site (if cors? :none :lax)
+                    :secure secure?}]
+    (update response :cookies assoc name cookie)))
 
-                (some? authenticated-cookie-domain)
+(defn assign-authenticated-cookie
-                (assoc authenticated-cookie-name {:domain authenticated-cookie-domain
+  [response {updated-at :updated-at}]
-                                                  :path "/"
+  (let [max-age    (cf/get :auth-token-cookie-max-age default-cookie-max-age)
-                                                  :value true
+        created-at (or updated-at (dt/now))
-                                                  :same-site :strict
+        renewal    (dt/plus created-at default-renewal-max-age)
-                                                  :secure secure?}))))))
+        expires    (dt/plus created-at max-age)
+        comment    (str "Renewal at: " (dt/format-instant renewal :rfc1123))
+        secure?    (contains? cf/flags :secure-session-cookies)
+        domain     (cf/get :authenticated-cookie-domain)
+        name       (cf/get :authenticated-cookie-name "authenticated")
+        cookie     {:domain domain
+                    :expires expires
+                    :path "/"
+                    :comment comment
+                    :value true
+                    :same-site :strict
+                    :secure secure?}]
+    (cond-> response
+      (string? domain)
+      (update :cookies assoc name cookie))))
 
-(defn- clear-cookies
+(defn clear-auth-token-cookie
   [response]
-  (let [authenticated-cookie-domain (cfg/get :authenticated-cookie-domain)]
+  (let [name (cf/get :auth-token-cookie-name default-auth-token-cookie-name)]
-    (assoc response :cookies
+    (update response :cookies assoc name {:path "/" :value "" :max-age -1})))
-           {token-cookie-name {:path "/"
+
-                               :value ""
+(defn- clear-authenticated-cookie
-                               :max-age -1}
+  [response]
-            authenticated-cookie-name {:domain authenticated-cookie-domain
+  (let [name   (cf/get :authenticated-cookie-name default-authenticated-cookie-name)
-                                       :path "/"
+        domain (cf/get :authenticated-cookie-domain)]
-                                       :value ""
+    (cond-> response
-                                       :max-age -1}})))
+      (string? domain)
+      (update :cookies assoc name {:domain domain :path "/" :value "" :max-age -1}))))
 
 (defn- make-middleware
-  [{:keys [::events-ch store] :as cfg}]
+  [{:keys [store] :as cfg}]
-  {:name :session
+  (letfn [;; Check if time reached for automatic session renewal
-   :compile (fn [& _]
+          (renew-session? [{:keys [updated-at] :as session}]
-              (fn [handler]
+            (and (dt/instant? updated-at)
-                (fn [request respond raise]
+                 (let [elapsed (dt/diff updated-at (dt/now))]
-                  (try
+                   (neg? (compare default-renewal-max-age elapsed)))))
-                    (-> (retrieve-session store request)
+
-                        (p/then' #(merge request %))
+          ;; Wrap respond with session renewal code
-                        (p/finally (fn [request cause]
+          (wrap-respond [respond session]
-                                     (if cause
+            (fn [response]
-                                       (raise cause)
+              (p/let [session (update-session! store session)]
-                                       (do
+                (-> response
-                                    (when-let [session-id (:session-id request)]
+                    (assign-auth-token-cookie session)
-                                      (a/offer! events-ch session-id))
+                    (assign-authenticated-cookie session)
-                                    (handler request respond raise))))))
+                    (respond)))))]
-                    (catch Throwable cause
+
-                      (raise cause))))))})
+    {:name :session
+     :compile (fn [& _]
+                (fn [handler]
+                  (fn [request respond raise]
+                    (try
+                      (-> (retrieve-session store request)
+                          (p/finally (fn [session cause]
+                                       (cond
+                                         (some? cause)
+                                         (raise cause)
+
+                                         (nil? session)
+                                         (handler request respond raise)
+
+                                         :else
+                                         (let [request    (-> request
+                                                              (assoc :profile-id (:profile-id session))
+                                                              (assoc :session-id (:id session)))
+                                               respond    (cond-> respond
+                                                            (renew-session? session)
+                                                            (wrap-respond session))]
+
+                                           (handler request respond raise))))))
+
+                      (catch Throwable cause
+                        (raise cause))))))}))
 
 
 ;; --- STATE INIT: SESSION
@@ -194,77 +257,23 @@
 
 (defmethod ig/init-key :app.http/session
   [_ {:keys [store] :as cfg}]
-  (let [events-ch (a/chan (a/dropping-buffer (:buffer-size cfg)))
+  (-> cfg
-        cfg       (assoc cfg ::events-ch events-ch)]
+      (assoc :middleware (make-middleware cfg))
-
+      (assoc :create (fn [profile-id]
-    (-> cfg
+                       (fn [request response]
-        (assoc :middleware (make-middleware cfg))
+                         (p/let [uagent  (yrq/get-header request "user-agent")
-        (assoc :create (fn [profile-id]
+                                 session (create-session! store profile-id uagent)]
-                         (fn [request response]
-                           (p/let [token (create-session! store request profile-id)]
-                             (add-cookies response token)))))
-        (assoc :delete (fn [request response]
-                         (p/do
-                           (delete-session! store request)
                            (-> response
-                               (assoc :status 204)
+                               (assign-auth-token-cookie session)
-                               (assoc :body nil)
+                               (assign-authenticated-cookie session))))))
-                               (clear-cookies))))))))
+      (assoc :delete (fn [request response]
-
+                       (p/do
-(defmethod ig/halt-key! :app.http/session
+                         (delete-session! store request)
-  [_ data]
+                         (-> response
-  (a/close! (::events-ch data)))
+                             (assoc :status 204)
-
+                             (assoc :body nil)
-;; --- STATE INIT: SESSION UPDATER
+                             (clear-auth-token-cookie)
-
+                             (clear-authenticated-cookie)))))))
-(declare update-sessions)
-
-(s/def ::session map?)
-(s/def ::max-batch-age ::cfg/http-session-updater-batch-max-age)
-(s/def ::max-batch-size ::cfg/http-session-updater-batch-max-size)
-
-(defmethod ig/pre-init-spec ::updater [_]
-  (s/keys :req-un [::db/pool ::wrk/executor ::mtx/metrics ::session]
-          :opt-un [::max-batch-age ::max-batch-size]))
-
-(defmethod ig/prep-key ::updater
-  [_ cfg]
-  (merge {:max-batch-age (dt/duration {:minutes 5})
-          :max-batch-size 200}
-         (d/without-nils cfg)))
-
-(defmethod ig/init-key ::updater
-  [_ {:keys [session metrics] :as cfg}]
-  (l/info :action "initialize session updater"
-          :max-batch-age (str (:max-batch-age cfg))
-          :max-batch-size (str (:max-batch-size cfg)))
-  (let [input (aa/batch (::events-ch session)
-                        {:max-batch-size (:max-batch-size cfg)
-                         :max-batch-age (inst-ms (:max-batch-age cfg))})]
-    (a/go-loop []
-      (when-let [[reason batch] (a/<! input)]
-        (let [result (a/<! (update-sessions cfg batch))]
-          (mtx/run! metrics {:id :session-update-total :inc 1})
-          (cond
-            (ex/exception? result)
-            (l/error :task "updater"
-                     :hint "unexpected error on update sessions"
-                     :cause result)
-
-            (= :size reason)
-            (l/debug :task "updater"
-                     :hint "update sessions"
-                     :reason (name reason)
-                     :count result))
-
-          (recur))))))
-
-(defn- update-sessions
-  [{:keys [pool executor]} ids]
-  (aa/with-thread executor
-    (db/exec-one! pool ["update http_session set updated_at=now() where id = ANY(?)"
-                        (into-array String ids)])
-    (count ids)))
 
 ;; --- STATE INIT: SESSION GC
 
@@ -278,7 +287,7 @@
 
 (defmethod ig/prep-key ::gc-task
   [_ cfg]
-  (merge {:max-age (dt/duration {:days 15})}
+  (merge {:max-age default-cookie-max-age}
          (d/without-nils cfg)))
 
 (defmethod ig/init-key ::gc-task

backend/src/app/main.clj

@@ -98,15 +98,7 @@
 
    :app.http.session/gc-task
    {:pool        (ig/ref :app.db/pool)
-    :max-age     (cf/get :http-session-idle-max-age)}
+    :max-age     (cf/get :auth-token-cookie-max-age)}
-
-   :app.http.session/updater
-   {:pool           (ig/ref :app.db/pool)
-    :metrics        (ig/ref :app.metrics/metrics)
-    :executor       (ig/ref [::worker :app.worker/executor])
-    :session        (ig/ref :app.http/session)
-    :max-batch-age  (cf/get :http-session-updater-batch-max-age)
-    :max-batch-size (cf/get :http-session-updater-batch-max-size)}
 
    :app.http.awsns/handler
    {:tokens      (ig/ref :app.tokens/tokens)