penpot/backend/test/backend_tests/http_middleware_test.clj
Dr. Dominik Jain c0f0b14540
🎉 Add direct MCP feedback channel via dedicated tool (#12551)
* ♻️ Move devenv-only tools to a separate folder

* 🎉 Add an MCP feedback channel

Add a user-approved feedback tool and an MCP-token-authenticated backend
endpoint that queues plain-text email. Enable the tool through the
configured backend URI in both local and multi-user mode.

Validate subject and feedback limits, enforce per-profile rate limits,
and document configuration. Cover authentication, queueing, tool
availability, and failure handling with backend and MCP tests.

Closes #12490

AI-assisted-by: gpt-6

* ♻️ Move MCP feedback submission into RPC

Use the standard RPC wrappers for feedback and remove the dedicated
HTTP endpoint, route wiring, and custom rate limiter.

Restrict MCP tokens to opted-in routes and commands. Add a shared RPC
call helper to the MCP backend client and adapt the existing tests.

AI-assisted-by: gpt-6

* 🐛 Harden MCP feedback auth, validation and messages

Accept MCP tokens when either the mcp or the access-tokens flag is on, so
instances that enable MCP without personal access tokens can send
feedback. Personal tokens still need access-tokens. Keep the issuer in one
constant, decode tokens without raising to reject unknown issuers, and
name the issuer and type checks.

Reject control characters in the subject, and in the feedback all but
tabs and line breaks, in both the command and the tool, so a NUL answers
400 instead of failing when the mail job is stored. Answer 403 with
profile-blocked or profile-not-active for unusable profiles, record only
who sent feedback in the audit event, and add doc metadata.

Replace on OAuth approval an MCP token issued before MCP tokens had their
own issuer, or one this instance cannot decrypt, since the backend rejects
both.

In the MCP server, mention disabled access tokens on 401, drop the unused
503 case, and say that delivery happens in the background. Document the
flags in the README.

AI-assisted-by: claude-opus-5-5

* 📚 Document the MCP feedback tool and MCP token rules

List submit_feedback among the MCP tools and add an MCP feedback section to
the configuration guide covering PENPOT_MCP_BACKEND_URI,
PENPOT_MCP_FEEDBACK_EMAIL, the flags and the email settings. Add commented
examples of both variables to the compose file.

In the agent memories, record when OAuth approval replaces an MCP token,
how the MCP server reaches the backend, and which flags, routes and
commands accept MCP tokens.

AI-assisted-by: claude-opus-5-5
2026-10-29 10:35:46 +01:00

764 lines
37 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 backend-tests.http-middleware-test
(:require
[app.common.exceptions :as ex]
[app.common.json :as json]
[app.common.time :as ct]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.http :as-alias http]
[app.http.access-token]
[app.http.errors :as http-errors]
[app.http.middleware :as mw]
[app.http.session :as session]
[app.main :as main]
[app.metrics :as mtx]
[app.rpc :as-alias rpc]
[app.rpc.commands.access-token]
[app.storage.schema :as stsch]
[app.tokens :as tokens]
[backend-tests.helpers :as th]
[clojure.string :as str]
[clojure.test :as t]
[integrant.core :as ig]
[mockery.core :refer [with-mocks]]
[yetti.request :as yreq]
[yetti.response :as yres])
(:import
io.prometheus.client.CollectorRegistry
io.undertow.server.RequestTooBigException))
(t/use-fixtures :once (t/compose-fixtures
(partial th/init-config [:enable-access-tokens])
th/init-system))
(t/use-fixtures :each th/database-reset)
(t/deftest auth-middleware-1
(let [request (volatile! nil)
handler (#'app.http.middleware/wrap-auth
(fn [req] (vreset! request req))
{})]
(handler (th/make-dummy-request {}))
(t/is (nil? (::http/auth-data @request)))
(handler (th/make-dummy-request {:headers {"authorization" "Token aaaa"}}))
(let [{:keys [token claims] token-type :type} (get @request ::http/auth-data)]
(t/is (= :token token-type))
(t/is (= "aaaa" token))
(t/is (nil? claims)))))
(t/deftest auth-middleware-2
(let [request (volatile! nil)
handler (#'app.http.middleware/wrap-auth
(fn [req] (vreset! request req))
{})]
(handler (th/make-dummy-request {}))
(t/is (nil? (::http/auth-data @request)))
;; A bearer token is only attached when it is a current session
;; token (kid=1/ver=1) and a decoder is configured. Otherwise the
;; request stays unauthenticated.
(handler (th/make-dummy-request {:headers {"authorization" "Bearer aaaa"}}))
(t/is (nil? (::http/auth-data @request)))))
(t/deftest auth-middleware-3
(let [request (volatile! nil)
handler (#'app.http.middleware/wrap-auth
(fn [req] (vreset! request req))
{})]
(handler (th/make-dummy-request {}))
(t/is (nil? (::http/auth-data @request)))
(handler (th/make-dummy-request {:cookies {"auth-token" "foobar"}}))
(t/is (nil? (::http/auth-data @request)))))
(t/deftest shared-key-auth
(let [handler (#'app.http.middleware/wrap-shared-key-auth
(fn [req] {::yres/status 200})
{:test1 "secret-key"})]
(let [response (handler (th/make-dummy-request {}))]
(t/is (= 403 (::yres/status response))))
(let [response (handler (th/make-dummy-request {:headers {"x-shared-key" "secret-key2"}}))]
(t/is (= 403 (::yres/status response))))
(let [response (handler (th/make-dummy-request {:headers {"x-shared-key" "secret-key"}}))]
(t/is (= 403 (::yres/status response))))
(let [response (handler (th/make-dummy-request {:headers {"x-shared-key" "test1 secret-key"}}))]
(t/is (= 200 (::yres/status response))))))
(t/deftest access-token-authz
(let [profile (th/create-profile* 1)
token (db/tx-run! th/*system* app.rpc.commands.access-token/create-access-token (:id profile) "test" nil nil)
handler (#'app.http.access-token/wrap-authz identity th/*system*)]
(let [response (handler nil)]
(t/is (nil? response)))
(let [response (handler {::http/auth-data {:type :token :token (:token token)
:claims (tokens/verify th/*system* {:token (:token token)})}})]
(t/is (= #{} (:app.http.access-token/perms response)))
(t/is (= (:id profile) (:app.http.access-token/profile-id response))))))
(t/deftest access-token-authz-sets-token-id-and-type
(let [profile (th/create-profile* 1)
token (db/tx-run! th/*system* app.rpc.commands.access-token/create-access-token
(:id profile) "test" nil "mcp")
handler (#'app.http.access-token/wrap-authz
identity (assoc th/*system* :app.http.access-token/allow-mcp true))
request {::http/auth-data {:type :token :token (:token token)
:claims (tokens/verify th/*system* {:token (:token token)})}}
response (handler request)]
(t/is (nil? (:app.http.access-token/profile-id
((#'app.http.access-token/wrap-authz identity th/*system*) request)))
"MCP tokens do not authenticate routes that have not opted in")
;; Must set ::actoken/id from claims :tid
(t/is (= (:id token) (:app.http.access-token/id response)))
;; Must set ::actoken/type from database
(t/is (= "mcp" (:app.http.access-token/type response)))
;; Existing assertions still pass
(t/is (= #{} (:app.http.access-token/perms response)))
(t/is (= (:id profile) (:app.http.access-token/profile-id response)))))
(t/deftest access-token-authz-follows-flags
(let [profile (th/create-profile* 1)
create #(db/tx-run! th/*system* app.rpc.commands.access-token/create-access-token
(:id profile) "test" nil %)
request (fn [{:keys [token]}]
{::http/auth-data {:type :token :token token
:claims (tokens/verify th/*system* {:token token})}})
auth (fn [flags token]
(with-redefs [cf/flags flags]
(let [handler (#'app.http.access-token/wrap-authz
identity (assoc th/*system* :app.http.access-token/allow-mcp true))]
(:app.http.access-token/profile-id (handler (request token))))))
personal (create nil)
mcp (create "mcp")]
(t/testing "only mcp: MCP tokens authenticate, personal tokens do not"
(t/is (= (:id profile) (auth #{:mcp} mcp)))
(t/is (nil? (auth #{:mcp} personal))))
(t/testing "only access-tokens: both authenticate"
(t/is (= (:id profile) (auth #{:access-tokens} mcp)))
(t/is (= (:id profile) (auth #{:access-tokens} personal))))
(t/testing "neither flag: the middleware is not installed"
(with-redefs [cf/flags #{}]
(t/is (nil? ((:compile app.http.access-token/authz))))))))
(defrecord MethodAwareDummyRequest [req-method headers]
yreq/IRequest
(method [_] req-method)
(get-header [_ name] (get headers name)))
(t/deftest cors-middleware-allowlisted-origin
(let [handler (#'app.http.middleware/wrap-cors
(fn [_] {::yres/status 200 ::yres/headers {}})
#{"https://trusted.example"})
resp (handler (->MethodAwareDummyRequest :get {"origin" "https://trusted.example"}))
headers (::yres/headers resp)]
(t/is (= 200 (::yres/status resp)))
(t/is (= "https://trusted.example" (get headers "access-control-allow-origin")))
(t/is (= "true" (get headers "access-control-allow-credentials")))
(t/is (= "Origin" (get headers "vary")))
(t/is (= "content-type, retry-after, x-rate-limit-remaining, x-rate-limit-reset"
(get headers "access-control-expose-headers")))
(t/is (not (str/includes?
(get headers "access-control-allow-headers" "")
"cookie")))))
(t/deftest cors-middleware-non-allowlisted-origin
(let [handler (#'app.http.middleware/wrap-cors
(fn [_] {::yres/status 200 ::yres/headers {}})
#{"https://trusted.example"})
resp (handler (->MethodAwareDummyRequest :get {"origin" "https://attacker.example"}))
headers (::yres/headers resp)]
(t/is (= 200 (::yres/status resp)))
(t/is (nil? (get headers "access-control-allow-origin")))
(t/is (nil? (get headers "access-control-allow-credentials")))
(t/is (nil? (get headers "access-control-allow-headers")))
(t/is (nil? (get headers "access-control-expose-headers")))
(t/is (= "Origin" (get headers "vary")))))
(t/deftest cors-middleware-preflight-allowlisted
(let [handler (#'app.http.middleware/wrap-cors
(fn [_] {::yres/status 200 ::yres/headers {}})
#{"https://trusted.example"})
resp (handler (->MethodAwareDummyRequest :options {"origin" "https://trusted.example"}))
headers (::yres/headers resp)]
(t/is (= 204 (::yres/status resp)))
(t/is (= "https://trusted.example" (get headers "access-control-allow-origin")))
(t/is (= "true" (get headers "access-control-allow-credentials")))))
(t/deftest cors-middleware-preflight-non-allowlisted
(let [handler (#'app.http.middleware/wrap-cors
(fn [_] {::yres/status 200 ::yres/headers {}})
#{"https://trusted.example"})
resp (handler (->MethodAwareDummyRequest :options {"origin" "https://attacker.example"}))
headers (::yres/headers resp)]
(t/is (= 204 (::yres/status resp)))
(t/is (nil? (get headers "access-control-allow-origin")))
(t/is (nil? (get headers "access-control-allow-credentials")))))
(t/deftest cors-middleware-missing-origin
(let [handler (#'app.http.middleware/wrap-cors
(fn [_] {::yres/status 200 ::yres/headers {}})
#{"https://trusted.example"})
resp (handler (->MethodAwareDummyRequest :get {}))
headers (::yres/headers resp)]
(t/is (= 200 (::yres/status resp)))
(t/is (nil? (get headers "access-control-allow-origin")))
(t/is (nil? (get headers "access-control-allow-credentials")))))
(t/deftest session-authz
(let [cfg th/*system*
manager (session/inmemory-manager)
profile (th/create-profile* 1)
handler (-> (fn [req] req)
(#'session/wrap-authz {::session/manager manager})
(#'mw/wrap-auth {:bearer (partial session/decode-token cfg)
:cookie (partial session/decode-token cfg)}))
session (->> (session/create-session manager {:profile-id (:id profile)
:user-agent "user agent"})
(#'session/assign-token cfg))
response (handler (th/make-dummy-request {:cookies {"auth-token" (:token session)}}))
{:keys [token claims] token-type :type}
(get response ::http/auth-data)]
(t/is (= :cookie token-type))
(t/is (= (:token session) token))
(t/is (= "authentication" (:iss claims)))
(t/is (= "penpot" (:aud claims)))
(t/is (= (:id session) (:sid claims)))
(t/is (= (:id profile) (:uid claims)))))
(t/deftest session-token-contains-exp-claim
(let [cfg th/*system*
manager (session/inmemory-manager)
profile (th/create-profile* 1)
session (->> (session/create-session manager {:profile-id (:id profile)
:user-agent "user agent"})
(#'session/assign-token cfg))
claims (tokens/decode cfg (:token session))
exp (:exp claims)]
(t/is (some? exp) "session token should contain :exp claim")
(t/is (ct/inst? exp) "exp should be an instant")))
(t/deftest session-token-exp-based-on-created-at
(let [cfg th/*system*
manager (session/inmemory-manager)
profile (th/create-profile* 1)
session (->> (session/create-session manager {:profile-id (:id profile)
:user-agent "user agent"})
(#'session/assign-token cfg))
claims (tokens/decode cfg (:token session))
expected-exp (ct/plus (:created-at session) (ct/duration {:days 30}))]
(t/is (some? (:exp claims)) "session token should contain :exp claim")
(t/is (= (inst-ms (:exp claims))
(inst-ms expected-exp))
"exp should equal created-at + 30 days")))
(t/deftest session-token-past-exp-is-rejected
(let [cfg th/*system*
manager (session/inmemory-manager)
profile (th/create-profile* 1)
session (->> (session/create-session manager {:profile-id (:id profile)
:user-agent "user agent"})
(#'session/assign-token cfg))
claims (tokens/decode cfg (:token session))
past-claims (assoc claims :exp (ct/minus (ct/now) (ct/duration {:days 1})))
past-token (tokens/generate cfg past-claims {:kid 1 :ver 1})]
(t/is (nil? (session/decode-token cfg past-token))
"token with exp in the past should be rejected")))
(t/deftest session-renewal-preserves-original-exp
(let [cfg th/*system*
profile (th/create-profile* 1)
created (ct/minus (ct/now) (ct/duration {:days 1}))
session {:id (uuid/random)
:profile-id (:id profile)
:user-agent "user agent"
:created-at created
:modified-at (ct/minus (ct/now) (ct/duration {:hours 7}))}
manager (reify session/ISessionManager
(read-session [_ _] session)
(create-session [_ _] session)
(update-session [_ s] (assoc s :modified-at (ct/now)))
(delete-session [_ _] nil))
old-token (:token (#'session/assign-token cfg session))
original-exp (:exp (tokens/decode cfg old-token))
handler (-> (fn [req] req)
(#'session/wrap-authz (assoc th/*system* ::session/manager manager))
(#'mw/wrap-auth {:bearer (partial session/decode-token cfg)
:cookie (partial session/decode-token cfg)}))
response (handler (th/make-dummy-request {:cookies {"auth-token" old-token}}))
renewed-token (get-in response [::yres/cookies "auth-token" :value])
renewed-claims (tokens/decode cfg renewed-token)]
(t/is (some? original-exp) "original token should have :exp")
(t/is (not= old-token renewed-token) "renewal should issue a new token string")
(t/is (= (inst-ms original-exp) (inst-ms (:exp renewed-claims)))
"renewed token should preserve the original :exp, not extend it")))
(t/deftest session-renewal-preserves-exp-with-db-manager
(let [cfg th/*system*
manager (::session/manager th/*system*)
profile (th/create-profile* 1)
created (session/create-session manager {:profile-id (:id profile)
:user-agent "user agent"})
_ (th/db-exec-one! ["UPDATE http_session_v2
SET modified_at = now() - interval '7 hours'
WHERE id = ?" (:id created)])
stale (session/read-session manager (:id created))
old-token (:token (#'session/assign-token cfg stale))
original-exp (:exp (tokens/decode cfg old-token))
handler (-> (fn [req] req)
(#'session/wrap-authz cfg)
(#'mw/wrap-auth {:bearer (partial session/decode-token cfg)
:cookie (partial session/decode-token cfg)}))
response (handler (th/make-dummy-request {:cookies {"auth-token" old-token}}))
renewed (get-in response [::yres/cookies "auth-token" :value])
renewed-exp (:exp (tokens/decode cfg renewed))
expected-exp (ct/plus (:created-at created) (ct/duration {:days 30}))
current (session/read-session manager (:id created))]
(t/is (some? original-exp) "original token should have :exp")
(t/is (some? renewed) "renewal should issue a new cookie token")
(t/is (not= old-token renewed) "renewal should issue a new token string")
(t/is (= (inst-ms original-exp) (inst-ms renewed-exp))
"renewed token should preserve the original :exp, not extend it")
(t/is (= (inst-ms expected-exp) (inst-ms renewed-exp))
"renewed :exp should equal created-at + 30 days")
(t/is (some? current) "session row must still exist after renewal")
(t/is (pos? (compare (:modified-at current) (:modified-at stale)))
"persisted modified_at must move forward on renewal")))
(t/deftest session-renewal-cookie-expires-diverges-from-token-exp
(let [cfg th/*system*
manager (::session/manager th/*system*)
profile (th/create-profile* 1)
created (session/create-session manager {:profile-id (:id profile)
:user-agent "user agent"})
_ (th/db-exec-one! ["UPDATE http_session_v2
SET created_at = now() - interval '29 days',
modified_at = now() - interval '7 hours'
WHERE id = ?" (:id created)])
stale (session/read-session manager (:id created))
old-token (:token (#'session/assign-token cfg stale))
handler (-> (fn [req] req)
(#'session/wrap-authz cfg)
(#'mw/wrap-auth {:bearer (partial session/decode-token cfg)
:cookie (partial session/decode-token cfg)}))
response (handler (th/make-dummy-request {:cookies {"auth-token" old-token}}))
cookie (get-in response [::yres/cookies "auth-token"])
renewed (:value cookie)
renewed-exp (:exp (tokens/decode cfg renewed))
expected-exp (ct/plus (:created-at stale) (ct/duration {:days 30}))
close-to? (fn [a b tolerance-ms]
(<= (Math/abs (- (inst-ms a) (inst-ms b))) tolerance-ms))]
(t/is (some? renewed) "renewal should issue a new cookie token")
(t/is (not= old-token renewed) "renewal should issue a new token string")
(t/is (= (inst-ms expected-exp) (inst-ms renewed-exp))
"renewed :exp should equal created-at + 30 days")
(t/is (close-to? renewed-exp (ct/plus (ct/now) (ct/duration {:days 1}))
(* 10 60 1000))
"renewed :exp should be ~1 day out (absolute cap is near)")
(t/is (close-to? (:expires cookie) (ct/plus (ct/now) (ct/duration {:days 7}))
(* 10 60 1000))
"cookie Expires should slide ~7 days out from now")
(t/is (pos? (compare (:expires cookie) renewed-exp))
"cookie Expires should stay ahead of the token :exp")))
(t/deftest legacy-session-token-is-rejected
(let [cfg th/*system*
manager (session/inmemory-manager)
handler (-> (fn [req] req)
(#'session/wrap-authz {::session/manager manager})
(#'mw/wrap-auth {:bearer (partial session/decode-token cfg)
:cookie (partial session/decode-token cfg)}))
token (tokens/generate cfg {:sid "legacy-session-id"} {:kid 0 :ver 0})
response (handler (th/make-dummy-request {:cookies {"auth-token" token}}))]
(t/is (nil? (get response ::http/auth-data))
"legacy tokens must not be attached as auth data")
(t/is (nil? (::session/profile-id response))
"legacy tokens must not authenticate")))
(t/deftest session-gc-deletes-idle-and-absolute-expired-rows
(let [profile (th/create-profile* 1)
fresh (uuid/random)
idle (uuid/random)
absolute (uuid/random)
valid (uuid/random)]
(th/db-exec-one! ["INSERT INTO http_session_v2 (id, profile_id, created_at, modified_at)
VALUES (?, ?, now(), now())"
fresh (:id profile)])
(th/db-exec-one! ["INSERT INTO http_session_v2 (id, profile_id, created_at, modified_at)
VALUES (?, ?, now() - interval '1 day', now() - interval '8 days')"
idle (:id profile)])
(th/db-exec-one! ["INSERT INTO http_session_v2 (id, profile_id, created_at, modified_at)
VALUES (?, ?, now() - interval '31 days', now())"
absolute (:id profile)])
(th/db-exec-one! ["INSERT INTO http_session_v2 (id, profile_id, created_at, modified_at)
VALUES (?, ?, now() - interval '1 day', now() - interval '6 days')"
valid (:id profile)])
(db/tx-run! th/*system*
(fn [cfg]
(#'session/collect-expired-tasks
(assoc cfg
:app.http.session.tasks/max-age (ct/duration {:days 7})
:app.http.session.tasks/max-age-absolute (ct/duration {:days 30})))))
(let [ids (->> (th/db-exec! ["SELECT id FROM http_session_v2 WHERE profile_id = ?" (:id profile)])
(map :id)
(set))]
(t/is (contains? ids fresh) "fresh session must be kept")
(t/is (contains? ids valid) "session within both windows must be kept")
(t/is (not (contains? ids idle)) "idle session must be deleted")
(t/is (not (contains? ids absolute)) "session past the absolute cap must be deleted"))))
(t/deftest session-gc-config-wiring
(let [idle (ct/duration {:days 3})
absolute (ct/duration {:days 10})]
(with-redefs [cf/get (fn
([k] (case k
:auth-token-cookie-max-age idle
:auth-token-cookie-max-age-absolute absolute
nil))
([k default] (case k
:auth-token-cookie-max-age idle
:auth-token-cookie-max-age-absolute absolute
default)))]
(let [expanded (ig/expand-key :app.http.session/job-def {})]
(t/is (= idle
(get-in expanded [:app.http.session/job-def
:app.http.session.tasks/max-age]))
"task max-age should carry the configured idle window")
(t/is (= absolute
(get-in expanded [:app.http.session/job-def
:app.http.session.tasks/max-age-absolute]))
"task max-age-absolute should carry the configured absolute cap")))
(with-redefs [cf/get (fn
([_k] nil)
([_k default] default))]
(let [expanded (ig/expand-key :app.http.session/job-def {})]
(t/is (= session/default-cookie-max-age
(get-in expanded [:app.http.session/job-def
:app.http.session.tasks/max-age]))
"task max-age should fall back to the default idle window")
(t/is (= session/default-cookie-max-age-absolute
(get-in expanded [:app.http.session/job-def
:app.http.session.tasks/max-age-absolute]))
"task max-age-absolute should fall back to the default absolute cap")))))
(t/deftest session-gc-rejects-absolute-below-idle
(let [pool (:app.db/pool th/*system*)
params {:app.db/pool pool
:app.http.session.tasks/max-age (ct/duration {:days 7})
:app.http.session.tasks/max-age-absolute (ct/duration {:days 30})}]
(t/is (nil? (ig/assert-key :app.http.session/job-def params))
"absolute cap above the idle window should pass")
(t/is (nil? (ig/assert-key :app.http.session/job-def
(assoc params
:app.http.session.tasks/max-age-absolute
(ct/duration {:days 7}))))
"absolute cap equal to the idle window should pass")
(t/is (thrown? IllegalArgumentException
(ig/assert-key :app.http.session/job-def
(assoc params
:app.http.session.tasks/max-age-absolute
(ct/duration {:days 3}))))
"absolute cap below the idle window should fail fast")))
(t/deftest idle-expired-session-is-rejected
(let [cfg th/*system*
profile (th/create-profile* 1)
updated? (atom false)
session {:id (uuid/random)
:profile-id (:id profile)
:user-agent "user agent"
:created-at (ct/now)
:modified-at (ct/minus (ct/now) (ct/duration {:days 8}))}
manager (reify session/ISessionManager
(read-session [_ _] session)
(create-session [_ _] session)
(update-session [_ s] (reset! updated? true) s)
(delete-session [_ _] nil))
token (:token (#'session/assign-token cfg session))
handler (-> (fn [req] req)
(#'session/wrap-authz (assoc cfg ::session/manager manager))
(#'mw/wrap-auth {:bearer (partial session/decode-token cfg)
:cookie (partial session/decode-token cfg)}))
cookie-r (handler (th/make-dummy-request {:cookies {"auth-token" token}}))
bearer-r (handler (th/make-dummy-request {:headers {"authorization" (str "Bearer " token)}}))]
(t/is (nil? (::session/profile-id cookie-r))
"idle-expired session must not authenticate via cookie")
(t/is (nil? (::session/session cookie-r))
"idle-expired session must not be attached via cookie")
(t/is (nil? (::session/profile-id bearer-r))
"idle-expired session must not authenticate via bearer")
(t/is (false? @updated?)
"idle-expired session must not be renewed")))
(t/deftest idle-session-within-window-is-accepted
(let [cfg th/*system*
profile (th/create-profile* 1)
session {:id (uuid/random)
:profile-id (:id profile)
:user-agent "user agent"
:created-at (ct/now)
:modified-at (ct/minus (ct/now) (ct/duration {:days 6}))}
manager (reify session/ISessionManager
(read-session [_ _] session)
(create-session [_ _] session)
(update-session [_ s] (assoc s :modified-at (ct/now)))
(delete-session [_ _] nil))
token (:token (#'session/assign-token cfg session))
handler (-> (fn [req] req)
(#'session/wrap-authz (assoc cfg ::session/manager manager))
(#'mw/wrap-auth {:bearer (partial session/decode-token cfg)
:cookie (partial session/decode-token cfg)}))
response (handler (th/make-dummy-request {:cookies {"auth-token" token}}))]
(t/is (= (:id profile) (::session/profile-id response))
"session within the idle window must authenticate")))
(t/deftest parse-request-illegal-argument-exception
;; clojure.data.json raises IllegalArgumentException (case
;; fall-through) on several kinds of malformed input. The
;; parse-request middleware should convert any such IAE into a
;; 400 :malformed-json validation error rather than letting it
;; surface as a 500 internal error. Because the conversion is
;; done by raising an ex-info (caught by the top-level error
;; handler in app.http/router-handler), this test asserts on
;; the ex-info thrown by wrap-parse-request directly.
(let [handler (#'app.http.middleware/wrap-parse-request
(fn [_] {::yres/status 200 ::yres/body :ok})
(th/metrics-stub))
;; Body contains the bytes for: {"x": "\}"} -- a string
;; value with a backslash followed by '}', which
;; clojure.data.json v0.5.x cannot handle.
body (.getBytes "{\"x\": \"\\}\"}" "UTF-8")
request (th/make-dummy-request
{:method :post
:headers {"content-type" "application/json"}
:body-bytes body})
ex (try
(handler request)
(catch clojure.lang.ExceptionInfo e e))]
(t/is (instance? clojure.lang.ExceptionInfo ex))
(t/is (= :validation (-> ex ex-data :type)))
(t/is (= :malformed-json (-> ex ex-data :code)))
(t/is (= "invalid JSON in request body" (-> ex ex-data :hint)))))
(defn- malformed-requests-count
"Value of the malformed-body counter of a metrics instance."
[metrics]
(.getSampleValue ^CollectorRegistry (mtx/get-registry metrics)
"penpot_http_malformed_requests_total"
(make-array String 0)
(make-array String 0)))
(t/deftest parse-request-malformed-json-body
;; The body shape seen in production: an object where the parser expects a
;; key. clojure.data.json signals it with a bare java.lang.Exception, which
;; the class-based classification did not recognize, so it surfaced as a 500
;; :unexpected with the whole stack trace in the log. It is a client error:
;; 400 :malformed-json, and it is counted.
(let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})
handler (#'app.http.middleware/wrap-parse-request
(fn [_] {::yres/status 200 ::yres/body :ok})
metrics)
request (th/make-dummy-request
{:method :post
:headers {"content-type" "application/json"}
:body-bytes (.getBytes "{\"events\":[{{\"a\":1}:\"b\"}]}" "UTF-8")})
ex (try
(handler request)
(catch clojure.lang.ExceptionInfo e e))]
(t/is (instance? clojure.lang.ExceptionInfo ex))
(t/is (= :validation (-> ex ex-data :type)))
(t/is (= :malformed-json (-> ex ex-data :code)))
(t/is (= 1.0 (malformed-requests-count metrics)))))
(t/deftest parse-request-request-too-big-exception
;; When RequestTooBigException is raised (e.g. the request body
;; exceeded the configured size limit), the middleware should
;; convert it to a 413 :request-body-too-large validation
;; error.
(let [handler (#'app.http.middleware/wrap-parse-request
(fn [_] (throw (RequestTooBigException. "too large")))
(th/metrics-stub))
request (th/make-dummy-request
{:method :post
:headers {"content-type" "application/json"}
:body-bytes (.getBytes "{}" "UTF-8")})
ex (try
(handler request)
(catch clojure.lang.ExceptionInfo e e))]
(t/is (instance? clojure.lang.ExceptionInfo ex))
(t/is (= :validation (-> ex ex-data :type)))
(t/is (= :request-body-too-large (-> ex ex-data :code)))
(t/is (= "request body exceeds size limit" (-> ex ex-data :hint)))))
(t/deftest parse-request-eof-exception
;; When java.io.EOFException is raised (e.g. the body stream
;; was closed before the parser could read it), the middleware
;; should convert it to a 400 :malformed-json validation error.
(let [handler (#'app.http.middleware/wrap-parse-request
(fn [_] (throw (java.io.EOFException. "stream closed")))
(th/metrics-stub))
request (th/make-dummy-request
{:method :post
:headers {"content-type" "application/json"}
:body-bytes (.getBytes "{}" "UTF-8")})
ex (try
(handler request)
(catch clojure.lang.ExceptionInfo e e))]
(t/is (instance? clojure.lang.ExceptionInfo ex))
(t/is (= :validation (-> ex ex-data :type)))
(t/is (= :malformed-json (-> ex ex-data :code)))
(t/is (= "unexpected end of request body" (-> ex ex-data :hint)))))
(t/deftest parse-request-runtime-exception-with-cause
;; When a RuntimeException with a non-nil ex-cause is raised,
;; the middleware should recurse on the cause and dispatch
;; through the specific-exception branches. Here we wrap an
;; IllegalArgumentException in a RuntimeException and verify
;; it surfaces as :malformed-json.
(let [iae (IllegalArgumentException. "No matching clause: 99")
wrapped (doto (RuntimeException. "wrapped")
(.initCause iae))
handler (#'app.http.middleware/wrap-parse-request
(fn [_] (throw wrapped))
(th/metrics-stub))
request (th/make-dummy-request
{:method :post
:headers {"content-type" "application/json"}
:body-bytes (.getBytes "{}" "UTF-8")})
ex (try
(handler request)
(catch clojure.lang.ExceptionInfo e e))]
(t/is (instance? clojure.lang.ExceptionInfo ex))
(t/is (= :validation (-> ex ex-data :type)))
(t/is (= :malformed-json (-> ex ex-data :code)))))
(t/deftest parse-request-runtime-exception-without-cause
;; When a bare RuntimeException (no ex-cause) is raised, the
;; middleware should fall through to errors/handle's :default
;; path and return a 500 with :type :server-error :code
;; :unexpected. This is the "true internal error" path.
(let [handler (#'app.http.middleware/wrap-parse-request
(fn [_] (throw (RuntimeException. "boom")))
(th/metrics-stub))
request (th/make-dummy-request
{:method :post
:headers {"content-type" "application/json"}
:body-bytes (.getBytes "{}" "UTF-8")})
response (handler request)
body (::yres/body response)]
(t/is (= 500 (::yres/status response)))
(t/is (= :server-error (:type body)))
(t/is (= :unexpected (:code body)))
(t/is (nil? (:hint body)))))
(t/deftest parse-request-non-runtime-throwable
;; When a non-RuntimeException Throwable is raised (e.g. an
;; Error subclass or a non-RuntimeException checked-style
;; exception), the middleware should fall through to the
;; :else branch and call errors/handle. java.io.IOException
;; has a dedicated handle-exception method that returns 500
;; with :code :io-exception.
(let [handler (#'app.http.middleware/wrap-parse-request
(fn [_] (throw (java.io.IOException. "network gone")))
(th/metrics-stub))
request (th/make-dummy-request
{:method :post
:headers {"content-type" "application/json"}
:body-bytes (.getBytes "{}" "UTF-8")})
response (handler request)
body (::yres/body response)]
(t/is (= 500 (::yres/status response)))
(t/is (= :server-error (:type body)))
(t/is (= :io-exception (:code body)))
(t/is (nil? (:hint body)))))
(t/deftest internal-error-strips-sensitive-fields
;; When an :internal error is raised with :state, :path, and
;; :context, those fields must not appear in the response body.
;; :hint is part of the error protocol and is preserved.
(let [cause (ex-info "internal error"
{:type :internal
:code :test-error
:hint "safe user-facing hint"
:state "XX000"
:path "/data/penpot/storage"
:context {:backend :s3 :bucket "prod"}})
response (http-errors/handle cause {})
body (::yres/body response)]
(t/is (= 500 (::yres/status response)))
(t/is (= :server-error (:type body)))
(t/is (= :test-error (:code body)))
(t/is (= "safe user-facing hint" (:hint body)))
(t/is (nil? (:state body)))
(t/is (nil? (:path body)))
(t/is (nil? (:context body)))))
(t/deftest unhandled-exinfo-strips-sensitive-fields
;; When an ex-info with an unregistered :type (dispatches through
;; handle-exception :default :else) carries :state and :path,
;; those fields must not appear in the response body.
;; :hint is part of the error protocol and is preserved.
(let [cause (ex-info "something broke"
{:type :unregistered-type
:code :custom-code
:hint "safe user-facing hint"
:state "internal-state"
:path "/internal/path"})
response (http-errors/handle cause {})
body (::yres/body response)]
(t/is (= 500 (::yres/status response)))
(t/is (= :server-error (:type body)))
(t/is (= :custom-code (:code body)))
(t/is (= "safe user-facing hint" (:hint body)))
(t/is (nil? (:state body)))
(t/is (nil? (:path body)))))
(t/deftest validation-error-body-with-raw-explain-is-json-serializable
;; A :validation error whose ex-data carries the raw malli explain
;; (storage invalid-storage-metadata) must produce a response body
;; that survives JSON encoding. Before the fix the live schema
;; object inside the explain broke the writer mid-stream and the
;; client received a truncated body.
(let [cause (try
(stsch/encode-metadata {})
(catch clojure.lang.ExceptionInfo cause cause))
response (http-errors/handle cause {})
body (::yres/body response)]
(t/is (= 400 (::yres/status response)))
(t/is (= :validation (:type body)))
(t/is (= :invalid-storage-metadata (:code body)))
(t/is (nil? (:app.common.schema/explain body)))
(let [encoded (json/encode body :key-fn json/write-camel-key)
decoded (json/decode encoded :key-fn json/read-kebab-key)]
(t/is (str/includes? encoded "invalid-storage-metadata"))
(t/is (string? (:explain decoded))))))