Repository: CSCfi/rems
Pull request #1127 (2019-04-15 16:31:02)

Performance optimizations cleanup
Follow up from #1114 code review.


Patch:
diff --git a/project.clj b/project.clj
index 765afdb14..9ab138166 100644
--- a/project.clj
+++ b/project.clj
@@ -142,6 +142,7 @@
    :project/dev {:dependencies [[binaryage/devtools "0.9.10"]
                                 [cider/piggieback "0.3.10"]
                                 [com.clojure-goes-fast/clj-memory-meter "0.1.2"]
+                                [criterium "0.4.4"]
                                 [doo "0.1.11"]
                                 [eftest "0.5.4"]
                                 [etaoin "0.3.1"]
@@ -159,7 +160,7 @@
                  :aot [rems.InvalidRequestException rems.auth.NotAuthorizedException rems.auth.ForbiddenException]
 
                  :jvm-opts ["-Drems.config=dev-config.edn"
-                            "-Djdk.attach.allowAttachSelf"]
+                            "-Djdk.attach.allowAttachSelf"] ; needed by clj-memory-meter on Java 9+
                  :source-paths ["env/dev/clj"]
                  :resource-paths ["env/dev/resources"]
                  :repl-options {:init-ns rems.standalone
diff --git a/src/clj/rems/api/applications_v2.clj b/src/clj/rems/api/applications_v2.clj
index e0973e690..fa631009e 100644
--- a/src/clj/rems/api/applications_v2.clj
+++ b/src/clj/rems/api/applications_v2.clj
@@ -13,7 +13,7 @@
             [rems.db.users :as users]
             [rems.permissions :as permissions]
             [rems.util :refer [getx atom?]])
-  (:import [java.util.concurrent TimeUnit ScheduledThreadPoolExecutor]))
+  (:import [java.util.concurrent TimeUnit ScheduledThreadPoolExecutor ExecutorService]))
 
 (defn- get-form [form-id]
   (-> (form/get-form form-id)
@@ -51,6 +51,7 @@
         build-app (fn [_] (model/build-application-view events injections))]
     (if (empty? events)
       nil ; application not found
+      ;; TODO: this caching could be removed by refactoring the pollers to build their own projection
       (if (atom? application-cache) ; guard against not started cache
         (-> (swap! application-cache cache/through-cache cache-key build-app)
             (getx cache-key))
@@ -79,7 +80,19 @@
           :application/form
           :application/licenses))
 
-(mount/defstate all-applications-cache
+(mount/defstate
+  ^{:doc "The cached state will contain the following keys:
+          ::raw-apps
+          - Map from application ID to the pure projected state of an application.
+          ::enriched-apps
+          - Map from application ID to the enriched version of an application.
+            Built from the raw apps by calling `enrich-with-injections`.
+            Since the injected entities (resources, forms etc.) are mutable,
+            it creates a cache invalidation problem here.
+          ::apps-by-user
+          - Map from user ID to a list of applications which the user can see.
+            Built from the enriched apps by calling `apply-user-permissions`."}
+  all-applications-cache
   :start (events-cache/new))
 
 (defn- group-apps-by-user [apps]
@@ -98,6 +111,7 @@
    (fn [state events]
      ;; Because enrich-with-injections is not idempotent,
      ;; it's necessary to hold on to the "raw" applications.
+     ;; TODO: consider making enrich-with-injections idempotent (move dissocs to hide-non-public-information and other small refactorings)
      (let [raw-apps (reduce all-applications-view (::raw-apps state) events)
            updated-app-ids (distinct (map :application/id events))
            ;; TODO: batched injections: only one DB query to fetch all catalogue items etc.
@@ -129,13 +143,16 @@
        (filter own-application?)))
 
 (defn reload-cache! []
+  ;; TODO: Here is a small chance that a user will experience a cache miss. Consider rebuilding the cache asynchronously and then `reset!` the cache.
   (events-cache/empty! all-applications-cache)
   (refresh-all-applications-cache!))
 
 ;; empty the cache occasionally in case some of the injected entities are changed
 (mount/defstate all-applications-cache-reloader
+  ;; TODO: consider refactoring this mount-cron-thing which is duplicated in a few places
   :start (doto (ScheduledThreadPoolExecutor. 1)
            (.scheduleWithFixedDelay reload-cache! 1 1 TimeUnit/HOURS))
-  :stop (doto all-applications-cache-reloader
-          (.shutdown)
-          (.awaitTermination 60 TimeUnit/SECONDS)))
+  :stop (let [executor (doto ^ExecutorService all-applications-cache-reloader
+                         (.shutdownNow))]
+          (when-not (.awaitTermination executor 1 TimeUnit/MINUTES)
+            (throw (IllegalStateException. "did not terminate")))))
diff --git a/src/clj/rems/application/events_cache.clj b/src/clj/rems/application/events_cache.clj
index 5abd91808..e12ca4acf 100644
--- a/src/clj/rems/application/events_cache.clj
+++ b/src/clj/rems/application/events_cache.clj
@@ -3,6 +3,7 @@
             [rems.util :refer [atom?]]))
 
 (def ^:private empty-cache
+  ;; TODO: consider refactoring opportunities with pollers
   {:last-processed-event-id 0
    :state nil})
 
diff --git a/src/clj/rems/application/model.clj b/src/clj/rems/application/model.clj
index fc697ac99..af1f52247 100644
--- a/src/clj/rems/application/model.clj
+++ b/src/clj/rems/application/model.clj
@@ -332,7 +332,7 @@
         orphans-in-order (filter (fn [item2]
                                    (not (contains? list1-keys (f item2))))
                                  list2)]
-    (concat merged-in-order orphans-in-order)))
+    (vec (concat merged-in-order orphans-in-order))))
 
 (deftest test-merge-lists-by
   (testing "merges objects with the same key"
@@ -426,7 +426,8 @@
                :catalogue-item/enabled (:enabled item)
                :catalogue-item/expired (:expired item)
                :catalogue-item/archived (:archived item)}))
