Merge pull request #6328 from jwarwick/ban

Moderation features

resources/dev.edn

@@ -31,6 +31,8 @@
  :web/auth #ig/ref :web/auth
  :web/chat #ig/ref :web/chat
  :web/email #ig/ref :web/email}
+ :web/banned-msg {:initial "Account Banned"
+ :mongo #ig/ref :mongodb/connection}
  :frontend/version {:initial "1"
  :mongo #ig/ref :mongodb/connection}
  :sente/router nil

src/clj/web/admin.clj

@@ -9,7 +9,7 @@
  [web.mongodb :refer [->object-id]]
  [web.user :refer [active-user?]]
  [web.utils :refer [response]]
- [web.versions :refer [frontend-version]]
+ [web.versions :refer [frontend-version banned-msg]]
  [web.ws :as ws]))
 
 (defmethod ws/-msg-handler :admin/announce
@@ -21,8 +21,7 @@
  (empty? message) (reply-fn 400)
  :else
  (do
- (doseq [u (app-state/get-users)
- :let [uid (:uid u)]]
+ (doseq [uid (ws/connected-uids)]
  (ws/chsk-send! uid [:lobby/toast {:message message
  :type "warning"}]))
  (reply-fn 200))))
@@ -63,6 +62,20 @@
  (response 200 {:message "ok" :version version}))
  (response 400 {:message "Missing version item"})))
 
+(defn banned-message-handler [{db :system/db}]
+ (let [config (mc/find-one-as-map db "config" nil)
+ banned (:banned-msg config "Account is locked")]
+ (response 200 {:message "ok" :banned banned})))
+
+(defn banned-message-update-handler [{db :system/db
+ {banned :banned} :body}]
+ (if-not (empty? banned)
+ (do
+ (reset! banned-msg banned)
+ (mc/update db "config" {} {$set {:banned-msg banned}})
+ (response 200 {:message "ok" :banned banned}))
+ (response 400 {:message "Missing banned message item"})))
+
 (def user-collection "users")
 
 (def user-type->field
@@ -92,7 +105,11 @@
  (-> (mc/find-one-as-map db user-collection {:username username} [:_id :username])
  (update :_id str)))]
  (if user
- (ws/broadcast-to! [uid] :admin/user-edit {:success (assoc data :user user)})
+ (do
+ (ws/broadcast-to! [uid] :admin/user-edit {:success (assoc data :user user)})
+ (when (= user-type :banned)
+ (when-let [connected-user ((:users @app-state/app-state) username)]
+ (ws/broadcast-to! [(:uid connected-user)] :system/force-disconnect {}))))
  (ws/broadcast-to! [uid] :admin/user-edit {:error "Not found"})))
  (ws/broadcast-to! [uid] :admin/user-edit {:error "Not allowed"})))
 

src/clj/web/api.clj

@@ -106,6 +106,8 @@
  ["/:id" {:delete admin/news-delete-handler}]]
  ["/version" {:get admin/version-handler
  :put admin/version-update-handler}]
+ ["/banned" {:get admin/banned-message-handler
+ :put admin/banned-message-update-handler}]
  ["/features" {:get admin/features-handler
  :put admin/features-update-handler}]]]
  {:reitit.middleware/registry

src/clj/web/app_state.clj

@@ -46,3 +46,12 @@
  "Add user to uid in app-state. Mutates."
  [uid user]
  (swap! app-state register-user uid user))
+
+(defn deregister-user!
+ "Remove user from app-state. Mutates."
+ [uid]
+ (let [users (:users @app-state)
+ _ (println "USERS" users)
+ new-users (dissoc users uid)
+ _ (println "NEW USERS" new-users)]
+ (swap! app-state #(assoc %1 :users new-users))))

src/clj/web/auth.clj

@@ -13,7 +13,8 @@
  [web.app-state :as app-state]
  [web.mongodb :refer [find-one-as-map-case-insensitive ->object-id]]
  [web.user :refer [active-user? create-user user-keys]]
- [web.utils :refer [response]])
+ [web.utils :refer [response]]
+ [web.versions :refer [banned-msg]])
  (:import
  java.security.SecureRandom))
 
@@ -98,16 +99,17 @@
  [{db :system/db
  auth :system/auth
  {:keys [username password]} :params}]
