mirror of
https://github.com/penpot/penpot.git
synced 2025-07-17 03:35:17 +02:00
✨ Improve msgbus subscription handling.
This commit is contained in:
Andrey Antukh
parent
8fd37dbad5
commit
7e1ee087d3
4 changed files with 194 additions and 124 deletions
|
|
@ -115,14 +115,11 @@
|
|||
[conn id]
|
||||
(db/exec-one! conn [sql:retrieve-file id]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; WebSocket Http Handler
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; --- WEBSOCKET INIT
|
||||
|
||||
(declare handle-connect)
|
||||
|
||||
(defrecord WebSocket [conn in out sub])
|
||||
|
||||
(defn- ws-send
|
||||
[conn data]
|
||||
(try
|
||||
|
|
@ -134,8 +131,8 @@
|
|||
|
||||
(defn websocket
|
||||
[{:keys [file-id team-id msgbus executor] :as cfg}]
|
||||
(let [in (a/chan (a/dropping-buffer 64))
|
||||
out (a/chan (a/dropping-buffer 64))
|
||||
(let [rcv-ch (a/chan 32)
|
||||
out-ch (a/chan 32)
|
||||
mtx-aconn (:mtx-active-connections cfg)
|
||||
mtx-messages (:mtx-messages cfg)
|
||||
mtx-sessions (:mtx-sessions cfg)
|
||||
|
|
@ -143,46 +140,51 @@
|
|||
ws-send (mtx/wrap-counter ws-send mtx-messages ["send"])]
|
||||
|
||||
(letfn [(on-connect [conn]
|
||||
(log/debugf "on-connect %s" (:session-id cfg))
|
||||
(mtx-aconn :inc)
|
||||
;; A subscription channel should use a lossy buffer
|
||||
;; because we can't penalize normal clients when one
|
||||
;; slow client is connected to the room.
|
||||
(let [sub (a/chan (a/dropping-buffer 64))
|
||||
ws (WebSocket. conn in out sub nil cfg)]
|
||||
(let [sub-ch (a/chan (a/dropping-buffer 128))
|
||||
cfg (assoc cfg
|
||||
:conn conn
|
||||
:rcv-ch rcv-ch
|
||||
:out-ch out-ch
|
||||
:sub-ch sub-ch)]
|
||||
|
||||
;; Subscribe to corresponding topics
|
||||
(a/<!! (msgbus :sub {:topic (str file-id) :chan sub}))
|
||||
(a/<!! (msgbus :sub {:topic (str team-id) :chan sub}))
|
||||
(log/tracef "on-connect %s" (:session-id cfg))
|
||||
|
||||
;; message forwarding loop
|
||||
;; Forward all messages from out-ch to the websocket
|
||||
;; connection
|
||||
(a/go-loop []
|
||||
(let [val (a/<! out)]
|
||||
(let [val (a/<! out-ch)]
|
||||
(when (some? val)
|
||||
(when (a/<! (aa/thread-call executor #(ws-send conn (t/encode-str val))))
|
||||
(recur)))))
|
||||
|
||||
(a/go
|
||||
(a/<! (handle-connect ws))
|
||||
(a/close! sub))))
|
||||
;; Subscribe to corresponding topics
|
||||
(a/<! (msgbus :sub {:topics [file-id team-id] :chan sub-ch}))
|
||||
(a/<! (handle-connect cfg))
|
||||
(a/close! sub-ch))))
|
||||
|
||||
(on-error [_conn _e]
|
||||
(log/debugf "on-error %s" (:session-id cfg))
|
||||
(on-error [_conn e]
|
||||
(mtx-aconn :dec)
|
||||
(mtx-sessions :observe (/ (inst-ms (dt/duration-between created-at (dt/now))) 1000.0))
|
||||
(a/close! out)
|
||||
(a/close! in))
|
||||
(log/tracef "on-error %s (%s)" (:session-id cfg) (ex-message e))
|
||||
(a/close! out-ch)
|
||||
(a/close! rcv-ch))
|
||||
|
||||
(on-close [_conn _status _reason]
|
||||
(log/debugf "on-close %s" (:session-id cfg))
|
||||
(mtx-aconn :dec)
|
||||
(mtx-sessions :observe (/ (inst-ms (dt/duration-between created-at (dt/now))) 1000.0))
|
||||
(a/close! out)
|
||||
(a/close! in))
|
||||
(log/tracef "on-close %s" (:session-id cfg))
|
||||
(a/close! out-ch)
|
||||
(a/close! rcv-ch))
|
||||
|
||||
(on-message [_ws message]
|
||||
(let [message (t/decode-str message)]
|
||||
(a/>!! in message)))]
|
||||
(when-not (a/offer! rcv-ch message)
|
||||
(log/warn "droping ws input message, channe full"))))]
|
||||
|
||||
{:on-connect on-connect
|
||||
:on-error on-error
|
||||
|
|
@ -190,16 +192,18 @@
|
|||
:on-text (mtx/wrap-counter on-message mtx-messages ["recv"])
|
||||
:on-bytes (constantly nil)})))
|
||||
|
||||
;; --- CONNECTION INIT
|
||||
|
||||
(declare handle-message)
|
||||
(declare start-loop!)
|
||||
|
||||
(defn- handle-connect
|
||||
[{:keys [conn] :as ws}]
|
||||
[{:keys [conn] :as cfg}]
|
||||
(a/go
|
||||
(try
|
||||
(aa/<? (handle-message ws {:type :connect}))
|
||||
(aa/<? (start-loop! ws))
|
||||
(aa/<? (handle-message ws {:type :disconnect}))
|
||||
(aa/<? (handle-message cfg {:type :connect}))
|
||||
(aa/<? (start-loop! cfg))
|
||||
(aa/<? (handle-message cfg {:type :disconnect}))
|
||||
(catch Throwable err
|
||||
(log/errorf err "unexpected exception on websocket handler")
|
||||
(let [session (.getSession ^WebSocketAdapter conn)]
|
||||
|
|
@ -207,36 +211,39 @@
|
|||
(.disconnect session)))))))
|
||||
|
||||
(defn- start-loop!
|
||||
[{:keys [in out sub session-id] :as ws}]
|
||||
[{:keys [rcv-ch out-ch sub-ch session-id] :as cfg}]
|
||||
(aa/go-try
|
||||
(loop []
|
||||
(let [timeout (a/timeout 30000)
|
||||
[val port] (a/alts! [in sub timeout])]
|
||||
[val port] (a/alts! [rcv-ch sub-ch timeout])]
|
||||
|
||||
(cond
|
||||
;; Process message coming from connected client
|
||||
(and (= port in) (not (nil? val)))
|
||||
(and (= port rcv-ch) (some? val))
|
||||
(do
|
||||
(aa/<? (handle-message ws val))
|
||||
(aa/<? (handle-message cfg val))
|
||||
(recur))
|
||||
|
||||
;; Forward message to the websocket
|
||||
(and (= port sub) (not (nil? val)))
|
||||
;; If message comes from subscription channel; we just need
|
||||
;; to foreward it to the output channel.
|
||||
(and (= port sub-ch) (some? val))
|
||||
(do
|
||||
(when-not (= (:session-id val) session-id)
|
||||
(a/>! out val))
|
||||
(a/>! out-ch val))
|
||||
(recur))
|
||||
|
||||
;; Timeout channel signaling
|
||||
;; When timeout channel is signaled, we need to send a ping
|
||||
;; message to the output channel. TODO: we need to make this
|
||||
;; more smart.
|
||||
(= port timeout)
|
||||
(do
|
||||
(a/>! out {:type :ping})
|
||||
(a/>! out-ch {:type :ping})
|
||||
(recur))
|
||||
|
||||
:else
|
||||
nil)))))
|
||||
|
||||
;; Incoming Messages Handling
|
||||
;; --- PRESENCE HANDLING API
|
||||
|
||||
(def ^:private
|
||||
sql:retrieve-presence
|
||||
|
|
@ -244,12 +251,6 @@
|
|||
where file_id=?
|
||||
and (clock_timestamp() - updated_at) < '5 min'::interval")
|
||||
|
||||
(defn- retrieve-presence
|
||||
[pool file-id]
|
||||
(aa/thread-try
|
||||
(let [rows (db/exec! pool [sql:retrieve-presence file-id])]
|
||||
(mapv (juxt :session-id :profile-id) rows))))
|
||||
|
||||
(def ^:private
|
||||
sql:update-presence
|
||||
"insert into presence (file_id, session_id, profile_id, updated_at)
|
||||
|
|
@ -257,49 +258,66 @@
|
|||
on conflict (file_id, session_id, profile_id)
|
||||
do update set updated_at=clock_timestamp()")
|
||||
|
||||
(defn- retrieve-presence
|
||||
[{:keys [pool file-id] :as cfg}]
|
||||
(let [rows (db/exec! pool [sql:retrieve-presence file-id])]
|
||||
(mapv (juxt :session-id :profile-id) rows)))
|
||||
|
||||
(defn- retrieve-presence*
|
||||
[{:keys [executor] :as cfg}]
|
||||
(aa/with-thread executor
|
||||
(retrieve-presence cfg)))
|
||||
|
||||
(defn- update-presence
|
||||
[conn file-id session-id profile-id]
|
||||
(aa/thread-try
|
||||
(let [sql [sql:update-presence file-id session-id profile-id]]
|
||||
(db/exec-one! conn sql))))
|
||||
[{:keys [pool file-id session-id profile-id] :as cfg}]
|
||||
(let [sql [sql:update-presence file-id session-id profile-id]]
|
||||
(db/exec-one! pool sql)))
|
||||
|
||||
(defn- update-presence*
|
||||
[{:keys [executor] :as cfg}]
|
||||
(aa/with-thread executor
|
||||
(update-presence cfg)))
|
||||
|
||||
(defn- delete-presence
|
||||
[pool file-id session-id profile-id]
|
||||
(aa/thread-try
|
||||
(db/delete! pool :presence {:file-id file-id
|
||||
:profile-id profile-id
|
||||
:session-id session-id})))
|
||||
[{:keys [pool file-id session-id profile-id] :as cfg}]
|
||||
(db/delete! pool :presence {:file-id file-id
|
||||
:profile-id profile-id
|
||||
:session-id session-id}))
|
||||
|
||||
(defn- delete-presence*
|
||||
[{:keys [executor] :as cfg}]
|
||||
(aa/with-thread executor
|
||||
(delete-presence cfg)))
|
||||
|
||||
;; --- INCOMING MSG PROCESSING
|
||||
|
||||
(defmulti handle-message
|
||||
(fn [_ message] (:type message)))
|
||||
|
||||
;; TODO: check permissions for join a file-id channel (probably using
|
||||
;; single use token for avoid explicit database query).
|
||||
|
||||
(defmethod handle-message :connect
|
||||
[{:keys [file-id profile-id session-id pool msgbus] :as ws} _message]
|
||||
[{:keys [file-id msgbus] :as cfg} _message]
|
||||
;; (log/debugf "profile '%s' is connected to file '%s'" profile-id file-id)
|
||||
(aa/go-try
|
||||
(aa/<? (update-presence pool file-id session-id profile-id))
|
||||
(let [members (aa/<? (retrieve-presence pool file-id))]
|
||||
(a/<! (msgbus :pub {:topic file-id
|
||||
:message {:type :presence :sessions members}})))))
|
||||
(aa/<? (update-presence* cfg))
|
||||
(let [members (aa/<? (retrieve-presence* cfg))
|
||||
val {:topic file-id :message {:type :presence :sessions members}}]
|
||||
(a/<! (msgbus :pub val)))))
|
||||
|
||||
(defmethod handle-message :disconnect
|
||||
[{:keys [profile-id file-id session-id pool msgbus] :as ws} _message]
|
||||
[{:keys [file-id msgbus] :as cfg} _message]
|
||||
;; (log/debugf "profile '%s' is disconnected from '%s'" profile-id file-id)
|
||||
(aa/go-try
|
||||
(aa/<? (delete-presence pool file-id session-id profile-id))
|
||||
(let [members (aa/<? (retrieve-presence pool file-id))]
|
||||
(a/<! (msgbus :pub {:topic file-id
|
||||
:message {:type :presence :sessions members}})))))
|
||||
(aa/<? (delete-presence* cfg))
|
||||
(let [members (aa/<? (retrieve-presence* cfg))
|
||||
val {:topic file-id :message {:type :presence :sessions members}}]
|
||||
(a/<! (msgbus :pub val)))))
|
||||
|
||||
(defmethod handle-message :keepalive
|
||||
[{:keys [profile-id file-id session-id pool] :as ws} _message]
|
||||
(update-presence pool file-id session-id profile-id))
|
||||
[cfg _message]
|
||||
(update-presence* cfg))
|
||||
|
||||
(defmethod handle-message :pointer-update
|
||||
[{:keys [profile-id file-id session-id msgbus] :as ws} message]
|
||||
[{:keys [profile-id file-id session-id msgbus] :as cfg} message]
|
||||
(let [message (assoc message
|
||||
:profile-id profile-id
|
||||
:session-id session-id)]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue