mirror of
https://github.com/penpot/penpot.git
synced 2026-11-12 21:10:34 +00:00
8f91f7cd4e
SSE endpoints always encoded event payloads in transit, ignoring request content negotiation. WebSocket notifications always used transit as well, with no way to request plain JSON. Extract the response format negotiation (Accept header and _fmt query param) into the shared app.http.content-negotiation helper and reuse it from the response formatting middleware, the SSE response builder and the WebSocket notifications endpoint. The _fmt=json parameter takes precedence over Accept, transit stays the default, and unknown formats fall back to transit. SSE event payloads are now encoded as transit (default) or plain JSON depending on the request, while the text/event-stream transport remains unchanged. The WebSocket format is negotiated once on the upgrade request and applies bidirectionally: outbound notification messages use the negotiated encoder and inbound client messages the matching decoder, with a normalization step converting JSON messages (:type to keyword, entity ids to UUID) into the same shape produced by transit. The generic websocket listener now accepts encode/decode functions as options (defaulting to the historical transit codecs) and exposes the resolved options in the handler metadata under ::options for testing and introspection. The notifications http-handler is now public so tests can cover the wiring. On the frontend, stream requests accept a :response-format :json option that switches the Accept header and decodes each event with the plain JSON decoder. Add unit tests for negotiate-format, SSE response encoding and the WebSocket codec wiring (JSON via Accept header or _fmt param, transit default for unsignaled requests). Closes #11409 AI-assisted-by: glm-5.3-flash AI-assisted-by: muse-spark-1.3-contributor
401 lines
14 KiB
Clojure
401 lines
14 KiB
Clojure
;; This Source Code Form is subject to the terms of the Mozilla Public
|
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
;;
|
|
;; Copyright (c) KALEIDOS SUBSIDIARY SL
|
|
|
|
(ns app.http.websocket
|
|
"A penpot notification service for file cooperative edition."
|
|
(:require
|
|
[app.binfile.common :as bfc]
|
|
[app.common.data.macros :as dm]
|
|
[app.common.exceptions :as ex]
|
|
[app.common.json :as json]
|
|
[app.common.logging :as l]
|
|
[app.common.pprint :as pp]
|
|
[app.common.schema :as sm]
|
|
[app.common.time :as ct]
|
|
[app.common.transit :as t]
|
|
[app.common.uuid :as uuid]
|
|
[app.db :as db]
|
|
[app.http.content-negotiation :as cnegot]
|
|
[app.http.session :as session]
|
|
[app.metrics :as mtx]
|
|
[app.msgbus :as mbus]
|
|
[app.nitrate :as nitrate]
|
|
[app.rpc.commands.files :as files]
|
|
[app.rpc.commands.teams :as teams]
|
|
[app.util.websocket :as ws]
|
|
[integrant.core :as ig]
|
|
[promesa.exec.csp :as sp]
|
|
[yetti.websocket :as yws]))
|
|
|
|
(def recv-labels
|
|
(into-array String ["recv"]))
|
|
|
|
(def send-labels
|
|
(into-array String ["send"]))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; WEBSOCKET HOOKS
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(def state (atom {}))
|
|
|
|
;; REPL HELPERS
|
|
|
|
(defn repl-get-connections-for-file
|
|
[file-id]
|
|
(->> (vals @state)
|
|
(filter #(= file-id (-> % ::ws/state deref ::file-subscription :file-id)))
|
|
(map ::ws/id)))
|
|
|
|
(defn repl-get-connections-for-team
|
|
[team-id]
|
|
(->> (vals @state)
|
|
(filter #(= team-id (-> % ::ws/state deref ::team-subscription :team-id)))
|
|
(map ::ws/id)))
|
|
|
|
(defn repl-close-connection
|
|
[id]
|
|
(when-let [{:keys [::ws/close-ch] :as wsp} (get @state id)]
|
|
(sp/put! close-ch [8899 "closed from server"])
|
|
(sp/close! close-ch)))
|
|
|
|
(defn repl-get-connection-info
|
|
[id]
|
|
(when-let [wsp (get @state id)]
|
|
(let [subs (some-> wsp ::ws/state deref)]
|
|
{:id id
|
|
:created-at (::created-at wsp)
|
|
:profile-id (::profile-id wsp)
|
|
:session-id (::session-id wsp)
|
|
:user-agent (::ws/user-agent wsp)
|
|
:ip-addr (::ws/remote-addr wsp)
|
|
:last-activity-at (::ws/last-activity-at wsp)
|
|
:subscribed-file (-> subs ::file-subscription :file-id)
|
|
:subscribed-team (-> subs ::team-subscription :team-id)
|
|
:subscribed-org (-> subs ::team-subscription :organization-id)})))
|
|
|
|
(defn repl-print-connection-info
|
|
[id]
|
|
(some-> id repl-get-connection-info pp/pprint))
|
|
|
|
(defn repl-print-connection-info-for-file
|
|
[file-id]
|
|
(some->> (repl-get-connections-for-file file-id)
|
|
(map repl-get-connection-info)
|
|
(pp/pprint)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; WEBSOCKET HANDLER
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn resolve-encoder
|
|
"Resolve the outbound message encoder for the negotiated format.
|
|
The transit encoding is the default for unexpected format values."
|
|
[format]
|
|
(case format
|
|
:transit #(t/encode-str % {:type :json-verbose})
|
|
:json cnegot/json-encode-str
|
|
#(t/encode-str % {:type :json-verbose})))
|
|
|
|
(defn resolve-decoder
|
|
"Resolve the inbound message decoder for the negotiated format.
|
|
The transit decoding is the default for unexpected format values."
|
|
[format]
|
|
(case format
|
|
:transit t/decode-str
|
|
:json #(json/decode % {:key-fn json/read-kebab-key})
|
|
t/decode-str))
|
|
|
|
(defn normalize-message
|
|
"Normalize the inbound message into the same shape produced by the
|
|
transit decoding: the `:type` value is a keyword and the entity ids
|
|
are UUID objects. This is a no-op for transit decoded messages."
|
|
[message]
|
|
(cond-> message
|
|
(string? (:type message))
|
|
(assoc :type (keyword (:type message)))
|
|
|
|
(string? (:team-id message))
|
|
(assoc :team-id (uuid/parse* (:team-id message)))
|
|
|
|
(string? (:file-id message))
|
|
(assoc :file-id (uuid/parse* (:file-id message)))))
|
|
|
|
(defmulti handle-message
|
|
(fn [_ _ message]
|
|
(:type message)))
|
|
|
|
(defmethod handle-message :open
|
|
[{:keys [::mbus/msgbus]} {:keys [::ws/id ::ws/output-ch ::ws/state ::profile-id ::session-id] :as wsp} _]
|
|
(l/trace :fn "handle-message" :event "open" :conn-id id)
|
|
(let [ch (sp/chan :buf (sp/dropping-buffer 16)
|
|
:xf (remove #(= (:session-id %) session-id)))]
|
|
|
|
;; Subscribe to the profile channel and forward all messages to websocket output
|
|
;; channel (send them to the client).
|
|
(swap! state assoc ::profile-subscription {:channel ch})
|
|
|
|
;; Forward the subscription messages directly to the websocket output channel
|
|
(sp/pipe ch output-ch false)
|
|
|
|
;; Subscribe to the profile topic on msgbus/redis
|
|
(mbus/sub! msgbus :topic profile-id :chan ch)
|
|
|
|
;; Subscribe to the system topic on msgbus/redis
|
|
(mbus/sub! msgbus :topic (str uuid/zero) :chan ch)))
|
|
|
|
(defmethod handle-message :close
|
|
[{:keys [::mbus/msgbus]} {:keys [::ws/id ::ws/state ::profile-id ::session-id]} _]
|
|
(l/trace :fn "handle-message" :event "close" :conn-id id)
|
|
(let [psub (::profile-subscription @state)
|
|
fsub (::file-subscription @state)
|
|
tsub (::team-subscription @state)
|
|
msg {:type :disconnect
|
|
:profile-id profile-id
|
|
:session-id session-id}]
|
|
|
|
;; Close profile subscription if exists
|
|
(when-let [ch (:channel psub)]
|
|
(sp/close! ch)
|
|
(mbus/purge! msgbus [ch]))
|
|
|
|
;; Close team subscription if exists
|
|
(when-let [ch (:channel tsub)]
|
|
(sp/close! ch)
|
|
(mbus/purge! msgbus [ch]))
|
|
|
|
;; Close file subscription if exists
|
|
(when-let [{:keys [topic channel]} fsub]
|
|
(sp/close! channel)
|
|
(mbus/purge! msgbus [channel])
|
|
(mbus/pub! msgbus :topic topic :message msg))))
|
|
|
|
(defn- get-team-organization-id
|
|
"Returns the id of the organization that owns `team-id`, or nil when
|
|
the team has no organization or nitrate cannot be reached."
|
|
[cfg team-id]
|
|
(try
|
|
(-> (nitrate/call cfg :get-team-organization {:team-id team-id})
|
|
(dm/get-in [:organization :id]))
|
|
(catch Throwable cause
|
|
(l/warn :hint "unable to resolve team organization"
|
|
:team-id team-id
|
|
:cause cause)
|
|
nil)))
|
|
|
|
(defmethod handle-message :subscribe-team
|
|
[cfg {:keys [::ws/id ::ws/state ::ws/output-ch ::session-id ::profile-id]} {:keys [team-id] :as params}]
|
|
(l/trace :fn "handle-message" :event "subscribe-team" :team-id team-id :conn-id id)
|
|
(teams/check-read-permissions! cfg profile-id team-id)
|
|
(let [prev-subs (get @state ::team-subscription)
|
|
organization-id (get-team-organization-id cfg team-id)
|
|
;; Resolved server-side so a client only hears its readable team's org
|
|
topics (cond-> [team-id]
|
|
(some? organization-id)
|
|
(conj organization-id))
|
|
channel (sp/chan :buf (sp/dropping-buffer 64)
|
|
:xf (remove #(= (:session-id %) session-id)))]
|
|
|
|
(sp/pipe channel output-ch false)
|
|
(mbus/sub! (::mbus/msgbus cfg) :topics topics :chan channel)
|
|
|
|
(let [subs {:team-id team-id
|
|
:organization-id organization-id
|
|
:channel channel
|
|
:topic team-id}]
|
|
(swap! state assoc ::team-subscription subs))
|
|
|
|
;; Close previous subscription if exists
|
|
(when-let [ch (:channel prev-subs)]
|
|
(sp/close! ch)
|
|
(mbus/purge! (::mbus/msgbus cfg) [ch]))))
|
|
|
|
|
|
(defmethod handle-message :subscribe-file
|
|
[cfg {:keys [::ws/id ::ws/state ::ws/output-ch ::session-id ::profile-id]} {:keys [file-id] :as params}]
|
|
(l/trace :fn "handle-message" :event "subscribe-file" :file-id file-id :conn-id id)
|
|
(bfc/check-file-exists cfg file-id)
|
|
(files/check-read-permissions! cfg profile-id file-id)
|
|
(let [psub (::file-subscription @state)
|
|
fch (sp/chan :buf (sp/dropping-buffer 64)
|
|
:xf (remove #(= (:session-id %) session-id)))]
|
|
|
|
(let [subs {:file-id file-id :channel fch :topic file-id}]
|
|
(swap! state assoc ::file-subscription subs))
|
|
|
|
;; Close previous subscription if exists
|
|
(when-let [ch (:channel psub)]
|
|
(sp/close! ch)
|
|
(mbus/purge! (::mbus/msgbus cfg) [ch]))
|
|
|
|
(sp/go-loop []
|
|
(when-let [{:keys [type] :as message} (sp/take! fch)]
|
|
(sp/put! output-ch message)
|
|
(when (or (= :join-file type)
|
|
(= :leave-file type)
|
|
(= :disconnect type))
|
|
(let [message {:type :presence
|
|
:file-id file-id
|
|
:session-id session-id
|
|
:profile-id profile-id}]
|
|
(mbus/pub! (::mbus/msgbus cfg)
|
|
:topic file-id
|
|
:message message)))
|
|
(recur)))
|
|
|
|
;; Subscribe to file topic
|
|
(mbus/sub! (::mbus/msgbus cfg) :topic file-id :chan fch)
|
|
|
|
;; Notifify the rest of participants of the new connection.
|
|
(let [message {:type :join-file
|
|
:file-id file-id
|
|
:session-id session-id
|
|
:profile-id profile-id}]
|
|
(mbus/pub! (::mbus/msgbus cfg) :topic file-id :message message))))
|
|
|
|
(defmethod handle-message :unsubscribe-file
|
|
[{:keys [::mbus/msgbus]} {:keys [::ws/id ::ws/state ::session-id ::profile-id]} {:keys [file-id] :as params}]
|
|
(l/trace :fn "handle-message" :event "unsubscribe-file" :file-id file-id :conn-id id)
|
|
|
|
(let [subs (::file-subscription @state)
|
|
message {:type :leave-file
|
|
:file-id file-id
|
|
:session-id session-id
|
|
:profile-id profile-id}]
|
|
|
|
(when (= (:file-id subs) file-id)
|
|
(mbus/pub! msgbus :topic file-id :message message)
|
|
(let [ch (:channel subs)]
|
|
(sp/close! ch)
|
|
(mbus/purge! msgbus [ch])))))
|
|
|
|
(defmethod handle-message :keepalive
|
|
[_ _ _]
|
|
(l/trace :fn "handle-message" :event :keepalive))
|
|
|
|
(defmethod handle-message :broadcast
|
|
[{:keys [::mbus/msgbus]} {:keys [::ws/id ::session-id ::profile-id]} message]
|
|
(l/trace :fn "handle-message" :event "broadcast" :conn-id id)
|
|
(let [message (-> message
|
|
(assoc :subs-id profile-id)
|
|
(assoc :profile-id profile-id)
|
|
(assoc :session-id session-id))]
|
|
(mbus/pub! msgbus :topic profile-id :message message)))
|
|
|
|
(defmethod handle-message :pointer-update
|
|
[{:keys [::mbus/msgbus]} {:keys [::ws/state ::session-id ::profile-id]} {:keys [file-id] :as message}]
|
|
(when-let [subs (::file-subscription @state)]
|
|
(when (= file-id (:file-id subs))
|
|
(let [message (-> message
|
|
(assoc :subs-id file-id)
|
|
(assoc :profile-id profile-id)
|
|
(assoc :session-id session-id))]
|
|
(mbus/pub! msgbus :topic file-id :message message)))))
|
|
|
|
(defmethod handle-message :default
|
|
[_ {:keys [::ws/id]} message]
|
|
(l/warn :hint "received unexpected message"
|
|
:message message
|
|
:conn-id id))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; HTTP HANDLER
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn- on-connect
|
|
[{:keys [::mtx/metrics]} {:keys [::ws/id] :as wsp}]
|
|
(let [created-at (ct/now)]
|
|
(l/trace :fn "on-connect" :conn-id id)
|
|
(swap! state assoc id wsp)
|
|
(mtx/run! metrics
|
|
:id :websocket-active-connections
|
|
:inc 1)
|
|
|
|
(assoc wsp ::ws/on-disconnect
|
|
(fn []
|
|
(l/trace :fn "on-disconnect" :conn-id id)
|
|
(swap! state dissoc id)
|
|
(mtx/run! metrics :id :websocket-active-connections :dec 1)
|
|
(mtx/run! metrics
|
|
:id :websocket-session-timing
|
|
:val (/ (inst-ms (ct/diff created-at (ct/now))) 1000.0))))))
|
|
|
|
(defn- on-rcv-message
|
|
[{:keys [::mtx/metrics ::profile-id ::session-id]} message]
|
|
(mtx/run! metrics
|
|
:id :websocket-messages-total
|
|
:labels recv-labels
|
|
:inc 1)
|
|
(let [message (normalize-message message)]
|
|
(assoc message :profile-id profile-id :session-id session-id)))
|
|
|
|
(defn- on-snd-message
|
|
[{:keys [::mtx/metrics]} message]
|
|
(mtx/run! metrics
|
|
:id :websocket-messages-total
|
|
:labels send-labels
|
|
:inc 1)
|
|
message)
|
|
|
|
(defn http-handler
|
|
"The websocket upgrade request handler. Returns the upgrade
|
|
response containing the websocket listener built with the
|
|
codecs of the negotiated payload format."
|
|
[cfg {:keys [params ::session/profile-id] :as request}]
|
|
(let [session-id (some-> params :session-id uuid/parse*)
|
|
format (cnegot/negotiate-format request)]
|
|
(when-not (uuid? session-id)
|
|
(ex/raise :type :validation
|
|
:code :missing-session-id
|
|
:hint "missing or invalid session-id found"))
|
|
|
|
(cond
|
|
(not profile-id)
|
|
(ex/raise :type :authentication
|
|
:hint "authentication required")
|
|
|
|
;; WORKAROUND: we use the adapter specific predicate for
|
|
;; performance reasons; for now, the ring default impl for
|
|
;; `upgrade-request?` parses all requests headers before perform
|
|
;; any checking.
|
|
(not (yws/upgrade-request? request))
|
|
(ex/raise :type :validation
|
|
:code :websocket-request-expected
|
|
:hint "this endpoint only accepts websocket connections")
|
|
|
|
:else
|
|
(do
|
|
(l/trace :hint "websocket request"
|
|
:profile-id profile-id
|
|
:session-id session-id
|
|
:format format)
|
|
{::yws/listener (ws/listener request
|
|
::ws/on-rcv-message (partial on-rcv-message cfg)
|
|
::ws/on-snd-message (partial on-snd-message cfg)
|
|
::ws/on-connect (partial on-connect cfg)
|
|
::ws/handler (partial handle-message cfg)
|
|
::ws/encode-fn (resolve-encoder format)
|
|
::ws/decode-fn (resolve-decoder format)
|
|
::profile-id profile-id
|
|
::session-id session-id)}))))
|
|
|
|
|
|
(def ^:private schema:routes-params
|
|
[:map
|
|
::mbus/msgbus
|
|
::mtx/metrics
|
|
::db/pool
|
|
::session/manager])
|
|
|
|
(defmethod ig/assert-key ::routes
|
|
[_ params]
|
|
(assert (sm/valid? schema:routes-params params)))
|
|
|
|
(defmethod ig/init-key ::routes
|
|
[_ cfg]
|
|
["/ws/notifications" {:middleware [[session/authz cfg]]
|
|
:handler (partial http-handler cfg)}])
|