- (let [user (find-non-banned-user db {:username username})]
- (if (and user
- (password/check password (:password user)))
+ (let [user (mc/find-one-as-map db "users" {:username username})]
+ (cond
+ (and user (:banned user)) (response 403 {:error (or @banned-msg "Account Locked")})
+ (and user (password/check password (:password user)))
  (do (mc/update db "users"
  {:username username}
  {"$set" {:last-connection (inst/now)}})
  (assoc (response 200 {:message "ok"})
  :cookies {"session" (merge {:value (create-token auth user)}
  (:cookie auth))}))
- (response 401 {:error "Invalid login or password"}))))
+ :else (response 401 {:error "Invalid login or password"}))))
 
 (defn logout-handler [_]
  (assoc (response 200 {:message "ok"})

src/clj/web/chat.clj

@@ -82,7 +82,7 @@
  inserted (update inserted :_id str)
  inserted (update inserted :date #(.toString %))
  connected-users (app-state/get-users)]
- (doseq [uid (map :uid connected-users)
+ (doseq [uid (ws/connected-uids)
  :when (or (= (:username user) uid)
  (visible-to-user user {:username uid} connected-users))]
  (ws/broadcast-to! [uid] :chat/message inserted)))
@@ -102,11 +102,8 @@
  :action :delete-message
  :date (inst/now)
  :msg msg})
- (let [connected-users (app-state/get-users)]
- (doseq [uid (map :uid connected-users)
- :when (or (= (:username user) uid)
- (visible-to-user user {:username uid} connected-users))]
- (ws/broadcast-to! [uid] :chat/delete-msg msg))))))
+ (doseq [uid (ws/connected-uids)]
+ (ws/broadcast-to! [uid] :chat/delete-msg msg)))))
 
 (defmethod ws/-msg-handler :chat/delete-all
  [{{db :system/db
@@ -121,8 +118,5 @@
  :action :delete-all-messages
  :date (inst/now)
  :sender sender})
- (let [connected-users (app-state/get-users)]
- (doseq [uid (map :uid connected-users)
- :when (or (= (:username user) uid)
- (visible-to-user user {:username uid} connected-users))]
- (ws/broadcast-to! [uid] :chat/delete-all {:username sender})))))
+ (doseq [uid (ws/connected-uids)]
+ (ws/broadcast-to! [uid] :chat/delete-all {:username sender}))))

src/clj/web/lobby.clj