-       (sort-by :catalogue-item/id)))
+       (sort-by :catalogue-item/id)
+       vec))
 
 (defn- enrich-licenses [app-licenses get-license]
   (let [rich-licenses (->> app-licenses
@@ -525,7 +526,7 @@
                        :application.event/decided
                        :application.event/decision-requested}
                      :event/type))
-       (map hide-sensitive-event-content)))
+       (mapv hide-sensitive-event-content)))
 
 (defn- hide-sensitive-information [application]
   (-> application
diff --git a/src/clj/rems/db/dynamic_roles.clj b/src/clj/rems/db/dynamic_roles.clj
index 2a6558d0f..5c9227e4e 100644
--- a/src/clj/rems/db/dynamic_roles.clj
+++ b/src/clj/rems/db/dynamic_roles.clj
@@ -42,15 +42,22 @@
     (is (= #{}
            (roles-from-all-applications "unknown" events)))))
 
-(mount/defstate dynamic-roles-cache
+(mount/defstate
+  ^{:doc "The cached state will contain the following keys:
+          ::permissions
+          - Map from application ID to the roles and permissions of an application.
+          ::roles-by-user
+          - Map from user ID to a set of all application roles which the user has,
+            a union of roles from all applications."}
+  dynamic-roles-cache
   :start (events-cache/new))
 
 (defn get-roles [user]
   (->> (events-cache/refresh!
         dynamic-roles-cache
         (fn [state events]
-          (let [apps (reduce permissions-of-all-applications (::apps state) events)]
-            {::apps apps
-             ::roles-by-user (group-roles-by-user apps)})))
+          (let [permissions (reduce permissions-of-all-applications (::permissions state) events)]
+            {::permissions permissions
+             ::roles-by-user (group-roles-by-user permissions)})))
        ::roles-by-user
        (get-user-roles user)))
diff --git a/src/clj/rems/poller/email.clj b/src/clj/rems/poller/email.clj
index 77d6aa30c..7d221b799 100644
--- a/src/clj/rems/poller/email.clj
+++ b/src/clj/rems/poller/email.clj
@@ -11,7 +11,7 @@
             [rems.poller.common :as common]
             [rems.text :refer [text text-format with-language]]
             [rems.util :as util])
