Merge pull request #5336 from dsimmer/performance_tests

Performance tests and improvements

project.clj

@@ -9,6 +9,7 @@
                  [org.clojure/clojurescript "1.10.238"]
                  [org.clojure/core.async "0.3.443"]
                  [cheshire "5.6.3"]
+                 [stylefruits/gniazdo "1.1.4"]
                  [danhut/monger "3.1.0"]
                  [differ "0.3.3"]
                  [com.taoensso/sente "1.11.0"]
@@ -54,6 +55,7 @@
   :aliases {"fetch" ["run" "-m" "tasks.fetch/command"]
             "dumbrepl" ["trampoline" "run" "-m" "clojure.main/main"]
             "add-art" ["run" "-m" "tasks.altart/add-art"]
+            "load-test" ["run" "-m" "tasks.load-test/command"]
             "delete-duplicate-users" ["run" "-m" "tasks.db/delete-duplicate-users"]
             "update-all-decks" ["run" "-m" "tasks.db/update-all-decks"]
             "card-coverage" ["run" "-m" "tasks.cards/test-coverage"]}

src/clj/tasks/load_test.clj

@@ -0,0 +1,121 @@
+(ns tasks.load-test
+  "Load test for large numbers of websockets"
+  (:require [clojure.string :refer [join]]
+            [web.db :refer [db] :as webdb]
+            [gniazdo.core :as ws]
+            [clj-uuid :as uuid]
+            [org.httpkit.client :as http]
+            [crypto.password.bcrypt :as password]
+            [monger.collection :as mc]
+            [web.core :refer [-main]]
+            [web.game :refer [handle-game-start]]
+            [web.lobby :refer [handle-lobby-create handle-lobby-join handle-lobby-watch all-games]]))
+
+;; This print guarantees a coherent print (i.e. parallel prints will not be interleaved)
+(defn safe-println [& more]
+  (.write *out* (str (join " " more) "\n")))
+
+(defn add-test-users [maxUsers]
+  (webdb/connect)
+  (when (not (mc/find-one-as-map db "users" {:username "TestCorp"}))
+    (mc/insert db "users" {:username "TestCorp"
+                           :email "[email protected]"
+                           :password (password/encrypt "password")
+                           :isadmin false
+                           :options {}}))
+
+  (when (not (mc/find-one-as-map db "users" {:username "TestRunner"}))
+    (mc/insert db "users" {:username "TestRunner"
+                           :email "[email protected]"
+                           :password (password/encrypt "password")
+                           :isadmin false
+                           :options {}}))
+  (doall
+    (pmap
+      (fn [n]
+        (when (not (mc/find-one-as-map db "users" {:username (str "TestUser" n)}))
+          (mc/insert db "users" {:username (str "TestUser" n)
+                                 :email (str "TestUser" n "@mailinator.com")
+                                 :password (password/encrypt "password")
+                                 :isadmin false
+                                 :options {}})))
+      (range maxUsers))))
+
+(defn login
+  [username password]
+  (let [options {:form-params {:username username
+                               :password password}}
+        {:keys [status error headers]} @(http/post "http://localhost:1042/login" options)]
+    (if (or error (= 401 status))
+      (println "Failed, exception is " (or error status))
+      (:set-cookie headers))))
+
+(defn create-game
+  [maxUsers]
+  (let [client (ws/client)
+        corp-client-id (uuid/to-string (uuid/v1))
+        runner-client-id (uuid/to-string (uuid/v1))]
+    (safe-println "Login with test users")
+    (.setMaxTextMessageSize (.getPolicy client) (* 1024 1024))
+    (.start client)
+
+    (ws/connect (str "ws://localhost:1042/ws?client-id=" corp-client-id)
+                :client client
+                :on-error #(safe-println "corp error" %)
+                :on-connect (fn [n] (safe-println "Corp Connected"))
+                :on-close (fn [x y] (safe-println "Corp Disconnected"))
+                :headers {"Cookie" (login "TestCorp" "password")})
+    (ws/connect (str "ws://localhost:1042/ws?client-id=" runner-client-id)
+                :client client
+                :on-error #(safe-println "runner error" %)
+                :on-connect (fn [n] (safe-println "Runner Connected"))
+                :on-close (fn [x y] (safe-println "Runner Disconnected"))
+                :headers {"Cookie" (login "TestRunner" "password")})
+    (safe-println "Create lobby")
+    (handle-lobby-create {:ring-req {:user {:username "TestCorp"}}
+                          :client-id corp-client-id
+                          :?data {:title "Performance Game"
+                                  :format "standard"
+                                  :allow-spectator true
+                                  :spectatorhands false
+                                  :password ""
+                                  :room "casual"
+                                  :side "Corp"
+                                  :options {}}})
+
+    (let [game-id (first (first @all-games))]
+      (handle-lobby-join {:ring-req {:user {:username "TestRunner"}}
+                            :client-id runner-client-id
+                            :?data {:gameid game-id
+                                    :password ""}})
+
+      (doall
+        (pmap
+          (fn [n]
+            (let [userClientID (uuid/to-string (uuid/v1))
+                  socket (ws/connect (str "ws://localhost:1042/ws?client-id=" userClientID)
+                                     :client client
+                                     :on-error #(safe-println "spectator error" %)
+                                     :on-close #(safe-println 'closed %1 %2)
+                                     :headers {"Cookie" (login (str "TestUser" n) "password")})]
+              (handle-lobby-watch {:ring-req {:user {:username (str "TestUser" n)}}
+                                    :client-id userClientID
+                                    :?data {:gameid game-id
+                                            :password ""}})
+              socket))
+          (range maxUsers)))
+
+      (safe-println "Spectators connected")
+      (handle-game-start {:ring-req {:user {:username "TestCorp"}}
+                          :client-id corp-client-id})
+      (safe-println "Started game"))))
+
+(defn command
+  []
+  (-main "dev")
+
+  (def maxUsers 1000)
+  (add-test-users maxUsers)
+  (safe-println "Users created")
+
+  (create-game maxUsers))

