diff --git a/src/clj/rems/main.clj b/src/clj/rems/main.clj index 3de05890d..4b7365fe6 100644 --- a/src/clj/rems/main.clj +++ b/src/clj/rems/main.clj @@ -10,6 +10,7 @@ [mount.core :as mount] [rems.application.search :as search] [rems.common.git :as git] + [rems.common.util :refer [not-blank]] [rems.config :refer [env]] [rems.db.api-key] [rems.db.applications] @@ -24,6 +25,7 @@ [rems.service.fix-userid] [rems.service.test-data :as test-data] [rems.service.users] + [rems.user-simulator] [rems.validate :as validate]) (:import [sun.misc Signal SignalHandler] [org.eclipse.jetty.server.handler.gzip GzipHandler]) @@ -146,7 +148,10 @@ Example regex: /api/applications/[0-9]+/? \"api-key allow-all \" -- clears the allowed method/path whitelist. An empty list means all methods and paths are allowed. - \"rename-user \" -- change a user's identity from old to new" + \"rename-user \" -- change a user's identity from old to new + \"user-simulator \" -- start user simulator that runs concurrent headless browser instances against target REMS. + is target REMS (e.g. http://localhost:3000). + is an comma-separated list of user ids (e.g. alice,elsa,frank). Each user is simulated in separate thread." [& args] (try (exit-on-signals!) @@ -300,6 +305,13 @@ (rems.service.fix-userid/fix-all old-userid new-userid simulate?) (println "Finished.\n\nConsider rebooting the server process next to refresh all the caches, most importantly the application cache."))))) + "user-simulator" + (let [[_ url users] args] + (rems.user-simulator/start! {:url url + :users (when (not-blank users) + (mapv str/trim (str/split users #",")))}) + (.addShutdownHook (Runtime/getRuntime) (Thread. rems.user-simulator/stop!))) + (do (println "Unrecognized argument:" (first args)) (usage) diff --git a/src/clj/rems/user_simulator.clj b/src/clj/rems/user_simulator.clj new file mode 100644 index 000000000..7a9ce9157 --- /dev/null +++ b/src/clj/rems/user_simulator.clj @@ -0,0 +1,217 @@ +(ns rems.user-simulator + "Namespace for simulating actual user interactions with in REMS, allowing + automated testing of user behavior. Simulations run in a headless browser + using etaoin with chromedriver, and can be configured via the command line + interface (CLI). Various user scenarios are implemented as functions in this + namespace, enabling flexible testing of different workflows. Multiple + simulations can run concurrently to test system performance and user load. + + User simulator can be started from CLI with e.g. Leiningen: + - `lein run user-simulator` (uses default values), or + - `lein run user-simulator http://localhost:3000/ alice,elsa,frank` when replacing default values" + (:require [clj-http.client :as http] + [clojure.pprint] + [clojure.string :as str] + [clojure.tools.logging.readable :as logr] + [etaoin.api :as et] + [mount.core :as mount] + [muuntaja.core :as muuntaja] + [rems.browser-test-util :as btu] + [rems.common.util :refer [rand-nth*]] + [rems.config] + [rems.concurrency :as concurrency] + [rems.json :as json] + [rems.logging :refer [with-mdc]])) + + +;;; threadpool + + +(def ^:private thread-pool (atom nil)) + +(defn- submit-all [& fns] + (let [pool (or @thread-pool + (reset! thread-pool (concurrency/cached-thread-pool {:thread-prefix "user-simulator"})))] + (concurrency/submit! pool fns))) + +(def task-counter (atom 0)) +(def restart-queue (atom [])) + +(defn create-simulator-task [{:keys [actions url user-id] :as opts}] + (logr/info #'create-simulator-task opts) + (binding [btu/*test-context* (atom (assoc (btu/create-test-context) + :url url)) + btu/screenshot (constantly nil) + btu/screenshot-element (constantly nil) + btu/check-axe (constantly nil) + btu/postmortem-handler (constantly nil)] + (bound-fn simulate-user [] + (try + (logr/info "Simulator thread starting") + (btu/init-driver! :chrome (btu/get-server-url)) + (btu/context-assoc! :user-id user-id) + + (while true + (Thread/sleep (+ 200 (rand-int 300))) + + (when (btu/running?) + (let [action-var (rand-nth actions) + action (var-get action-var) + task-id (swap! task-counter inc)] + (btu/context-assoc! :task-id task-id) + (with-mdc {:userid user-id + :request-id task-id} + (et/delete-cookies (btu/get-driver)) + (btu/go (btu/get-server-url)) + (et/refresh (btu/get-driver)) + (btu/scroll-and-click [{:css ".language-switcher"} {:fn/text "EN"}]) ; make sure language is stable + (action))))) + + (catch InterruptedException e + (.interrupt (Thread/currentThread)) + (logr/info e "Simulator thread interrupted")) + (catch Throwable t + (logr/error t "Internal error" (with-out-str + (clojure.pprint/pprint (merge {::context @(btu/test-ctx)} + (ex-data t))))) + (swap! restart-queue conj opts)) + (finally + (logr/info "Simulator thread shutting down") + (some-> (btu/get-driver) + et/stop-driver)))))) + + +;;; api utils + + +(defn- parse-transit [x] + (muuntaja/decode json/muuntaja "application/transit+json" x)) + +(defn- join-url [base path] + (let [base (cond-> base + (str/ends-with? base "/") + (subs 0 (dec (count base)))) + path (cond-> path + (str/starts-with? path "/") + (subs 1))] + (str base "/" path))) + +(comment + (= "http://localhost:3000/api/applications" + (join-url "http://localhost:3000" "api/applications") + (join-url "http://localhost:3000" "/api/applications") + (join-url "http://localhost:3000/" "api/applications") + (join-url "http://localhost:3000/" "/api/applications"))) + +(defn- api-get [path & [{:keys [api-key user-id]}]] + (let [url (join-url (btu/get-server-url) path) + response (http/get url {:accept :transit+json + :headers {"x-rems-api-key" (or api-key 42) + "x-rems-user-id" (or user-id (btu/context-getx :user-id))}})] + (parse-transit (:body response)))) + +(defn- query-my-applications [] + (let [user-id (btu/context-getx :user-id)] + (->> (api-get "/api/applications") + (filter #(= user-id (get-in % [:application/applicant :userid]))) + (mapv :application/id)))) + + +;;; etaoin utils + + +(defn login-as [username] + (btu/go (btu/get-server-url)) + (btu/scroll-and-click {:css ".login-btn"}) + (when (btu/visible? :show-special-users) ; sometimes the user is in the hidden part + (btu/scroll-and-click :show-special-users)) + (btu/scroll-and-click [{:css ".users"} {:tag :a :fn/text username}]) + (btu/wait-visible :logout)) + +(defn logout [] + (btu/scroll-and-click :logout) + (btu/wait-visible {:css ".login-component"})) + +(defn click-navigation-menu [link-text] + (btu/scroll-and-click [:big-navbar {:tag :a :fn/text link-text}])) + +(defn go-to-application [application-id] + (click-navigation-menu "Applications") + (btu/wait-visible {:tag :h1 :fn/text "Applications – REMS"}) + (btu/wait-page-loaded) + (btu/scroll-and-click [:my-applications + {:css (format "tr[data-row='%s'] > td.view a" application-id)}]) + (btu/wait-page-loaded)) + + +;;; simulations + + +(defn user-views-applications + "Simulation flow where + - user logs in, + - user visits random application pages (that user is applying for) + - user logs out." + [] + (logr/info "login") + (login-as (btu/context-getx :user-id)) + (loop [n 0] + (Thread/sleep 1000) + (btu/context-assoc! :my-applications (query-my-applications)) + (btu/context-assoc! :application-id (rand-nth* (btu/context-getx :my-applications))) + (cond + (>= n 100) + (do (logr/info "logout") + (logout)) + + (not (btu/context-getx :application-id)) + (do (logr/warnf "No applications found for user %s" (btu/context-getx :user-id)) + (recur (inc n))) + + :else + (let [start (System/currentTimeMillis)] + (logr/infof "> view application %s/%s, id %s" n 100 (btu/context-getx :application-id)) + (go-to-application (btu/context-getx :application-id)) + (logr/infof "< view application %s/%s, id %s (%sms)" n 100 (- (System/currentTimeMillis) start) (btu/context-getx :application-id)) + (recur (inc n)))))) + + +;;; core logic + + +(def all-actions [#'user-views-applications]) + +(defn- queue-simulate-tasks! [opts] + (assert (seq (:users opts)) "no users to simulate?") + (assert (seq (:actions opts)) "no actions to simulate?") + (assert (:url opts) "missing target REMS url") + (logr/info 'queue-simulate-tasks :start opts) + (submit-all (vec (for [user-id (:users opts) + :let [task-opts {:actions (:actions opts) + :url (:url opts) + :user-id user-id}]] + (create-simulator-task task-opts)))) + (add-watch restart-queue :task-daemon (fn [_key q _old-state new-state] + (when (seq new-state) + (submit-all (mapv create-simulator-task new-state)) + (reset! q []))))) + +(defn start! [& [{:keys [actions url users]}]] + (mount/start #'rems.config/env) + (queue-simulate-tasks! {:actions (or (seq actions) all-actions) + :url (or url "http://localhost:3000/") + :users (or (seq users) ["alice" "elsa" "frank"])})) + +(defn stop! [] + (remove-watch restart-queue :task-daemon) + (some-> @thread-pool concurrency/shutdown-now!)) + +(comment + ;; can also be started from command line, like: + ;; "lein run user-simulator http://localhost:3000/ alice,elsa,frank" + (start!) + (start! {:actions [#'user-views-applications] + :url "https://rems-dev.2.rahtiapp.fi/" + :users ["alice"]}) + + (stop!)) diff --git a/src/cljc/rems/common/util.cljc b/src/cljc/rems/common/util.cljc index 967bb41af..ae847d749 100644 --- a/src/cljc/rems/common/util.cljc +++ b/src/cljc/rems/common/util.cljc @@ -724,3 +724,9 @@ "Like `clojure.core/range`, but starts from 1 and `end` is inclusive." [end] (range 1 (inc end))) + +(defn rand-nth* + "As (rand-nth), but returns nil if (seq coll) is nil." + [coll] + (some-> (seq coll) + (rand-nth))) diff --git a/test/clj/rems/api/testing.clj b/test/clj/rems/api/testing.clj index e00617dbc..926f9e668 100644 --- a/test/clj/rems/api/testing.clj +++ b/test/clj/rems/api/testing.clj @@ -11,7 +11,6 @@ [rems.handler :refer :all] [rems.locales] [rems.middleware] - [rems.main] [ring.mock.request :refer :all] [rems.json :as json])) diff --git a/test/clj/rems/browser_test_util.clj b/test/clj/rems/browser_test_util.clj index 97710d9a3..738a5cdc2 100644 --- a/test/clj/rems/browser_test_util.clj +++ b/test/clj/rems/browser_test_util.clj @@ -21,7 +21,6 @@ [rems.db.test-data-users :as test-users] [rems.service.test-data :as test-data] [rems.json :as json] - [rems.main] [rems.testing-util :refer [get-current-test-name]] [rems.util :refer [ensure-empty-directory!]] [slingshot.slingshot :refer [try+]]) @@ -58,9 +57,9 @@ (defn context-get [k] (test-ctx :test-data k)) (defn context-getx [k] (getx (test-ctx :test-data) k)) -(defn context-update! [& args] (apply swap! (test-ctx) update :test-data args)) -(defn context-assoc! [& args] (apply context-update! assoc args)) -(defn context-dissoc! [& args] (apply context-update! dissoc args)) +(defn context-update! [f & args] (apply swap! (test-ctx) update :test-data f args)) +(defn context-assoc! [k v & kvs] (apply context-update! assoc k v kvs)) +(defn context-dissoc! [k & ks] (apply context-update! dissoc k ks)) (defn- ensure-empty-directories! [] (ensure-empty-directory! (test-ctx :reporting-dir)) @@ -327,7 +326,7 @@ (get-sequence-number) (get-current-test-name))) -(defn screenshot [filename] +(defn ^:dynamic screenshot [filename] (let [driver (get-driver) _ (wait-for-idle driver 500) full-filename (str (get-file-base) filename ".png") @@ -355,7 +354,7 @@ (when need-to-adjust? (et/set-window-rect driver window-size)))) -(defn screenshot-element [filename q] +(defn ^:dynamic screenshot-element [filename q] (let [full-filename (format "%03d-%s-%s" (get-sequence-number) (get-current-test-name) @@ -389,6 +388,9 @@ {:explanation (explainer)})) ex))))) +(defn running? [] + (et/running? (get-driver))) + (defn wrap-etaoin [f] (fn [& args] (apply f (get-driver) args))) @@ -581,7 +583,7 @@ ['body > div:not(#app)']] }).then(callback);") -(defn check-axe +(defn ^:dynamic check-axe "Runs automated accessibility tests using axe. Returns the test report. @@ -662,7 +664,7 @@ (defn autosave-enabled? [] (get env :enable-autosave false)) -(defn postmortem-handler +(defn ^:dynamic postmortem-handler "Simplified version of `etaoin.api/postmortem-handler`" [ex] (let [driver (get-driver) diff --git a/test/clj/rems/test_browser.clj b/test/clj/rems/test_browser.clj index 20ae4792e..6c41e4418 100644 --- a/test/clj/rems/test_browser.clj +++ b/test/clj/rems/test_browser.clj @@ -29,7 +29,6 @@ [rems.db.test-data-helpers :as test-helpers] [rems.db.testing :refer [save-cache-statistics!]] [rems.db.user-settings] - [rems.main] [rems.testing-util :refer [with-user with-fake-login-users]] [rems.text :refer [localize-time text with-language]]))