-  (:import [java.util.concurrent ScheduledThreadPoolExecutor TimeUnit]))
+  (:import [java.util.concurrent ScheduledThreadPoolExecutor TimeUnit ExecutorService]))
 
 ;;; Mapping events to emails
 
@@ -181,9 +181,10 @@
 (mount/defstate email-poller
   :start (doto (ScheduledThreadPoolExecutor. 1)
            (.scheduleWithFixedDelay run 10 10 TimeUnit/SECONDS))
-  :stop (doto email-poller
-          (.shutdownNow)
-          (.awaitTermination 60 TimeUnit/SECONDS)))
+  :stop (let [executor (doto ^ExecutorService email-poller
+                         (.shutdownNow))]
+          (when-not (.awaitTermination executor 1 TimeUnit/MINUTES)
+            (throw (IllegalStateException. "did not terminate")))))
 
 (comment
   (mount/start #{#'email-poller})
diff --git a/src/clj/rems/poller/entitlements.clj b/src/clj/rems/poller/entitlements.clj
index 0025cd7d9..0c49adefd 100644
--- a/src/clj/rems/poller/entitlements.clj
+++ b/src/clj/rems/poller/entitlements.clj
@@ -6,7 +6,7 @@
             [rems.api.applications-v2 :as applications-v2]
             [rems.db.entitlements :as entitlements]
             [rems.poller.common :as common])
-  (:import [java.util.concurrent ScheduledThreadPoolExecutor TimeUnit]))
+  (:import [java.util.concurrent ScheduledThreadPoolExecutor TimeUnit ExecutorService]))
 
 (defn- entitlements-for-event [event]
   ;; we filter by event here, and by state in update-entitlements-for.
@@ -25,6 +25,7 @@
 (mount/defstate entitlements-poller
   :start (doto (ScheduledThreadPoolExecutor. 1)
            (.scheduleWithFixedDelay run 10 10 TimeUnit/SECONDS))
-  :stop (doto entitlements-poller
-          (.shutdownNow)
-          (.awaitTermination 60 TimeUnit/SECONDS)))
+  :stop (let [executor (doto ^ExecutorService entitlements-poller
+                         (.shutdownNow))]
+          (when-not (.awaitTermination executor 1 TimeUnit/MINUTES)
+            (throw (IllegalStateException. "did not terminate")))))


Test patch:
diff --git a/test/clj/rems/api/testing.clj b/test/clj/rems/api/testing.clj
index 0855d6274..adbe62093 100644
--- a/test/clj/rems/api/testing.clj
+++ b/test/clj/rems/api/testing.clj
@@ -3,7 +3,7 @@
   (:require [clojure.test :refer :all]
             [cheshire.core :refer [parse-stream]]
             [mount.core :as mount]
-            [rems.db.testing :refer [test-data-fixture test-db-fixture]]
+            [rems.db.testing :refer [test-data-fixture test-db-fixture caches-fixture]]
             [rems.handler :refer :all]
             [ring.mock.request :refer :all]))
 
@@ -17,6 +17,7 @@
 
 (def api-fixture
   (join-fixtures [test-db-fixture
+                  caches-fixture
                   test-data-fixture
                   handler-fixture]))
 
diff --git a/test/clj/rems/db/testing.clj b/test/clj/rems/db/testing.clj
index 15496bb7d..7cc5df39e 100644
--- a/test/clj/rems/db/testing.clj
+++ b/test/clj/rems/db/testing.clj
@@ -13,14 +13,19 @@
   (mount/stop) ;; during interactive development, app might be running when tests start. we need to tear it down
   (mount/start-with-args {:test true}
                          #'rems.config/env
-                         #'rems.db.core/*db*
-                         #'rems.api.applications-v2/all-applications-cache
-                         #'rems.db.dynamic-roles/dynamic-roles-cache)
+                         #'rems.db.core/*db*)
   (db/assert-test-database!)
   (migrations/migrate ["reset"] {:database-url (:test-database-url env)})
   (f)
   (mount/stop))
 