src/clj/web/chat.clj

@@ -53,8 +53,7 @@
           (update inserted :_id str))
         (do
           (when client-id
-            (ws/send! client-id [:chat/blocked
-                                 {:reason (if len-valid :rate-exceeded :length-exceeded)}]))
+            (ws/broadcast-to! [client-id] :chat/blocked {:reason (if len-valid :rate-exceeded :length-exceeded)}))
           nil)))))
 
 (defn broadcast-msg

src/clj/web/core.clj

@@ -76,7 +76,7 @@
 
     ;; Clear inactive lobbies after 30 minutes
     (web.utils/tick #(lobby/clear-inactive-lobbies 1800) 1000)
-    (web.utils/tick lobby/send-lobby 1000)
+    (web.utils/tick lobby/reset-send-lobby 1000)
 
     (reset! server (org.httpkit.server/run-server app {:port port}))
     (println "Jinteki server running in" @server-mode "mode on port" port)

src/clj/web/diffs.clj

@@ -18,12 +18,18 @@
             (assoc p :deck deck))
           p)))
 
-(defn game-public-view
+(defn update-if-contains
+  [m ks f & args]
+  (if (get m ks)
+    (apply (partial update m ks f) args)
+    m))
+
+(defn game-internal-view
   "Strips private server information from a game map, preparing to send the game to clients."
-  [game]
-  (-> game
-      (dissoc :state :last-update :on-close)
-      (update :players #(map (partial user-public-view game) %))
-      (update :original-players #(map (partial user-public-view game) %))
-      (update :ending-players #(map (partial user-public-view game) %))
-      (update :spectators #(map (partial user-public-view game) %))))
+  [full-game game-update]
+    (-> game-update
+        (dissoc :state :last-update :on-close)
+        (update-if-contains :players #(map (partial user-public-view full-game) %))
+        (update-if-contains :original-players #(map (partial user-public-view full-game) %))
+        (update-if-contains :spectators #(map (partial user-public-view full-game) %))
+        (update-if-contains :ending-players #(map (partial user-public-view full-game) %))))

src/clj/web/game.clj

@@ -1,7 +1,6 @@
 (ns web.game
   (:require [web.ws :as ws]
             [web.lobby :refer [all-games old-states already-in-game? spectator?] :as lobby]
-            [web.diffs :refer [game-public-view]]
             [web.utils :refer [response]]
             [web.stats :as stats]
             [game.main :as main]
@@ -20,41 +19,46 @@
   [{:keys [gameid players spectators] :as game}
    {:keys [type runner-diff corp-diff spect-diff] :as diffs}]
   (doseq [{:keys [ws-id side] :as pl} players]
-    (ws/send! ws-id [:netrunner/diff (json/generate-string
-                                       {:gameid gameid
-                                        :diff (if (= side "Corp")
-                                                corp-diff
-                                                runner-diff)})]))
-  (doseq [{:keys [ws-id] :as pl} spectators]
-    (ws/send! ws-id [:netrunner/diff (json/generate-string
-                                       {:gameid gameid
-                                        :diff spect-diff})])))
+    (ws/broadcast-to! [ws-id] :netrunner/diff (json/generate-string {:gameid gameid
+                                                                     :diff (if (= side "Corp")
+                                                                              corp-diff
+                                                                              runner-diff)})))
+  (ws/broadcast-to! (map #(:ws-id %) spectators)
+                    :netrunner/diff
+                    (json/generate-string {:gameid gameid
+                                           :diff spect-diff})))
 
 (defn send-state!
-  "Sends full states generated by public-states to all connected clients."
-  ([game states]
-   (send-state! :netrunner/state game states))
+  "Sends full states generated by public-states to either the client specified or all connected clients."
+  ([event
+    {:keys [gameid players spectators] :as game}
+    {:keys [type runner-state corp-state spect-state] :as states}
+    ws-id]
+   (let [player (some #(= (:ws-id %) ws-id) players)]
+     (ws/broadcast-to! [ws-id] event (json/generate-string {:gameid gameid
+                                                            :state (if player
+                                                                      (if (= (:side player) "Corp")
+                                                                        corp-state
+                                                                        runner-state)
+                                                                      spect-state)}))))
 
   ([event
     {:keys [gameid players spectators] :as game}
     {:keys [type runner-state corp-state spect-state] :as states}]
    (doseq [{:keys [ws-id side] :as pl} players]
-     (ws/send! ws-id [event (json/generate-string
-                              {:gameid gameid
-                               :state (if (= side "Corp")
-                                        corp-state
-                                        runner-state)})]))
-   (doseq [{:keys [ws-id] :as pl} spectators]
-     (ws/send! ws-id [event (json/generate-string
-                              {:gameid gameid
-                               :state spect-state})]))))
+     (ws/broadcast-to! [ws-id] event (json/generate-string {:gameid gameid
+                                                            :state (if (= side "Corp")
+                                                                      corp-state
+                                                                      runner-state)})))
+   (ws/broadcast-to! (map #(:ws-id %) spectators) event (json/generate-string {:gameid gameid
+                                                                               :state spect-state}))))
 
 (defn swap-and-send-state!
   "Updates the old-states atom with the new game state, then sends a :netrunner/state
   message to game clients."
   [{:keys [gameid state] :as game}]
   (swap! old-states assoc gameid @state)
-  (send-state! game (public-states state)))
+  (send-state! :netrunner/state game (public-states state)))
 
 (defn swap-and-send-diffs!
   "Updates the old-states atom with the new game state, then sends a :netrunner/diff
@@ -95,10 +99,9 @@
                           :last-update start-date
                           :state (core/init-game g))
                    (update-in g [:players] #(mapv strip-deck %)))]
-        (swap! all-games assoc gameid game)
-        (swap! old-states assoc gameid @(:state game))
         (stats/game-started game)
-        (lobby/refresh-lobby :update gameid)
+        (lobby/refresh-lobby gameid game)
+        (swap! old-states assoc gameid @(:state game))
         (send-state! :netrunner/start game (public-states (:state game)))))))
 
 (defn handle-game-leave
@@ -125,12 +128,11 @@
       (let [player (lobby/join-game user client-id gameid)
             side (keyword (str (.toLowerCase (:side player)) "-state"))]
         (main/handle-rejoin state (:user player))
-        (lobby/refresh-lobby :update gameid)
-        (ws/send! client-id [:lobby/select {:gameid gameid
-                                            :started started
-                                            :state (json/generate-string
-                                                     (side (public-states (:state game))))}])
-        (swap-and-send-state! (lobby/game-for-id gameid))))))
+        (ws/broadcast-to! [client-id] :lobby/select {:gameid gameid
+                                                     :started started
+                                                     :state (json/generate-string (side (public-states (:state game))))})
+        (send-state! :netrunner/state (lobby/game-for-id gameid) (public-states (:state game)) client-id)
+        (swap-and-send-diffs! (lobby/game-for-id gameid))))))
 
 (defn handle-game-concede
   [{{{:keys [username] :as user} :user} :ring-req
@@ -153,13 +155,9 @@
           {:keys [started state] :as game} (lobby/game-for-id gameid)
           message (if mute-state "muted" "unmuted")]
       (when (lobby/player? client-id gameid)
-        (swap! all-games assoc-in [gameid :mute-spectators] mute-state)
+        (lobby/refresh-lobby-assoc-in gameid [:mute-spectators] mute-state)
         (main/handle-notification state (str username " " message " specatators."))
-        (lobby/refresh-lobby :update gameid)
-        (swap-and-send-diffs! game)
-        (ws/broadcast-to! (lobby/lobby-clients gameid)
-                          :games/diff
-                          {:diff {:update {gameid (game-public-view (lobby/game-for-id gameid))}}})))))
+        (swap-and-send-diffs! game)))))
 
 (defn handle-game-action
   [{{{:keys [username] :as user} :user}       :ring-req
@@ -173,7 +171,7 @@
       (if (and state side)
         (do
           (main/handle-action user command state (side-from-str side) args)
-          (swap! all-games assoc-in [gameid :last-update] (t/now))
+          (lobby/refresh-lobby-assoc-in gameid [:last-update] (t/now))
           (swap-and-send-diffs! game))
         (when-not spectator
           (println "handle-game-action unknown state or side")
@@ -202,13 +200,14 @@
                      (bcrypt/check password game-password)))
           (let [{:keys [spect-state]} (public-states state)]
             ;; Add as a spectator, inform the client that this is the active game,
-            ;; add a chat message, then send full states to all players.
-            ; TODO: this would be better if a full state was only sent to the new spectator, and diffs sent to the existing players.
+            ;; Send existing state to spectator
+            ;; add a chat message, then send diff state to all players.
             (lobby/spectate-game user client-id gameid)
             (main/handle-notification state (str username " joined the game as a spectator."))
-            (ws/send! client-id [:lobby/select {:gameid gameid
-                                                :started started}])
-            (swap-and-send-state! (lobby/game-for-id gameid))
+            (ws/broadcast-to! [client-id] :lobby/select {:gameid gameid
+                                                         :started started})
+            (send-state! :netrunner/state (lobby/game-for-id gameid) (public-states (:state game)) client-id)
+            (swap-and-send-diffs! (lobby/game-for-id gameid))
             (when reply-fn (reply-fn 200))
             true)
           (when reply-fn
@@ -232,7 +231,7 @@
         (let [{:keys [user]} (lobby/spectator? client-id gameid)]
           (when (and user (not mute-spectators))
             (main/handle-say state :spectator user msg)
-            (swap! all-games assoc-in [gameid :last-update] (t/now))
+            (lobby/refresh-lobby-assoc-in gameid [:last-update] (t/now))
             (try
               (swap-and-send-diffs! game)
               (catch Exception ex