@@ -183,7 +183,11 @@
 (defn broadcast-lobby-list
  "Sends the lobby list to all users or a given list of users.
  Filters the list per each users block list."
- ([] (broadcast-lobby-list (app-state/get-users)))
+ ([]
+ (let [user-cache (:users @app-state/app-state)
+ uids (ws/connected-uids)
+ users (map #(get user-cache %) uids)]
+ (broadcast-lobby-list users)))
  ([users]
  (assert (or (sequential? users) (nil? users)) (str "Users must be a sequence: " (pr-str users)))
  (let [lobbies (app-state/get-lobbies)]

src/clj/web/system.clj

@@ -25,7 +25,7 @@
  [time-literals.data-readers]
  [time-literals.read-write]
  [web.angel-arena :as angel-arena]
- [web.versions :refer [frontend-version]]
+ [web.versions :refer [frontend-version banned-msg]]
  [web.api :refer [make-app make-dev-app]]
  [web.app-state :as app-state]
  [web.game]
@@ -90,6 +90,16 @@
 (defmethod ig/init-key :web/email [_ settings]
  settings)
 
+(defmethod ig/init-key :web/banned-msg [_ {initial :initial
+ {:keys [db]} :mongo}]
+ (if-let [config (mc/find-one-as-map db "config" nil)]
+ (do (reset! banned-msg (:banned-msg config))
+ config)
+ (do (doto db
+ (mc/create "config" nil)
+ (mc/insert-and-return "config" {:banned-msg initial}))
+ (reset! banned-msg initial))))
+
 (defmethod ig/init-key :frontend/version [_ {initial :initial
  {:keys [db]} :mongo}]
  (if-let [config (mc/find-one-as-map db "config" nil)]

src/clj/web/versions.clj

@@ -1,3 +1,4 @@
 (ns web.versions)
 
 (def frontend-version (atom nil))
+(def banned-msg (atom nil))

src/clj/web/ws.clj

@@ -1,7 +1,7 @@
 (ns web.ws
  (:require
  [clojure.core.async :refer [<! >! chan go timeout]]
- [web.app-state :refer [register-user!]]
+ [web.app-state :refer [register-user! deregister-user!]]
  [web.user :refer [active-user?]]
  [taoensso.sente :as sente]
  [taoensso.sente.server-adapters.http-kit :refer [get-sch-adapter]]))
@@ -11,10 +11,11 @@
  {:user-id-fn (fn [ring-req]
  (or (-> ring-req :session :uid)
  (:client-id ring-req)))})
- {:keys [ch-recv send-fn
+ {:keys [ch-recv send-fn connected-uids
  ajax-post-fn ajax-get-or-ws-handshake-fn]} chsk-server]
  (defonce handshake-handler ajax-get-or-ws-handshake-fn)
  (defonce post-handler ajax-post-fn)
+ (defonce connected-sockets connected-uids)
  (defonce ch-chsk ch-recv)
  (defn chsk-send! [uid ev] (send-fn uid ev)))
 
@@ -29,6 +30,8 @@
 (def buffer-size 500)
 (def websocket-buffer (chan buffer-size))
 
+(defn connected-uids [] (seq (:any @connected-sockets)))
+
 (defonce ratelimiter
  (go (while true
  (<! (timeout (int buffer-clear-timer-ms)))
@@ -61,6 +64,7 @@
  (?reply-fn {:msg "Unhandled event"})))
 
 (defmethod -msg-handler :chsk/ws-ping [_])
+;; NOTE - :chsk/uidport-close is handled in game.clj
 (defmethod -msg-handler :chsk/uidport-open
  [{uid :uid
  {user :user} :ring-req}]

src/cljs/nr/admin.cljs

@@ -45,6 +45,17 @@
  (go (let [response (<! (PUT "/admin/version" {:version msg} :json))]
  (update-version-response response))))
 
+(defn- update-banned-response [response]
+ (if (= 200 (:status response))
+ (do
+ (go (swap! admin-state assoc :banned (:json (<! (GET "/admin/banned")))))
+ (non-game-toast "Updated banned message" "success" nil))
+ (non-game-toast "Failed to update banned message" "error" nil)))
+
+(defn- update-banned-item [msg]
+ (go (let [response (<! (PUT "/admin/banned" {:banned msg} :json))]
+ (update-banned-response response))))
+
 (defn- update-announce-response [response]
  (if (sente/cb-success? response)
  (case response
@@ -114,6 +125,23 @@
  :class (if disabled "disabled" "")}
  "Update"])]
 
+ [:br]
+ [:h3 "Update banned user login failure message"]
+ [:form.msg-box {:on-submit #(let [msg (:banned @s)]
+ (.preventDefault %)
+ (when-not (s/blank? msg)
+ (update-banned-item msg)
+ (swap! s assoc :banned "")))}
+ [:input {:type "text"
+ :placeholder "Type something...."
+ :value (:banned @s "")
+ :on-change #(swap! s assoc :banned (-> % .-target .-value))}]
+ (let [msg (:banned @s "")
+ disabled (s/blank? msg)]
+ [:button {:disabled disabled
+ :class (if disabled "disabled" "")}
+ "Update"])]
+
  [:br]
  [:h3 "Site Announcement"]
  [:form.msg-box {:on-submit #(let [msg (:announce-msg @s)]

src/cljs/nr/auth.cljs

@@ -26,6 +26,7 @@
  (swap! s assoc :flash-message "Reset password sent")
  (case (:status response)
  401 (swap! s assoc :flash-message "Invalid login or password")
+ 403 (swap! s assoc :flash-message (or (:error (:json response)) "Account banned"))
  421 (swap! s assoc :flash-message "No account with that email address exists")
  422 (swap! s assoc :flash-message "Username taken")
  423 (swap! s assoc :flash-message "Username too long")

src/cljs/nr/ws.cljs

@@ -9,12 +9,13 @@
 
 (if-not ?csrf-token
  (println "CSRF token NOT detected in HTML, default Sente config will reject requests")
- (let [{:keys [ch-recv send-fn]}
+ (let [{:keys [chsk ch-recv send-fn]}
  (sente/make-channel-socket-client!
  "/chsk"
  ?csrf-token
  {:type :auto
  :wrap-recv-evs? false})]
+ (def chsk chsk)
  (def ch-chsk ch-recv)
  (defn ws-send!
  ([ev] (send-fn ev))
@@ -40,6 +41,9 @@
 (defmethod event-msg-handler :chsk/handshake [_] (ws-send! [:lobby/list]))
 (defmethod event-msg-handler :chsk/ws-ping [_])
 
+(defmethod event-msg-handler :system/force-disconnect [_]
+ (sente/chsk-reconnect! chsk))
+
 (defn resync []
  (ws-send! [:game/resync {:gameid (current-gameid app-state)}]))