+(defn caches-fixture [f]
+  ;; no specific teardown. relies on the teardown of test-db-fixture.
+  (mount/start #'rems.api.applications-v2/application-cache
+               #'rems.api.applications-v2/all-applications-cache
+               #'rems.db.dynamic-roles/dynamic-roles-cache)
+  (f))
+
 (defn test-data-fixture [f]
   ;; no specific teardown for test-data-fixture. tests rely on the
   ;; setup of test-db-fixture or the teardown of rollback-db-fixture
diff --git a/test/clj/rems/test_performance.clj b/test/clj/rems/test_performance.clj
index 6eaa7ac5c..1b9b36294 100644
--- a/test/clj/rems/test_performance.clj
+++ b/test/clj/rems/test_performance.clj
@@ -1,44 +1,42 @@
-(ns ^:integration rems.test-performance
+(ns rems.test-performance
   (:require [clj-memory-meter.core :as mm]
+            [criterium.core :as criterium]
             [medley.core :refer [map-vals]]
             [mount.core :as mount]
             [rems.api.applications-v2 :as applications-v2]
             [rems.api.reviews :as reviews]
-            [rems.db.dynamic-roles :as dynamic-roles]))
+            [rems.db.dynamic-roles :as dynamic-roles])
+  (:import [java.util Locale]))
 
-(defn duration-millis [f]
-  (let [start (System/nanoTime)
-        _ (f)
-        end (System/nanoTime)]
-    (/ (- end start) 1000000.0)))
-
-(defn run-benchmark [benchmark iterations]
+(defn run-benchmark [benchmark]
+  (println "\n=====" (:name benchmark) "=====")
   ((:setup benchmark))
-  (doall (for [_ (range iterations)]
-           (duration-millis (:benchmark benchmark)))))
-
-(defn statistics [measurements]
-  (let [measurements (sort measurements)]
-    {:min (first measurements)
-     :median (nth measurements (quot (count measurements) 2))
-     :max (last measurements)}))
+  (let [result (criterium/with-progress-reporting
+                 (criterium/quick-benchmark ((:benchmark benchmark)) {}))]
+    (criterium/report-result result)
+    ;(clojure.pprint/pprint (dissoc result :results))
+    {:name (:name benchmark)
+     :mean (first (:mean result))
+     :high (first (:upper-q result))
+     :low (first (:lower-q result))}))
 
-(defn run-benchmarks [iterations benchmarks]
-  ;; warmup
-  (doseq [benchmark benchmarks]
-    (run-benchmark benchmark iterations))
-  ;; actual measurements
-  (doseq [benchmark benchmarks]
-    (let [measurements (run-benchmark benchmark iterations)]
-      (println (:name benchmark)
-               (->> (statistics measurements)
-                    (map-vals #(format "%.3fms" %)))))))
+(defn run-benchmarks [benchmarks]
+  (let [results (doall (for [benchmark benchmarks]
+                         (run-benchmark benchmark)))
+        longest-name (->> results (map :name) (map count) (apply max))
+        right-pad (fn [s length]
+                    (apply str s (repeat (- length (count s)) " ")))]
+    (println "\n===== Summary =====")
+    (doseq [result results]
+      (println (right-pad (:name result) longest-name)
+               (->> (select-keys result [:low :mean :high])
+                    (map-vals #(String/format Locale/ENGLISH "%.3f ms" (to-array [(* 1000 %)]))))))))
 
-(comment
+(defn benchmark-get-all-applications []
   (let [test-get-all-unrestricted-applications #(doall (applications-v2/get-all-unrestricted-applications))
         test-get-all-applications #(doall (applications-v2/get-all-applications "alice"))
         test-get-own-applications #(doall (applications-v2/get-own-applications "alice"))
-        ;; developer can view much more applications than alice, so it takes longer to filter them
+        ;; developer can view much more applications than alice, so it takes longer to filter reviews from all apps
         test-get-open-reviews #(doall (reviews/get-open-reviews "developer"))
         no-cache (fn []
                    (mount/stop #'applications-v2/all-applications-cache))
@@ -46,23 +44,24 @@
                  (mount/stop #'applications-v2/all-applications-cache)
                  (mount/start #'applications-v2/all-applications-cache)
                  (test-get-all-unrestricted-applications))]
-    (run-benchmarks 5 [{:name "get-all-unrestricted-applications, no cache"
-                        :setup no-cache
-                        :benchmark test-get-all-unrestricted-applications}
-                       {:name "get-all-unrestricted-applications, cached"
-                        :setup cached
-                        :benchmark test-get-all-unrestricted-applications}
-                       {:name "get-all-applications, cached"
-                        :setup cached
-                        :benchmark test-get-all-applications}
-                       {:name "get-own-applications, cached"
-                        :setup cached
-                        :benchmark test-get-own-applications}
-                       {:name "get-open-reviews, cached"
-                        :setup cached
-                        :benchmark test-get-open-reviews}])
-    (println "cache size" (mm/measure applications-v2/all-applications-cache)))
+    (run-benchmarks [{:name "get-all-unrestricted-applications, no cache"
+                      :setup no-cache
+                      :benchmark test-get-all-unrestricted-applications}
+                     {:name "get-all-unrestricted-applications, cached"
+                      :setup cached
+                      :benchmark test-get-all-unrestricted-applications}
+                     {:name "get-all-applications, cached"
+                      :setup cached
+                      :benchmark test-get-all-applications}
+                     {:name "get-own-applications, cached"
+                      :setup cached
+                      :benchmark test-get-own-applications}
+                     {:name "get-open-reviews, cached"
+                      :setup cached
+                      :benchmark test-get-open-reviews}])
+    (println "cache size" (mm/measure applications-v2/all-applications-cache))))
 
+(defn benchmark-get-application []
   (let [test-get-application #(applications-v2/get-application "developer" 12)
         no-cache (fn []
                    (mount/stop #'applications-v2/application-cache))
@@ -70,14 +69,15 @@
                  (mount/stop #'applications-v2/application-cache)
                  (mount/start #'applications-v2/application-cache)
                  (test-get-application))]
-    (run-benchmarks 100 [{:name "get-application, no cache"
-                          :setup no-cache
-                          :benchmark test-get-application}
-                         {:name "get-application, cached"
-                          :setup cached
-                          :benchmark test-get-application}])
-    (println "cache size" (mm/measure applications-v2/application-cache)))
+    (run-benchmarks [{:name "get-application, no cache"
+                      :setup no-cache
+                      :benchmark test-get-application}
+                     {:name "get-application, cached"
+                      :setup cached
+                      :benchmark test-get-application}])
+    (println "cache size" (mm/measure applications-v2/application-cache))))
 
+(defn benchmark-get-dynamic-roles []
   (let [test-get-roles #(doall (dynamic-roles/get-roles "developer"))
         no-cache (fn []
                    (mount/stop #'dynamic-roles/dynamic-roles-cache))
@@ -85,10 +85,19 @@
                  (mount/stop #'dynamic-roles/dynamic-roles-cache)
                  (mount/start #'dynamic-roles/dynamic-roles-cache)
                  (test-get-roles))]
-    (run-benchmarks 5 [{:name "get-roles, no cache"
-                        :setup no-cache
-                        :benchmark test-get-roles}
-                       {:name "get-roles, cached"
-                        :setup cached
-                        :benchmark test-get-roles}])
+    (run-benchmarks [{:name "get-roles, no cache"
+                      :setup no-cache
+                      :benchmark test-get-roles}
+                     {:name "get-roles, cached"
+                      :setup cached
+                      :benchmark test-get-roles}])
     (println "cache size" (mm/measure dynamic-roles/dynamic-roles-cache))))
+
+(comment
+  ;; Note: If clj-memory-meter throws InaccessibleObjectException on Java 9+,
+  ;;       you *could* work around it by adding `--add-opens` JVM options, but
+  ;;       the root cause is probably that there is a lazy sequence that could
+  ;;       easily be avoided.
+  (benchmark-get-all-applications)
+  (benchmark-get-application)
+  (benchmark-get-dynamic-roles))