Skip to content

Commit

Permalink
wip: task recovery
Browse files Browse the repository at this point in the history
  • Loading branch information
@aatkin
aatkin committed Nov 6, 2024
1 parent ba5147c commit 532ab5f
Show file tree
Hide file tree
Showing 2 changed files with 44 additions and 18 deletions.
3 changes: 2 additions & 1 deletion src/clj/rems/main.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -317,7 +317,8 @@

"user-simulator"
(let [[_ url users] args]
(start-user-simulator {:url url
(start-user-simulator {:actions rems.user-simulator/all-actions
:url url
:users (mapv str/trim (str/split users #","))}))

(do
Expand Down
59 changes: 42 additions & 17 deletions src/clj/rems/user_simulator.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -52,7 +52,7 @@
(let [user-id (btu/context-getx :user-id)]
(->> (api-get "/api/applications"
{:api-key 42 :user-id user-id})
(filter #(= user-id (-> % :applicant :userid)))
(filter #(= user-id (-> % :application/applicant :userid)))
(mapv :application/id))))

(defn- query-application [application-id]
Expand Down Expand Up @@ -83,6 +83,8 @@

(def task-counter (atom 0))

(def restart-queue (atom []))

(defn create-simulator-task [{:keys [actions url user-id] :as opts}]
(binding [btu/*test-context* (atom (assoc (btu/create-test-context)
:url url))
Expand All @@ -101,23 +103,27 @@
(when (btu/running?)
(btu/context-assoc! :task-id (swap! task-counter inc)
:user-id user-id)
(with-mdc {:userid user-id}
(logr/info "> simulate-user" (btu/context-getx :task-id))
(with-mdc {:userid user-id
:request-id (btu/context-getx :task-id)}
(et/delete-cookies (btu/get-driver))
(btu/go (btu/get-server-url))
(et/refresh (btu/get-driver))
(when-let [action (rand-nth actions)]
(if (var? action)
((var-get action))
(action)))
(logr/info "< simulate-user" (btu/context-getx :task-id)))))
(let [action-var (rand-nth actions)
title (:title (some-> action-var meta) "simulate-user")
start (System/currentTimeMillis)]
(logr/infof "> %s" title)
(when-let [action (some-> action-var var-get)]
(action))
(let [duration (- (System/currentTimeMillis) start)]
(logr/infof "< %s %sms" title duration))))))
(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))))))
(ex-data t)))))
(swap! restart-queue conj opts))
(finally
(logr/info "Simulator thread shutting down")
(some-> (btu/get-driver)
Expand Down Expand Up @@ -180,6 +186,7 @@
- user logs in,
- user visits random application page (that user is applying for)
- user logs out."
{:title "user-views-application"}
[]
(btu/context-assoc! :my-applications (query-applications))
(btu/context-assoc! :application-id (rand-nth* (btu/context-getx :my-applications)))
Expand All @@ -197,6 +204,7 @@
- users fills text fields if any exist,
- user accepts licenses,
- user logs out."
{:title "user-creates-draft"}
[]
(btu/context-assoc! :catalogue-items (query-catalogue-items))
(btu/context-assoc! :catalogue-item-id (rand-nth* (btu/context-getx :catalogue-items)))
Expand All @@ -207,6 +215,7 @@
(add-to-cart (btu/context-getx :catalogue-item-id))
(apply-for-catalogue-items)
(btu/context-assoc! :application-id (last (str/split (btu/get-url) #"/")))
(logr/infof "created application %s" (btu/context-getx :application-id))
(btu/context-assoc! :application (query-application (btu/context-getx :application-id)))
(fill-text-form-fields (btu/context-getx :application)
{:text "Hello from simulator!"
Expand All @@ -220,15 +229,16 @@
;; test chrome in headful mode
(swap! btu/global-test-context assoc :url "http://localhost:3000")
(btu/init-driver! :chrome "http://localhost:3000/" :development)
(et/quit (btu/get-driver))

(user-views-application)
(user-creates-draft))


;;; core logic

(def all-actions #{#'user-views-application
#'user-creates-draft})
(def all-actions [#'user-views-application
#'user-creates-draft])

(defn- get-simulator-opts [args]
(when-some [opts (:user-simulator args)]
Expand All @@ -240,18 +250,33 @@
(mount/defstate queue-simulate-tasks
:start (when-some [opts (get-simulator-opts (mount/args))]
(logr/info 'queue-simulate-tasks :start opts)
(submit-all (vec (for [user-id (:users opts)]
(create-simulator-task {:actions (:actions opts)
:url (:url opts)
:user-id user-id})))))
:stop (logr/info 'queue-simulate-tasks :stop))
(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 [])))))
:stop (do
(logr/info 'queue-simulate-tasks :stop)
(remove-watch restart-queue :task-daemon)))

(comment
;; can also be started from command line, like:
;; "lein run user-simulator http://localhost:3000/ alice,elsa,frank"
(mount/start-with-args {:user-simulator {:actions all-actions
:url "http://localhost:3000"
:url "http://localhost:3000/"
:users ["alice" "elsa" "frank"]}}
#'simulator-thread-pool
#'queue-simulate-tasks)

(mount/start-with-args {:user-simulator {:actions [#'user-views-application]
:url "https://rems-dev.2.rahtiapp.fi/"
:users ["alice"]}}
#'simulator-thread-pool
#'queue-simulate-tasks)

(mount/stop #'simulator-thread-pool
#'queue-simulate-tasks))

0 comments on commit 532ab5f

Please sign in to comment.