init codebase
This commit is contained in:
@@ -0,0 +1,12 @@
|
||||
{:tasks
|
||||
{test
|
||||
{:doc "Run all shared module tests"
|
||||
:task (shell {:dir ".."} "bb test:shared")}
|
||||
|
||||
test:unit
|
||||
{:doc "Run shared unit tests only"
|
||||
:task (shell {:dir ".."} "bb test:shared:unit")}
|
||||
|
||||
test:integration
|
||||
{:doc "Run shared integration tests"
|
||||
:task (shell {:dir ".."} "bb test:shared:integration")}}}
|
||||
+16
-2
@@ -1,8 +1,22 @@
|
||||
{:paths ["src"]
|
||||
{:paths ["src" "resources"]
|
||||
:deps {org.clojure/clojure {:mvn/version "1.12.0"}
|
||||
;; DB
|
||||
com.github.seancorfield/next.jdbc {:mvn/version "1.3.955"}
|
||||
com.github.seancorfield/honeysql {:mvn/version "2.6.1230"}
|
||||
org.postgresql/postgresql {:mvn/version "42.7.4"}
|
||||
com.zaxxer/HikariCP {:mvn/version "6.2.1"}
|
||||
migratus/migratus {:mvn/version "1.5.8"}
|
||||
;; NATS
|
||||
io.nats/jnats {:mvn/version "2.20.5"}
|
||||
;; HTTP client
|
||||
org.babashka/http-client {:mvn/version "0.4.22"}
|
||||
org.clojure/data.json {:mvn/version "2.5.1"}}}
|
||||
;; JSON
|
||||
org.clojure/data.json {:mvn/version "2.5.1"}
|
||||
;; Logging
|
||||
org.clojure/tools.logging {:mvn/version "1.3.0"}
|
||||
ch.qos.logback/logback-classic {:mvn/version "1.5.16"}
|
||||
net.logstash.logback/logstash-logback-encoder {:mvn/version "8.0"}
|
||||
;; S3/MinIO
|
||||
software.amazon.awssdk/s3 {:mvn/version "2.29.51"}
|
||||
;; Spec
|
||||
org.clojure/spec.alpha {:mvn/version "0.5.238"}}}
|
||||
|
||||
@@ -0,0 +1,33 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<configuration>
|
||||
<!-- Dev: human-readable console output -->
|
||||
<appender name="CONSOLE" class="ch.qos.logback.core.ConsoleAppender">
|
||||
<encoder>
|
||||
<pattern>%d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %X{trace-id:-} %msg%n</pattern>
|
||||
</encoder>
|
||||
</appender>
|
||||
|
||||
<!-- Prod: structured JSON output -->
|
||||
<appender name="JSON" class="ch.qos.logback.core.ConsoleAppender">
|
||||
<encoder class="net.logstash.logback.encoder.LogstashEncoder">
|
||||
<includeMdcKeyName>trace-id</includeMdcKeyName>
|
||||
<includeMdcKeyName>user-id</includeMdcKeyName>
|
||||
<includeMdcKeyName>method</includeMdcKeyName>
|
||||
<includeMdcKeyName>path</includeMdcKeyName>
|
||||
</encoder>
|
||||
</appender>
|
||||
|
||||
<!-- Default: console appender -->
|
||||
<root level="INFO">
|
||||
<appender-ref ref="CONSOLE" />
|
||||
</root>
|
||||
|
||||
<!-- Reduce noise from libraries -->
|
||||
<logger name="com.zaxxer.hikari" level="WARN" />
|
||||
<logger name="io.nats" level="WARN" />
|
||||
<logger name="org.eclipse.jetty" level="WARN" />
|
||||
<logger name="software.amazon" level="WARN" />
|
||||
|
||||
<!-- App namespaces at DEBUG in dev -->
|
||||
<logger name="ajet.chat" level="DEBUG" />
|
||||
</configuration>
|
||||
@@ -2,60 +2,48 @@
|
||||
"HTTP client SDK for the ajet-chat API.
|
||||
|
||||
All public functions take an explicit context map (ctx) as the first argument.
|
||||
This avoids dynamic vars which don't work with core.async or cross-thread
|
||||
callbacks (NATS handlers, SSE).
|
||||
|
||||
ctx shape:
|
||||
{:base-url \"http://localhost:3001\" ;; API URL (SMs) or Auth GW URL (CLI)
|
||||
:auth-token \"base64url-token\" ;; raw token, SDK prepends \"Bearer \"
|
||||
:trace-id \"uuid\" ;; optional, from X-Trace-Id
|
||||
:user-id \"uuid\" ;; optional, informational
|
||||
:user-role \"admin\"} ;; optional, informational
|
||||
{:base-url \"http://localhost:3001\"
|
||||
:auth-token \"base64url-token\"
|
||||
:trace-id \"uuid\"
|
||||
:user-id \"uuid\"
|
||||
:user-role \"admin\"
|
||||
:timeout 10000}
|
||||
|
||||
Error handling:
|
||||
- HTTP 4xx/5xx → ex-info with {:type :ajet.chat/api-error, :status, :body, :trace-id}
|
||||
- Network errors (connect refused, timeout) → propagate raw from http-client"
|
||||
- HTTP 4xx/5xx -> ex-info with {:type :ajet.chat/api-error, :status, :body, :trace-id}
|
||||
- Network errors -> propagated from http-client"
|
||||
(:require [babashka.http-client :as http]
|
||||
[clojure.data.json :as json]
|
||||
[clojure.string :as str]))
|
||||
[clojure.java.io :as io]
|
||||
[clojure.string :as str]
|
||||
[clojure.tools.logging :as log]))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Private HTTP layer
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- api-url
|
||||
"Join base-url and path, ensuring exactly one slash between them."
|
||||
[base-url path]
|
||||
(let [base (if (str/ends-with? base-url "/")
|
||||
(subs base-url 0 (dec (count base-url)))
|
||||
base-url)
|
||||
p (if (str/starts-with? path "/")
|
||||
(subs path 1)
|
||||
path)]
|
||||
(defn- api-url [base-url path]
|
||||
(let [base (cond-> base-url (str/ends-with? base-url "/") (subs 0 (dec (count base-url))))
|
||||
p (cond-> path (str/starts-with? path "/") (subs 1))]
|
||||
(str base "/" p)))
|
||||
|
||||
(defn- build-headers
|
||||
"Build HTTP headers from ctx."
|
||||
[ctx]
|
||||
(defn- build-headers [ctx]
|
||||
(cond-> {"Accept" "application/json"}
|
||||
(:auth-token ctx) (assoc "Authorization" (str "Bearer " (:auth-token ctx)))
|
||||
(:trace-id ctx) (assoc "X-Trace-Id" (:trace-id ctx))))
|
||||
(:trace-id ctx) (assoc "X-Trace-Id" (:trace-id ctx))
|
||||
(:user-id ctx) (assoc "X-User-Id" (:user-id ctx))
|
||||
(:user-role ctx) (assoc "X-User-Role" (:user-role ctx))))
|
||||
|
||||
(defn- encode-json
|
||||
"Encode a Clojure value as a JSON string."
|
||||
[data]
|
||||
(defn- encode-json [data]
|
||||
(json/write-str data))
|
||||
|
||||
(defn- parse-json
|
||||
"Parse a JSON string into a Clojure map with keyword keys.
|
||||
Returns nil for nil/blank input."
|
||||
[s]
|
||||
(defn- parse-json [s]
|
||||
(when-not (str/blank? s)
|
||||
(json/read-str s :key-fn keyword)))
|
||||
|
||||
(defn- check-response!
|
||||
"Throw ex-info on 4xx/5xx responses."
|
||||
[response trace-id]
|
||||
(defn- check-response! [response trace-id]
|
||||
(let [status (:status response)]
|
||||
(when (>= status 400)
|
||||
(throw (ex-info (str "API error: HTTP " status)
|
||||
@@ -65,31 +53,40 @@
|
||||
:trace-id trace-id})))))
|
||||
|
||||
(defn- request!
|
||||
"Core HTTP dispatch. All public functions route through here.
|
||||
Returns parsed JSON body as a Clojure map."
|
||||
[ctx method path & [{:keys [body query-params]}]]
|
||||
(let [headers (cond-> (build-headers ctx)
|
||||
body (assoc "Content-Type" "application/json"))
|
||||
url (api-url (:base-url ctx) path)
|
||||
trace-id (:trace-id ctx)
|
||||
opts (cond-> {:method method
|
||||
:uri url
|
||||
:headers headers
|
||||
:throw false}
|
||||
body (assoc :body (encode-json body))
|
||||
query-params (assoc :query-params query-params))
|
||||
response (http/request opts)]
|
||||
(check-response! response trace-id)
|
||||
(parse-json (:body response))))
|
||||
"Core HTTP dispatch with optional retry on 5xx."
|
||||
[ctx method path & [{:keys [body query-params multipart]}]]
|
||||
(let [headers (cond-> (build-headers ctx)
|
||||
(and body (not multipart)) (assoc "Content-Type" "application/json"))
|
||||
url (api-url (:base-url ctx) path)
|
||||
trace-id (:trace-id ctx)
|
||||
timeout (or (:timeout ctx) 10000)
|
||||
base-opts (cond-> {:method method
|
||||
:uri url
|
||||
:headers headers
|
||||
:throw false
|
||||
:timeout timeout}
|
||||
(and body (not multipart)) (assoc :body (encode-json body))
|
||||
multipart (assoc :multipart multipart)
|
||||
query-params (assoc :query-params query-params))
|
||||
max-retries 3]
|
||||
(loop [attempt 1]
|
||||
(let [response (http/request base-opts)
|
||||
status (:status response)]
|
||||
(if (and (>= status 500) (< attempt max-retries))
|
||||
(do
|
||||
(log/warn "Retrying request" method url "attempt" (inc attempt) "status" status)
|
||||
(Thread/sleep (* attempt 500))
|
||||
(recur (inc attempt)))
|
||||
(do
|
||||
(check-response! response trace-id)
|
||||
(parse-json (:body response))))))))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Context helper
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn request->ctx
|
||||
"Build an API client ctx from a Ring request and the API base URL.
|
||||
Extracts auth token from Authorization header and trace/user info from
|
||||
custom headers injected by Auth GW."
|
||||
"Build an API client ctx from a Ring request and the API base URL."
|
||||
[ring-request api-base-url]
|
||||
(let [headers (:headers ring-request)
|
||||
auth (get headers "authorization")
|
||||
@@ -101,118 +98,249 @@
|
||||
token (assoc :auth-token token)
|
||||
(get headers "x-trace-id") (assoc :trace-id (get headers "x-trace-id"))
|
||||
(get headers "x-user-id") (assoc :user-id (get headers "x-user-id"))
|
||||
(get headers "x-user-role") (assoc :user-role (get headers "x-user-role")))))
|
||||
(get headers "x-user-role") (assoc :user-role (get headers "x-user-role"))
|
||||
(get headers "x-community-id") (assoc :community-id (get headers "x-community-id")))))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Public API — Channels (community-scoped)
|
||||
;;; Communities
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn get-channels
|
||||
"List channels for a community."
|
||||
[ctx community-slug]
|
||||
(request! ctx :get (str "c/" community-slug "/channels")))
|
||||
(defn create-community [ctx body-map]
|
||||
(request! ctx :post "/api/communities" {:body body-map}))
|
||||
|
||||
(defn get-channel
|
||||
"Get a single channel by ID within a community."
|
||||
[ctx community-slug channel-id]
|
||||
(request! ctx :get (str "c/" community-slug "/channels/" channel-id)))
|
||||
(defn get-communities [ctx]
|
||||
(request! ctx :get "/api/communities"))
|
||||
|
||||
(defn get-community [ctx community-id]
|
||||
(request! ctx :get (str "/api/communities/" community-id)))
|
||||
|
||||
(defn update-community [ctx community-id body-map]
|
||||
(request! ctx :put (str "/api/communities/" community-id) {:body body-map}))
|
||||
|
||||
(defn delete-community [ctx community-id]
|
||||
(request! ctx :delete (str "/api/communities/" community-id)))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Public API — Messages
|
||||
;;; Channels
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn get-channels [ctx community-id]
|
||||
(request! ctx :get (str "/api/communities/" community-id "/channels")))
|
||||
|
||||
(defn create-channel [ctx community-id body-map]
|
||||
(request! ctx :post (str "/api/communities/" community-id "/channels") {:body body-map}))
|
||||
|
||||
(defn get-channel [ctx channel-id]
|
||||
(request! ctx :get (str "/api/channels/" channel-id)))
|
||||
|
||||
(defn update-channel [ctx channel-id body-map]
|
||||
(request! ctx :put (str "/api/channels/" channel-id) {:body body-map}))
|
||||
|
||||
(defn delete-channel [ctx channel-id]
|
||||
(request! ctx :delete (str "/api/channels/" channel-id)))
|
||||
|
||||
(defn join-channel [ctx channel-id]
|
||||
(request! ctx :post (str "/api/channels/" channel-id "/join")))
|
||||
|
||||
(defn leave-channel [ctx channel-id]
|
||||
(request! ctx :post (str "/api/channels/" channel-id "/leave")))
|
||||
|
||||
(defn get-channel-members [ctx channel-id]
|
||||
(request! ctx :get (str "/api/channels/" channel-id "/members")))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Channel Categories
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn get-categories [ctx community-id]
|
||||
(request! ctx :get (str "/api/communities/" community-id "/categories")))
|
||||
|
||||
(defn create-category [ctx community-id body-map]
|
||||
(request! ctx :post (str "/api/communities/" community-id "/categories") {:body body-map}))
|
||||
|
||||
(defn update-category [ctx category-id body-map]
|
||||
(request! ctx :put (str "/api/categories/" category-id) {:body body-map}))
|
||||
|
||||
(defn delete-category [ctx category-id]
|
||||
(request! ctx :delete (str "/api/categories/" category-id)))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Messages
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn get-messages
|
||||
"Fetch messages for a channel. opts may include :after, :before, :limit, :thread."
|
||||
"Fetch messages for a channel. opts: :before :limit"
|
||||
[ctx channel-id & [opts]]
|
||||
(let [qp (cond-> {}
|
||||
(:after opts) (assoc "after" (str (:after opts)))
|
||||
(:before opts) (assoc "before" (str (:before opts)))
|
||||
(:limit opts) (assoc "limit" (str (:limit opts)))
|
||||
(:thread opts) (assoc "thread" (str (:thread opts))))]
|
||||
(request! ctx :get (str "api/messages/" channel-id)
|
||||
(:limit opts) (assoc "limit" (str (:limit opts))))]
|
||||
(request! ctx :get (str "/api/channels/" channel-id "/messages")
|
||||
(when (seq qp) {:query-params qp}))))
|
||||
|
||||
(defn send-message
|
||||
"Send a message to a channel. body-map should contain at least :body_md."
|
||||
[ctx channel-id body-map]
|
||||
(request! ctx :post (str "api/messages/" channel-id) {:body body-map}))
|
||||
(defn get-message [ctx message-id]
|
||||
(request! ctx :get (str "/api/messages/" message-id)))
|
||||
|
||||
(defn edit-message
|
||||
"Edit a message. body-map should contain :body_md."
|
||||
[ctx message-id body-map]
|
||||
(request! ctx :put (str "api/messages/" message-id) {:body body-map}))
|
||||
(defn send-message [ctx channel-id body-map]
|
||||
(request! ctx :post (str "/api/channels/" channel-id "/messages") {:body body-map}))
|
||||
|
||||
(defn delete-message
|
||||
"Delete a message."
|
||||
[ctx message-id]
|
||||
(request! ctx :delete (str "api/messages/" message-id)))
|
||||
(defn edit-message [ctx message-id body-map]
|
||||
(request! ctx :put (str "/api/messages/" message-id) {:body body-map}))
|
||||
|
||||
(defn delete-message [ctx message-id]
|
||||
(request! ctx :delete (str "/api/messages/" message-id)))
|
||||
|
||||
(defn get-thread [ctx message-id]
|
||||
(request! ctx :get (str "/api/messages/" message-id "/thread")))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Public API — Reactions
|
||||
;;; Reactions
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn add-reaction
|
||||
"Add a reaction (emoji) to a message. Idempotent."
|
||||
[ctx message-id emoji]
|
||||
(request! ctx :put (str "api/messages/" message-id "/reactions/" emoji)))
|
||||
(defn add-reaction [ctx message-id emoji]
|
||||
(request! ctx :put (str "/api/messages/" message-id "/reactions/" emoji)))
|
||||
|
||||
(defn remove-reaction
|
||||
"Remove a reaction (emoji) from a message."
|
||||
[ctx message-id emoji]
|
||||
(request! ctx :delete (str "api/messages/" message-id "/reactions/" emoji)))
|
||||
(defn remove-reaction [ctx message-id emoji]
|
||||
(request! ctx :delete (str "/api/messages/" message-id "/reactions/" emoji)))
|
||||
|
||||
(defn get-reactions [ctx message-id]
|
||||
(request! ctx :get (str "/api/messages/" message-id "/reactions")))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Public API — DMs (global)
|
||||
;;; DMs
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn get-dms
|
||||
"List the current user's DM channels."
|
||||
[ctx]
|
||||
(request! ctx :get "dm"))
|
||||
(defn get-dms [ctx]
|
||||
(request! ctx :get "/api/dms"))
|
||||
|
||||
(defn get-or-create-dm
|
||||
"Get or create a DM channel with another user. body-map should contain :user_id."
|
||||
[ctx body-map]
|
||||
(request! ctx :post "dm" {:body body-map}))
|
||||
(defn create-dm [ctx body-map]
|
||||
(request! ctx :post "/api/dms" {:body body-map}))
|
||||
|
||||
(defn create-group-dm [ctx body-map]
|
||||
(request! ctx :post "/api/dms/group" {:body body-map}))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Public API — Users
|
||||
;;; Users & Profiles
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn get-user
|
||||
"Get a user by ID."
|
||||
[ctx user-id]
|
||||
(request! ctx :get (str "api/users/" user-id)))
|
||||
(defn get-me [ctx]
|
||||
(request! ctx :get "/api/me"))
|
||||
|
||||
(defn get-me
|
||||
"Get the current authenticated user."
|
||||
[ctx]
|
||||
(request! ctx :get "api/users/me"))
|
||||
(defn update-me [ctx body-map]
|
||||
(request! ctx :put "/api/me" {:body body-map}))
|
||||
|
||||
(defn get-user [ctx user-id]
|
||||
(request! ctx :get (str "/api/users/" user-id)))
|
||||
|
||||
(defn get-community-members [ctx community-id]
|
||||
(request! ctx :get (str "/api/communities/" community-id "/members")))
|
||||
|
||||
(defn update-community-member [ctx community-id user-id body-map]
|
||||
(request! ctx :put (str "/api/communities/" community-id "/members/" user-id) {:body body-map}))
|
||||
|
||||
(defn kick-member [ctx community-id user-id]
|
||||
(request! ctx :delete (str "/api/communities/" community-id "/members/" user-id)))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Public API — Notifications
|
||||
;;; Notifications
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn get-notifications
|
||||
"Fetch notifications. opts may include :unread, :after, :limit."
|
||||
[ctx & [opts]]
|
||||
(defn get-notifications [ctx & [opts]]
|
||||
(let [qp (cond-> {}
|
||||
(some? (:unread opts)) (assoc "unread" (str (:unread opts)))
|
||||
(:after opts) (assoc "after" (str (:after opts)))
|
||||
(:limit opts) (assoc "limit" (str (:limit opts))))]
|
||||
(request! ctx :get "api/notifications"
|
||||
(request! ctx :get "/api/notifications"
|
||||
(when (seq qp) {:query-params qp}))))
|
||||
|
||||
(defn mark-notifications-read
|
||||
"Mark notifications as read. body-map should contain :notification_ids."
|
||||
[ctx body-map]
|
||||
(request! ctx :post "api/notifications/read" {:body body-map}))
|
||||
(defn mark-notifications-read [ctx body-map]
|
||||
(request! ctx :post "/api/notifications/read" {:body body-map}))
|
||||
|
||||
(defn get-unread-count [ctx]
|
||||
(request! ctx :get "/api/notifications/unread-count"))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Public API — Presence
|
||||
;;; Presence & Typing
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn heartbeat
|
||||
"Send a presence heartbeat."
|
||||
[ctx]
|
||||
(request! ctx :post "api/heartbeat"))
|
||||
(defn heartbeat [ctx]
|
||||
(request! ctx :post "/api/heartbeat"))
|
||||
|
||||
(defn get-presence [ctx community-id]
|
||||
(request! ctx :get (str "/api/communities/" community-id "/presence")))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Search
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn search [ctx opts]
|
||||
(let [qp (cond-> {"q" (:q opts)}
|
||||
(:type opts) (assoc "type" (name (:type opts)))
|
||||
(:community-id opts) (assoc "community_id" (str (:community-id opts)))
|
||||
(:channel-id opts) (assoc "channel_id" (str (:channel-id opts)))
|
||||
(:from opts) (assoc "from" (str (:from opts)))
|
||||
(:after opts) (assoc "after" (str (:after opts)))
|
||||
(:before opts) (assoc "before" (str (:before opts)))
|
||||
(:limit opts) (assoc "limit" (str (:limit opts))))]
|
||||
(request! ctx :get "/api/search" {:query-params qp})))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Invites
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn create-invite [ctx community-id body-map]
|
||||
(request! ctx :post (str "/api/communities/" community-id "/invites") {:body body-map}))
|
||||
|
||||
(defn get-invites [ctx community-id]
|
||||
(request! ctx :get (str "/api/communities/" community-id "/invites")))
|
||||
|
||||
(defn revoke-invite [ctx invite-id]
|
||||
(request! ctx :delete (str "/api/invites/" invite-id)))
|
||||
|
||||
(defn accept-invite [ctx code]
|
||||
(request! ctx :post (str "/api/invites/" code "/accept")))
|
||||
|
||||
(defn direct-invite [ctx community-id body-map]
|
||||
(request! ctx :post (str "/api/communities/" community-id "/invites/direct") {:body body-map}))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Webhooks
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn create-webhook [ctx community-id body-map]
|
||||
(request! ctx :post (str "/api/communities/" community-id "/webhooks") {:body body-map}))
|
||||
|
||||
(defn get-webhooks [ctx community-id]
|
||||
(request! ctx :get (str "/api/communities/" community-id "/webhooks")))
|
||||
|
||||
(defn delete-webhook [ctx webhook-id]
|
||||
(request! ctx :delete (str "/api/webhooks/" webhook-id)))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Slash Commands
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn execute-command [ctx body-map]
|
||||
(request! ctx :post "/api/commands" {:body body-map}))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; File Upload
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn upload-file [ctx channel-id file-path content-type]
|
||||
(request! ctx :post (str "/api/channels/" channel-id "/upload")
|
||||
{:multipart [{:name "file" :content (io/file file-path)
|
||||
:content-type content-type}]}))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Read Tracking
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn mark-read [ctx channel-id body-map]
|
||||
(request! ctx :post (str "/api/channels/" channel-id "/read") {:body body-map}))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Health
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn health [ctx]
|
||||
(request! ctx :get "/api/health"))
|
||||
|
||||
@@ -0,0 +1,112 @@
|
||||
(ns ajet.chat.shared.config
|
||||
"Configuration loader — EDN files + env var overrides.
|
||||
|
||||
Env var convention: AJET__DB__HOST -> {:db {:host \"...\"}}
|
||||
Double underscores separate nesting levels, single underscores become hyphens.
|
||||
Example: AJET__MINIO__ACCESS_KEY -> {:minio {:access-key \"...\"}}"
|
||||
(:require [clojure.edn :as edn]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.string :as str]))
|
||||
|
||||
(def ^:private shared-defaults
|
||||
{:db {:host "localhost" :port 5432 :dbname "ajet_chat" :user "ajet" :pool-size 10
|
||||
:migrations {:enabled true :location "migrations"}}
|
||||
:nats {:url "nats://localhost:4222"}
|
||||
:minio {:endpoint "http://localhost:9000"
|
||||
:access-key "minioadmin"
|
||||
:secret-key "minioadmin"
|
||||
:bucket "ajet-chat"}})
|
||||
|
||||
(def ^:private secret-keys
|
||||
"Keys whose values must never be logged."
|
||||
#{:password :secret :secret-key :client-secret :token :token-hash})
|
||||
|
||||
(defn- deep-merge
|
||||
"Recursively merge maps. Later values win for non-map leaves."
|
||||
[& maps]
|
||||
(reduce (fn [acc m]
|
||||
(reduce-kv (fn [a k v]
|
||||
(let [existing (get a k)]
|
||||
(if (and (map? existing) (map? v))
|
||||
(assoc a k (deep-merge existing v))
|
||||
(assoc a k v))))
|
||||
acc m))
|
||||
{} maps))
|
||||
|
||||
(defn- coerce-value
|
||||
"Coerce string env var value to appropriate type."
|
||||
[s]
|
||||
(cond
|
||||
(re-matches #"\d+" s) (parse-long s)
|
||||
(= "true" s) true
|
||||
(= "false" s) false
|
||||
:else s))
|
||||
|
||||
(defn- env-var->path
|
||||
"Convert AJET__DB__HOST to [:db :host].
|
||||
Double underscore __ separates nesting levels.
|
||||
Single underscore within a segment becomes hyphen (kebab-case).
|
||||
Example: AJET__MINIO__ACCESS_KEY -> [:minio :access-key]"
|
||||
[var-name]
|
||||
(let [stripped (str/replace-first var-name #"(?i)^AJET__" "")
|
||||
segments (str/split stripped #"__")]
|
||||
(mapv #(keyword (-> % str/lower-case (str/replace "_" "-"))) segments)))
|
||||
|
||||
(defn- env-overrides
|
||||
"Read all AJET__* env vars and convert to nested config map.
|
||||
Uses double-underscore prefix (AJET__) to distinguish from other vars."
|
||||
[]
|
||||
(reduce-kv (fn [acc k v]
|
||||
(if (str/starts-with? k "AJET__")
|
||||
(let [path (env-var->path k)]
|
||||
(assoc-in acc path (coerce-value v)))
|
||||
acc))
|
||||
{} (System/getenv)))
|
||||
|
||||
(defn- load-edn-resource
|
||||
"Load EDN from classpath resource."
|
||||
[path]
|
||||
(when-let [r (io/resource path)]
|
||||
(edn/read-string (slurp r))))
|
||||
|
||||
(defn- load-edn-file
|
||||
"Load EDN from filesystem path."
|
||||
[path]
|
||||
(let [f (io/file path)]
|
||||
(when (.exists f)
|
||||
(edn/read-string (slurp f)))))
|
||||
|
||||
(defn redact
|
||||
"Replace secret values in config with [REDACTED] for safe logging."
|
||||
[config]
|
||||
(cond
|
||||
(map? config)
|
||||
(reduce-kv (fn [m k v]
|
||||
(assoc m k (if (secret-keys k)
|
||||
"[REDACTED]"
|
||||
(redact v))))
|
||||
{} config)
|
||||
(sequential? config)
|
||||
(mapv redact config)
|
||||
:else config))
|
||||
|
||||
(defn load-config
|
||||
"Load configuration with priority: env vars > module config > shared defaults.
|
||||
|
||||
Options:
|
||||
:file - EDN file path (filesystem)
|
||||
:resource - EDN classpath resource name (default: \"config.edn\")
|
||||
:profile - :dev, :test, or :prod (merges profile-specific overrides)"
|
||||
[& [{:keys [file resource profile] :or {resource "config.edn"}}]]
|
||||
(let [file-config (if file
|
||||
(or (load-edn-file file)
|
||||
(throw (ex-info (str "Config file not found: " file)
|
||||
{:file file})))
|
||||
(load-edn-resource resource))
|
||||
base (deep-merge shared-defaults (or file-config {}))
|
||||
profile-config (when profile (get-in file-config [:profiles profile]))
|
||||
with-profile (if profile-config
|
||||
(deep-merge base profile-config)
|
||||
base)
|
||||
with-env (deep-merge with-profile (env-overrides))]
|
||||
with-env))
|
||||
@@ -1,17 +1,133 @@
|
||||
(ns ajet.chat.shared.db
|
||||
"Database layer — uses next.jdbc + HoneySQL. PostgreSQL everywhere."
|
||||
"Database layer — HikariCP connection pool, HoneySQL query execution, Migratus migrations."
|
||||
(:require [next.jdbc :as jdbc]
|
||||
[honey.sql :as sql]))
|
||||
[next.jdbc.result-set :as rs]
|
||||
[honey.sql :as sql]
|
||||
[clojure.tools.logging :as log]
|
||||
[migratus.core :as migratus])
|
||||
(:import [com.zaxxer.hikari HikariDataSource HikariConfig]))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Connection Pool
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn make-datasource
|
||||
"Create a PostgreSQL datasource."
|
||||
[& [{:keys [dbname host port user password]
|
||||
:or {dbname "ajet_chat"
|
||||
host "localhost"
|
||||
port 5432}}]]
|
||||
(jdbc/get-datasource {:dbtype "postgresql"
|
||||
:dbname dbname
|
||||
:host host
|
||||
:port port
|
||||
:user user
|
||||
:password password}))
|
||||
"Create a HikariCP connection pool from config map.
|
||||
|
||||
Config shape:
|
||||
{:host \"localhost\" :port 5432 :dbname \"ajet_chat\"
|
||||
:user \"ajet\" :password \"...\" :pool-size 10}"
|
||||
[config]
|
||||
(let [{:keys [host port dbname user password pool-size]
|
||||
:or {host "localhost" port 5432 dbname "ajet_chat"
|
||||
user "ajet" pool-size 10}} config
|
||||
jdbc-url (format "jdbc:postgresql://%s:%d/%s" host port dbname)
|
||||
hk-config (doto (HikariConfig.)
|
||||
(.setJdbcUrl jdbc-url)
|
||||
(.setUsername user)
|
||||
(.setMaximumPoolSize pool-size)
|
||||
(.setMinimumIdle (min 2 pool-size))
|
||||
(.setConnectionTimeout 10000)
|
||||
(.setIdleTimeout 600000)
|
||||
(.setMaxLifetime 1800000)
|
||||
(.setPoolName "ajet-chat-pool"))]
|
||||
(when password
|
||||
(.setPassword hk-config password))
|
||||
(HikariDataSource. hk-config)))
|
||||
|
||||
(defn close-datasource
|
||||
"Close a HikariCP datasource."
|
||||
[^HikariDataSource ds]
|
||||
(.close ds))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Query Execution (HoneySQL)
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(def ^:private default-opts
|
||||
{:builder-fn rs/as-unqualified-kebab-maps})
|
||||
|
||||
(def ^:private slow-query-threshold-ms 500)
|
||||
|
||||
(defn- log-slow-query [sql-vec duration-ms]
|
||||
(when (> duration-ms slow-query-threshold-ms)
|
||||
(log/warn (format "Slow query (%.0fms): %s" (double duration-ms) (first sql-vec)))))
|
||||
|
||||
(defn execute!
|
||||
"Execute a HoneySQL map, returning a vector of result maps."
|
||||
[ds hsql-map]
|
||||
(let [sql-vec (sql/format hsql-map)
|
||||
start (System/nanoTime)
|
||||
result (jdbc/execute! ds sql-vec default-opts)
|
||||
duration (/ (- (System/nanoTime) start) 1e6)]
|
||||
(log-slow-query sql-vec duration)
|
||||
result))
|
||||
|
||||
(defn execute-one!
|
||||
"Execute a HoneySQL map, returning the first result map or nil."
|
||||
[ds hsql-map]
|
||||
(let [sql-vec (sql/format hsql-map)
|
||||
start (System/nanoTime)
|
||||
result (jdbc/execute-one! ds sql-vec default-opts)
|
||||
duration (/ (- (System/nanoTime) start) 1e6)]
|
||||
(log-slow-query sql-vec duration)
|
||||
result))
|
||||
|
||||
(defn execute-sql!
|
||||
"Execute a raw SQL vector [sql & params], returning a vector of result maps."
|
||||
[ds sql-vec]
|
||||
(let [start (System/nanoTime)
|
||||
result (jdbc/execute! ds sql-vec default-opts)
|
||||
duration (/ (- (System/nanoTime) start) 1e6)]
|
||||
(log-slow-query sql-vec duration)
|
||||
result))
|
||||
|
||||
(defn execute-sql-one!
|
||||
"Execute a raw SQL vector, returning the first result map or nil."
|
||||
[ds sql-vec]
|
||||
(let [start (System/nanoTime)
|
||||
result (jdbc/execute-one! ds sql-vec default-opts)
|
||||
duration (/ (- (System/nanoTime) start) 1e6)]
|
||||
(log-slow-query sql-vec duration)
|
||||
result))
|
||||
|
||||
(defn plan
|
||||
"Return a reducible query plan from a HoneySQL map."
|
||||
[ds hsql-map]
|
||||
(jdbc/plan ds (sql/format hsql-map) default-opts))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Transactions
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defmacro with-transaction
|
||||
"Execute body within a database transaction.
|
||||
|
||||
Usage: (with-transaction [tx ds] (execute! tx ...))"
|
||||
[[tx ds & opts] & body]
|
||||
`(jdbc/with-transaction [~tx ~ds ~@opts]
|
||||
~@body))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Migrations (Migratus)
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- migratus-config
|
||||
"Build Migratus config from datasource and migration options."
|
||||
[ds {:keys [location] :or {location "migrations"}}]
|
||||
{:store :database
|
||||
:migration-dir location
|
||||
:db {:datasource ds}})
|
||||
|
||||
(defn migrate!
|
||||
"Run pending migrations forward."
|
||||
[ds & [opts]]
|
||||
(log/info "Running database migrations...")
|
||||
(migratus/migrate (migratus-config ds (or opts {})))
|
||||
(log/info "Migrations complete."))
|
||||
|
||||
(defn rollback!
|
||||
"Rollback the last migration."
|
||||
[ds & [opts]]
|
||||
(log/info "Rolling back last migration...")
|
||||
(migratus/rollback (migratus-config ds (or opts {}))))
|
||||
|
||||
@@ -0,0 +1,207 @@
|
||||
(ns ajet.chat.shared.eventbus
|
||||
"NATS pub/sub event bus with JetStream support.
|
||||
|
||||
Events are EDN maps serialized as JSON on the wire.
|
||||
Subject hierarchy:
|
||||
chat.events.{community-id}
|
||||
chat.dm.{channel-id}
|
||||
chat.typing.{community-id}.{channel-id}
|
||||
chat.presence.{community-id}
|
||||
chat.notifications.{user-id}
|
||||
chat.audit"
|
||||
(:require [clojure.data.json :as json]
|
||||
[clojure.tools.logging :as log])
|
||||
(:import [io.nats.client Nats Options$Builder Connection Connection$Status
|
||||
Dispatcher MessageHandler]
|
||||
[io.nats.client.api StreamConfiguration StorageType DiscardPolicy
|
||||
ConsumerConfiguration DeliverPolicy StreamInfo]
|
||||
[io.nats.client JetStream JetStreamSubscription JetStreamOptions
|
||||
PushSubscribeOptions]
|
||||
[java.time Duration Instant]
|
||||
[java.nio.charset StandardCharsets]))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Connection
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn connect!
|
||||
"Create a NATS connection from config.
|
||||
|
||||
Config shape: {:url \"nats://localhost:4222\"}"
|
||||
[{:keys [url] :or {url "nats://localhost:4222"}}]
|
||||
(let [opts (-> (Options$Builder.)
|
||||
(.server url)
|
||||
(.connectionTimeout (Duration/ofSeconds 5))
|
||||
(.reconnectWait (Duration/ofSeconds 2))
|
||||
(.maxReconnects -1)
|
||||
(.connectionListener
|
||||
(reify io.nats.client.ConnectionListener
|
||||
(connectionEvent [_ conn event]
|
||||
(log/info "NATS connection event:" (str event)))))
|
||||
(.build))]
|
||||
(Nats/connect opts)))
|
||||
|
||||
(defn close!
|
||||
"Close a NATS connection."
|
||||
[^Connection conn]
|
||||
(.close conn))
|
||||
|
||||
(defn connected?
|
||||
"Check if NATS connection is active."
|
||||
[^Connection conn]
|
||||
(= (.getStatus conn) Connection$Status/CONNECTED))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Event Envelope
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- keyword->str
|
||||
"Convert a keyword to a string, preserving namespace."
|
||||
[kw]
|
||||
(if-let [ns (namespace kw)]
|
||||
(str ns "/" (name kw))
|
||||
(name kw)))
|
||||
|
||||
(defn- make-event
|
||||
"Wrap a payload in the standard event envelope."
|
||||
[event-type payload]
|
||||
{:type (keyword->str event-type)
|
||||
:id (str (java.util.UUID/randomUUID))
|
||||
:ts (.toString (Instant/now))
|
||||
:payload payload})
|
||||
|
||||
(defn- encode-event
|
||||
"Serialize an event map to JSON bytes."
|
||||
[event]
|
||||
(.getBytes (json/write-str event) StandardCharsets/UTF_8))
|
||||
|
||||
(defn- decode-event
|
||||
"Deserialize JSON bytes to an event map."
|
||||
[^bytes data]
|
||||
(json/read-str (String. data StandardCharsets/UTF_8) :key-fn keyword))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Core Pub/Sub
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn publish!
|
||||
"Publish an event to a NATS subject.
|
||||
|
||||
event-type: keyword like :message/created
|
||||
subject: string like \"chat.events.community-uuid\"
|
||||
payload: map of event data"
|
||||
[^Connection conn subject event-type payload]
|
||||
(let [event (make-event event-type payload)
|
||||
data (encode-event event)]
|
||||
(.publish conn subject data)
|
||||
event))
|
||||
|
||||
(defn subscribe!
|
||||
"Subscribe to a NATS subject (supports wildcards like chat.events.*).
|
||||
|
||||
handler: (fn [event-map]) called on each message.
|
||||
Returns a Dispatcher that can be passed to unsubscribe!."
|
||||
[^Connection conn subject handler]
|
||||
(let [dispatcher (.createDispatcher conn
|
||||
(reify MessageHandler
|
||||
(onMessage [_ msg]
|
||||
(try
|
||||
(let [event (decode-event (.getData msg))]
|
||||
(handler event))
|
||||
(catch Exception e
|
||||
(log/error e "Error handling NATS message on" subject))))))]
|
||||
(.subscribe dispatcher subject)
|
||||
dispatcher))
|
||||
|
||||
(defn unsubscribe!
|
||||
"Close a subscription dispatcher."
|
||||
[^Connection conn ^Dispatcher dispatcher]
|
||||
(.closeDispatcher conn dispatcher))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; JetStream
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn ensure-stream!
|
||||
"Create or update the ajet-events JetStream stream."
|
||||
[^Connection conn]
|
||||
(let [js-mgmt (.jetStreamManagement conn)
|
||||
config (-> (StreamConfiguration/builder)
|
||||
(.name "ajet-events")
|
||||
(.subjects (into-array String
|
||||
["chat.events.>"
|
||||
"chat.dm.>"
|
||||
"chat.typing.>"
|
||||
"chat.presence.>"
|
||||
"chat.notifications.>"
|
||||
"chat.audit"]))
|
||||
(.maxAge (Duration/ofHours 24))
|
||||
(.maxBytes 1073741824) ;; 1GB
|
||||
(.storageType StorageType/File)
|
||||
(.replicas 1)
|
||||
(.discardPolicy DiscardPolicy/Old)
|
||||
(.build))]
|
||||
(try
|
||||
(.addStream js-mgmt config)
|
||||
(log/info "Created JetStream stream: ajet-events")
|
||||
(catch io.nats.client.JetStreamApiException e
|
||||
(if (= 10058 (.getApiErrorCode e)) ;; stream already exists
|
||||
(do
|
||||
(.updateStream js-mgmt config)
|
||||
(log/info "Updated JetStream stream: ajet-events"))
|
||||
(throw e))))))
|
||||
|
||||
(defn- build-push-subscribe-opts
|
||||
"Build PushSubscribeOptions via Method.invoke.
|
||||
SubscribeOptions$Builder is package-private so Clojure can't call its methods
|
||||
even with type hints (CLJ-1243). Method.invoke bypasses that restriction."
|
||||
[consumer-config stream-name]
|
||||
(let [builder (PushSubscribeOptions/builder)
|
||||
cls (class builder)
|
||||
invoke! (fn [method-name arg-types args]
|
||||
(.invoke (.getMethod cls method-name (into-array Class arg-types))
|
||||
builder (object-array args)))]
|
||||
(invoke! "configuration" [ConsumerConfiguration] [consumer-config])
|
||||
(invoke! "stream" [String] [stream-name])
|
||||
(invoke! "build" [] [])))
|
||||
|
||||
(defn jetstream-subscribe!
|
||||
"Create a JetStream push subscription with a durable consumer.
|
||||
|
||||
opts:
|
||||
:durable-name - durable consumer name (e.g. \"sm-web-user-uuid\")
|
||||
:filter-subjects - seq of subjects to filter (e.g. [\"chat.events.community-id\"])
|
||||
:deliver-from - Instant to deliver from (for reconnection)
|
||||
|
||||
Returns a map {:subscription ... :dispatcher ...}.
|
||||
Clean up via (.closeDispatcher conn (:dispatcher result))."
|
||||
[^Connection conn subject handler
|
||||
{:keys [durable-name filter-subjects deliver-from]}]
|
||||
(let [js (.jetStream conn)
|
||||
consumer-config (-> (cond-> (ConsumerConfiguration/builder)
|
||||
durable-name (.durable durable-name)
|
||||
deliver-from (.deliverPolicy DeliverPolicy/ByStartTime)
|
||||
deliver-from (.startTime (.atZone ^Instant deliver-from
|
||||
(java.time.ZoneId/of "UTC")))
|
||||
(not deliver-from) (.deliverPolicy DeliverPolicy/New))
|
||||
(.build))
|
||||
push-opts (build-push-subscribe-opts consumer-config "ajet-events")
|
||||
msg-handler (reify MessageHandler
|
||||
(onMessage [_ msg]
|
||||
(try
|
||||
(let [event (decode-event (.getData msg))]
|
||||
(handler event))
|
||||
(catch Exception e
|
||||
(log/error e "Error handling JetStream message")))))
|
||||
dispatcher (.createDispatcher conn msg-handler)
|
||||
subscription (.subscribe js subject dispatcher msg-handler true push-opts)]
|
||||
{:subscription subscription :dispatcher dispatcher}))
|
||||
|
||||
(defn js-publish!
|
||||
"Publish to JetStream (with ack). For critical events that must be durable."
|
||||
[^Connection conn subject event-type payload]
|
||||
(let [js (.jetStream conn)
|
||||
event (make-event event-type payload)
|
||||
data (encode-event event)]
|
||||
(.publish js subject data)
|
||||
event))
|
||||
@@ -0,0 +1,61 @@
|
||||
(ns ajet.chat.shared.logging
|
||||
"Structured logging with trace ID propagation.
|
||||
|
||||
Uses clojure.tools.logging with Logback backend.
|
||||
MDC (Mapped Diagnostic Context) carries trace-id, user-id per request."
|
||||
(:require [clojure.string :as str]
|
||||
[clojure.tools.logging :as log])
|
||||
(:import [org.slf4j MDC]))
|
||||
|
||||
(defn set-mdc!
|
||||
"Set MDC context values from a map. Keys are converted to strings."
|
||||
[context-map]
|
||||
(doseq [[k v] context-map]
|
||||
(when v
|
||||
(MDC/put (name k) (str v)))))
|
||||
|
||||
(defn clear-mdc!
|
||||
"Clear all MDC context values."
|
||||
[]
|
||||
(MDC/clear))
|
||||
|
||||
(defmacro with-mdc
|
||||
"Execute body with MDC context set. Clears MDC after completion."
|
||||
[context-map & body]
|
||||
`(let [cm# ~context-map]
|
||||
(set-mdc! cm#)
|
||||
(try
|
||||
~@body
|
||||
(finally
|
||||
(clear-mdc!)))))
|
||||
|
||||
(def ^:private sensitive-keys
|
||||
#{:password :token :secret :secret-key :client-secret :token-hash :authorization})
|
||||
|
||||
(defn redact-map
|
||||
"Replace sensitive values with [REDACTED] in a map."
|
||||
[m]
|
||||
(reduce-kv (fn [acc k v]
|
||||
(assoc acc k (if (sensitive-keys (keyword (name k)))
|
||||
"[REDACTED]"
|
||||
v)))
|
||||
{} m))
|
||||
|
||||
(defn wrap-request-logging
|
||||
"Ring middleware that logs request/response with timing and MDC context."
|
||||
[handler]
|
||||
(fn [request]
|
||||
(let [method (str/upper-case (name (:request-method request)))
|
||||
path (:uri request)
|
||||
trace-id (get-in request [:headers "x-trace-id"] (str (java.util.UUID/randomUUID)))
|
||||
user-id (get-in request [:headers "x-user-id"])
|
||||
start (System/nanoTime)]
|
||||
(with-mdc {:trace-id trace-id
|
||||
:user-id user-id
|
||||
:method method
|
||||
:path path}
|
||||
(let [response (handler (assoc-in request [:headers "x-trace-id"] trace-id))
|
||||
duration (/ (- (System/nanoTime) start) 1e6)]
|
||||
(log/info (format "%s %s %d (%.0fms)" method path (:status response 500) duration))
|
||||
(-> response
|
||||
(assoc-in [:headers "X-Trace-Id"] trace-id)))))))
|
||||
@@ -0,0 +1,208 @@
|
||||
(ns ajet.chat.shared.markdown
|
||||
"Discord-flavor markdown renderer.
|
||||
|
||||
Dual output: HTML (for web) and ANSI escape codes (for TUI).
|
||||
Supports: bold, italic, strikethrough, underline, inline code,
|
||||
fenced code blocks, spoilers, block quotes, auto-link URLs, emoji shortcodes.
|
||||
|
||||
Mention syntax (@<user:>, #<channel:>) is NOT processed here —
|
||||
that's handled by ajet.chat.shared.mentions."
|
||||
(:require [clojure.string :as str]))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; HTML Escaping
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- escape-html
|
||||
"Escape HTML special characters to prevent XSS."
|
||||
[s]
|
||||
(-> s
|
||||
(str/replace "&" "&")
|
||||
(str/replace "<" "<")
|
||||
(str/replace ">" ">")
|
||||
(str/replace "\"" """)
|
||||
(str/replace "'" "'")))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Emoji Shortcodes
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(def ^:private emoji-map
|
||||
"Common emoji shortcodes to Unicode."
|
||||
{":smile:" "\uD83D\uDE04"
|
||||
":laughing:" "\uD83D\uDE06"
|
||||
":heart:" "\u2764\uFE0F"
|
||||
":thumbsup:" "\uD83D\uDC4D"
|
||||
":thumbsdown:" "\uD83D\uDC4E"
|
||||
":fire:" "\uD83D\uDD25"
|
||||
":100:" "\uD83D\uDCAF"
|
||||
":rocket:" "\uD83D\uDE80"
|
||||
":wave:" "\uD83D\uDC4B"
|
||||
":eyes:" "\uD83D\uDC40"
|
||||
":thinking:" "\uD83E\uDD14"
|
||||
":tada:" "\uD83C\uDF89"
|
||||
":check:" "\u2705"
|
||||
":x:" "\u274C"
|
||||
":warning:" "\u26A0\uFE0F"
|
||||
":star:" "\u2B50"
|
||||
":sparkles:" "\u2728"
|
||||
":pray:" "\uD83D\uDE4F"
|
||||
":clap:" "\uD83D\uDC4F"
|
||||
":sob:" "\uD83D\uDE2D"
|
||||
":joy:" "\uD83D\uDE02"
|
||||
":wink:" "\uD83D\uDE09"
|
||||
":sunglasses:" "\uD83D\uDE0E"
|
||||
":muscle:" "\uD83D\uDCAA"
|
||||
":point_right:" "\uD83D\uDC49"
|
||||
":skull:" "\uD83D\uDC80"
|
||||
":ok_hand:" "\uD83D\uDC4C"
|
||||
":raised_hands:" "\uD83D\uDE4C"
|
||||
":coffee:" "\u2615"
|
||||
":beer:" "\uD83C\uDF7A"
|
||||
":pizza:" "\uD83C\uDF55"
|
||||
":poop:" "\uD83D\uDCA9"
|
||||
":bug:" "\uD83D\uDC1B"
|
||||
":wrench:" "\uD83D\uDD27"
|
||||
":bulb:" "\uD83D\uDCA1"
|
||||
":memo:" "\uD83D\uDCDD"
|
||||
":lock:" "\uD83D\uDD12"
|
||||
":key:" "\uD83D\uDD11"
|
||||
":link:" "\uD83D\uDD17"
|
||||
":heavy_plus_sign:" "\u2795"
|
||||
":heavy_minus_sign:" "\u2796"})
|
||||
|
||||
(defn- replace-emoji-shortcodes
|
||||
"Replace :shortcode: with Unicode emoji."
|
||||
[text]
|
||||
(str/replace text #":[a-z_]+:" #(get emoji-map % %)))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; HTML Rendering
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- render-fenced-code-blocks
|
||||
"Extract and render fenced code blocks, returning [processed-text, blocks-map]."
|
||||
[text]
|
||||
(let [blocks (atom {})
|
||||
counter (atom 0)
|
||||
result (str/replace text #"(?s)```(\w*)\n?(.*?)```"
|
||||
(fn [[_ lang code]]
|
||||
(let [id (str "\u0000CODEBLOCK" (swap! counter inc) "\u0000")
|
||||
lang-class (when-not (str/blank? lang) (str " class=\"language-" lang "\""))]
|
||||
(swap! blocks assoc id
|
||||
(str "<pre><code" (or lang-class "") ">"
|
||||
(escape-html code)
|
||||
"</code></pre>"))
|
||||
id)))]
|
||||
[result @blocks]))
|
||||
|
||||
(defn- render-inline-code
|
||||
"Render inline code, returning [processed-text, codes-map]."
|
||||
[text]
|
||||
(let [codes (atom {})
|
||||
counter (atom 0)
|
||||
result (str/replace text #"`([^`]+)`"
|
||||
(fn [[_ code]]
|
||||
(let [id (str "\u0000INLINECODE" (swap! counter inc) "\u0000")]
|
||||
(swap! codes assoc id
|
||||
(str "<code>" (escape-html code) "</code>"))
|
||||
id)))]
|
||||
[result @codes]))
|
||||
|
||||
(defn- restore-placeholders
|
||||
"Replace placeholder IDs with their rendered content."
|
||||
[text placeholders]
|
||||
(reduce-kv (fn [t k v] (str/replace t k v)) text placeholders))
|
||||
|
||||
(defn ->html
|
||||
"Render Discord-flavor markdown to HTML.
|
||||
|
||||
Handles: bold, italic, strikethrough, underline, inline code,
|
||||
fenced code blocks, spoilers, block quotes, auto-link URLs, emoji."
|
||||
[text]
|
||||
(let [;; Phase 1: Extract code blocks and inline code (don't process markdown inside)
|
||||
[text1 code-blocks] (render-fenced-code-blocks text)
|
||||
[text2 inline-codes] (render-inline-code text1)
|
||||
;; Phase 2: Escape remaining HTML
|
||||
text3 (escape-html text2)
|
||||
;; Phase 3: Apply formatting
|
||||
text4 (-> text3
|
||||
;; Bold: **text**
|
||||
(str/replace #"\*\*(.+?)\*\*" "<strong>$1</strong>")
|
||||
;; Underline: __text__
|
||||
(str/replace #"__(.+?)__" "<u>$1</u>")
|
||||
;; Italic: *text* or _text_
|
||||
(str/replace #"(?<!\*)\*(?!\*)(.+?)(?<!\*)\*(?!\*)" "<em>$1</em>")
|
||||
(str/replace #"(?<!_)_(?!_)(.+?)(?<!_)_(?!_)" "<em>$1</em>")
|
||||
;; Strikethrough: ~~text~~
|
||||
(str/replace #"~~(.+?)~~" "<del>$1</del>")
|
||||
;; Spoilers: ||text||
|
||||
(str/replace #"\|\|(.+?)\|\|" "<span class=\"spoiler\">$1</span>")
|
||||
;; Block quotes: > text (at start of line)
|
||||
(str/replace #"(?m)^> (.+)$" "<blockquote>$1</blockquote>")
|
||||
;; Auto-link URLs
|
||||
(str/replace #"(?<![\"=])(https?://[^\s<]+)"
|
||||
"<a href=\"$1\" rel=\"noopener noreferrer\">$1</a>")
|
||||
;; Emoji shortcodes
|
||||
(replace-emoji-shortcodes)
|
||||
;; Newlines to <br>
|
||||
(str/replace "\n" "<br>"))
|
||||
;; Phase 4: Restore code blocks and inline code
|
||||
text5 (restore-placeholders text4 (merge code-blocks inline-codes))]
|
||||
text5))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; ANSI Rendering (for TUI)
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(def ^:private ansi
|
||||
{:reset "\033[0m"
|
||||
:bold "\033[1m"
|
||||
:italic "\033[3m"
|
||||
:underline "\033[4m"
|
||||
:strike "\033[9m"
|
||||
:dim "\033[2m"
|
||||
:reverse "\033[7m"
|
||||
:cyan "\033[36m"
|
||||
:green "\033[32m"
|
||||
:yellow "\033[33m"
|
||||
:gray "\033[90m"})
|
||||
|
||||
(defn ->ansi
|
||||
"Render Discord-flavor markdown to ANSI escape codes for terminal display."
|
||||
[text]
|
||||
(let [;; Extract fenced code blocks
|
||||
[text1 blocks] (let [bs (atom {}) c (atom 0)]
|
||||
[(str/replace text #"(?s)```(\w*)\n?(.*?)```"
|
||||
(fn [[_ lang code]]
|
||||
(let [id (str "\u0000CB" (swap! c inc) "\u0000")
|
||||
header (if (str/blank? lang) "" (str (:cyan ansi) lang (:reset ansi) "\n"))
|
||||
box (str "\n" (:gray ansi) "\u250C" (apply str (repeat 60 "\u2500")) "\u2510" (:reset ansi)
|
||||
"\n" header
|
||||
(:dim ansi) code (:reset ansi)
|
||||
"\n" (:gray ansi) "\u2514" (apply str (repeat 60 "\u2500")) "\u2518" (:reset ansi) "\n")]
|
||||
(swap! bs assoc id box)
|
||||
id)))
|
||||
@bs])
|
||||
;; Extract inline code
|
||||
[text2 inlines] (let [cs (atom {}) c (atom 0)]
|
||||
[(str/replace text1 #"`([^`]+)`"
|
||||
(fn [[_ code]]
|
||||
(let [id (str "\u0000IC" (swap! c inc) "\u0000")]
|
||||
(swap! cs assoc id (str (:dim ansi) (:reverse ansi) " " code " " (:reset ansi)))
|
||||
id)))
|
||||
@cs])
|
||||
;; Apply formatting
|
||||
text3 (-> text2
|
||||
(str/replace #"\*\*(.+?)\*\*" (str (:bold ansi) "$1" (:reset ansi)))
|
||||
(str/replace #"__(.+?)__" (str (:underline ansi) "$1" (:reset ansi)))
|
||||
(str/replace #"(?<!\*)\*(?!\*)(.+?)(?<!\*)\*(?!\*)" (str (:italic ansi) "$1" (:reset ansi)))
|
||||
(str/replace #"(?<!_)_(?!_)(.+?)(?<!_)_(?!_)" (str (:italic ansi) "$1" (:reset ansi)))
|
||||
(str/replace #"~~(.+?)~~" (str (:strike ansi) "$1" (:reset ansi)))
|
||||
(str/replace #"\|\|(.+?)\|\|" (str (:reverse ansi) " SPOILER " (:reset ansi)))
|
||||
(str/replace #"(?m)^> (.+)$" (str (:gray ansi) "\u2502 " (:reset ansi) "$1"))
|
||||
(str/replace #"(https?://[^\s]+)" (str "\033]8;;" "$1" "\033\\\\" (:cyan ansi) "$1" (:reset ansi) "\033]8;;\033\\\\"))
|
||||
(replace-emoji-shortcodes))
|
||||
;; Restore code blocks
|
||||
text4 (restore-placeholders text3 (merge blocks inlines))]
|
||||
text4))
|
||||
@@ -0,0 +1,63 @@
|
||||
(ns ajet.chat.shared.mentions
|
||||
"Parse and render mention/channel-link syntax in message bodies.
|
||||
|
||||
Storage format:
|
||||
@<user:uuid> — user mention
|
||||
@<here> — @here mention
|
||||
#<channel:uuid> — channel link
|
||||
|
||||
Rendered output (resolved at display time):
|
||||
@displayName, @here, #channelName"
|
||||
(:require [clojure.string :as str]))
|
||||
|
||||
(def ^:private user-mention-re
|
||||
#"@<user:([0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12})>")
|
||||
|
||||
(def ^:private here-mention-re
|
||||
#"@<here>")
|
||||
|
||||
(def ^:private channel-link-re
|
||||
#"#<channel:([0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12})>")
|
||||
|
||||
(def ^:private code-block-re
|
||||
"Matches inline code and fenced code blocks."
|
||||
#"(?s)```.*?```|`[^`]+`")
|
||||
|
||||
(defn- strip-code-blocks
|
||||
"Remove code blocks from text to avoid parsing mentions inside them."
|
||||
[text]
|
||||
(str/replace text code-block-re ""))
|
||||
|
||||
(defn parse
|
||||
"Parse all mentions from a message body.
|
||||
|
||||
Returns a vector of maps:
|
||||
[{:type :user :id \"uuid\"}
|
||||
{:type :here}
|
||||
{:type :channel :id \"uuid\"}]"
|
||||
[body-md]
|
||||
(let [clean (strip-code-blocks body-md)]
|
||||
(vec
|
||||
(concat
|
||||
(for [[_ uuid] (re-seq user-mention-re clean)]
|
||||
{:type :user :id uuid})
|
||||
(for [_ (re-seq here-mention-re clean)]
|
||||
{:type :here})
|
||||
(for [[_ uuid] (re-seq channel-link-re clean)]
|
||||
{:type :channel :id uuid})))))
|
||||
|
||||
(defn render
|
||||
"Replace mention syntax with display names.
|
||||
|
||||
lookup-fn: (fn [type id]) -> display-name-string
|
||||
type is :user or :channel, id is UUID string.
|
||||
Returns nil if unknown -> falls back to @unknown-user / #unknown-channel."
|
||||
[body-md lookup-fn]
|
||||
(-> body-md
|
||||
(str/replace user-mention-re
|
||||
(fn [[_ uuid]]
|
||||
(str "@" (or (lookup-fn :user uuid) "unknown-user"))))
|
||||
(str/replace here-mention-re "@here")
|
||||
(str/replace channel-link-re
|
||||
(fn [[_ uuid]]
|
||||
(str "#" (or (lookup-fn :channel uuid) "unknown-channel"))))))
|
||||
@@ -0,0 +1,300 @@
|
||||
(ns ajet.chat.shared.schema
|
||||
"Data schemas and validation for all entities using clojure.spec.alpha."
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[clojure.string :as str]))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Predicates
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn uuid-str?
|
||||
"Check if value is a valid UUID string."
|
||||
[v]
|
||||
(and (string? v)
|
||||
(re-matches #"[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}" v)))
|
||||
|
||||
(defn uuid?
|
||||
"Check if value is a UUID (string or java.util.UUID)."
|
||||
[v]
|
||||
(or (instance? java.util.UUID v)
|
||||
(uuid-str? v)))
|
||||
|
||||
(defn slug?
|
||||
"Check if value is a valid slug: lowercase letters, digits, hyphens."
|
||||
[v]
|
||||
(and (string? v) (re-matches #"[a-z0-9][a-z0-9-]*[a-z0-9]" v) (<= (count v) 100)))
|
||||
|
||||
(defn non-blank-string?
|
||||
"Check if value is a non-blank string."
|
||||
[v]
|
||||
(and (string? v) (not (str/blank? v))))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Common Specs
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(s/def ::id uuid?)
|
||||
(s/def ::uuid uuid?)
|
||||
(s/def ::non-blank non-blank-string?)
|
||||
(s/def ::slug slug?)
|
||||
(s/def ::inst inst?)
|
||||
(s/def ::optional-string (s/nilable string?))
|
||||
(s/def ::optional-uuid (s/nilable uuid?))
|
||||
(s/def ::optional-inst (s/nilable inst?))
|
||||
(s/def ::positive-int (s/and int? pos?))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Entity Specs
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Community
|
||||
(s/def :community/id ::uuid)
|
||||
(s/def :community/name ::non-blank)
|
||||
(s/def :community/slug ::slug)
|
||||
(s/def :community/created-at ::inst)
|
||||
|
||||
(s/def ::community
|
||||
(s/keys :req-un [:community/id :community/name :community/slug]
|
||||
:opt-un [:community/created-at]))
|
||||
|
||||
;; User
|
||||
(s/def :user/id ::uuid)
|
||||
(s/def :user/username ::non-blank)
|
||||
(s/def :user/display-name ::non-blank)
|
||||
(s/def :user/email ::non-blank)
|
||||
(s/def :user/avatar-url ::optional-string)
|
||||
(s/def :user/status-text ::optional-string)
|
||||
(s/def :user/created-at ::inst)
|
||||
|
||||
(s/def ::user
|
||||
(s/keys :req-un [:user/id :user/username :user/email]
|
||||
:opt-un [:user/display-name :user/avatar-url :user/status-text :user/created-at]))
|
||||
|
||||
;; OAuth Provider (DB-stored, runtime-configurable)
|
||||
(s/def :oauth-provider/id ::uuid)
|
||||
(s/def :oauth-provider/provider-type #{"github" "gitea" "oidc"})
|
||||
(s/def :oauth-provider/display-name ::non-blank)
|
||||
(s/def :oauth-provider/slug ::non-blank)
|
||||
(s/def :oauth-provider/client-id ::non-blank)
|
||||
(s/def :oauth-provider/client-secret ::non-blank)
|
||||
(s/def :oauth-provider/base-url ::optional-string)
|
||||
(s/def :oauth-provider/issuer-url ::optional-string)
|
||||
(s/def :oauth-provider/enabled boolean?)
|
||||
(s/def :oauth-provider/sort-order int?)
|
||||
|
||||
(s/def ::oauth-provider
|
||||
(s/keys :req-un [:oauth-provider/id :oauth-provider/provider-type
|
||||
:oauth-provider/display-name :oauth-provider/slug
|
||||
:oauth-provider/client-id :oauth-provider/client-secret]
|
||||
:opt-un [:oauth-provider/base-url :oauth-provider/issuer-url
|
||||
:oauth-provider/enabled :oauth-provider/sort-order]))
|
||||
|
||||
;; OAuth Account
|
||||
(s/def :oauth-account/id ::uuid)
|
||||
(s/def :oauth-account/user-id ::uuid)
|
||||
(s/def :oauth-account/provider #{"github" "gitea" "oidc"})
|
||||
(s/def :oauth-account/provider-user-id ::non-blank)
|
||||
|
||||
(s/def ::oauth-account
|
||||
(s/keys :req-un [:oauth-account/id :oauth-account/user-id
|
||||
:oauth-account/provider :oauth-account/provider-user-id]))
|
||||
|
||||
;; Session
|
||||
(s/def :session/id ::uuid)
|
||||
(s/def :session/user-id ::uuid)
|
||||
(s/def :session/token-hash ::non-blank)
|
||||
(s/def :session/expires-at ::inst)
|
||||
|
||||
(s/def ::session
|
||||
(s/keys :req-un [:session/id :session/user-id :session/token-hash :session/expires-at]))
|
||||
|
||||
;; Channel
|
||||
(s/def :channel/id ::uuid)
|
||||
(s/def :channel/community-id ::optional-uuid)
|
||||
(s/def :channel/name ::non-blank)
|
||||
(s/def :channel/type #{:text :voice :dm :group-dm})
|
||||
(s/def :channel/visibility #{:public :private})
|
||||
(s/def :channel/topic ::optional-string)
|
||||
(s/def :channel/category-id ::optional-uuid)
|
||||
|
||||
(s/def ::channel
|
||||
(s/keys :req-un [:channel/id :channel/name :channel/type]
|
||||
:opt-un [:channel/community-id :channel/visibility :channel/topic
|
||||
:channel/category-id]))
|
||||
|
||||
;; Channel Category
|
||||
(s/def :category/id ::uuid)
|
||||
(s/def :category/community-id ::uuid)
|
||||
(s/def :category/name ::non-blank)
|
||||
(s/def :category/position int?)
|
||||
|
||||
(s/def ::channel-category
|
||||
(s/keys :req-un [:category/id :category/community-id :category/name :category/position]))
|
||||
|
||||
;; Community Member
|
||||
(s/def :community-member/community-id ::uuid)
|
||||
(s/def :community-member/user-id ::uuid)
|
||||
(s/def :community-member/role #{:owner :admin :member})
|
||||
(s/def :community-member/nickname ::optional-string)
|
||||
|
||||
(s/def ::community-member
|
||||
(s/keys :req-un [:community-member/community-id :community-member/user-id
|
||||
:community-member/role]))
|
||||
|
||||
;; Channel Member
|
||||
(s/def :channel-member/channel-id ::uuid)
|
||||
(s/def :channel-member/user-id ::uuid)
|
||||
(s/def :channel-member/joined-at ::inst)
|
||||
(s/def :channel-member/last-read-message-id ::optional-uuid)
|
||||
|
||||
(s/def ::channel-member
|
||||
(s/keys :req-un [:channel-member/channel-id :channel-member/user-id]
|
||||
:opt-un [:channel-member/joined-at :channel-member/last-read-message-id]))
|
||||
|
||||
;; Message
|
||||
(s/def :message/id ::uuid)
|
||||
(s/def :message/channel-id ::uuid)
|
||||
(s/def :message/user-id ::uuid)
|
||||
(s/def :message/parent-id ::optional-uuid)
|
||||
(s/def :message/body-md ::non-blank)
|
||||
(s/def :message/created-at ::inst)
|
||||
(s/def :message/edited-at ::optional-inst)
|
||||
|
||||
(s/def ::message
|
||||
(s/keys :req-un [:message/id :message/channel-id :message/user-id :message/body-md]
|
||||
:opt-un [:message/parent-id :message/created-at :message/edited-at]))
|
||||
|
||||
;; Attachment
|
||||
(s/def :attachment/id ::uuid)
|
||||
(s/def :attachment/message-id ::uuid)
|
||||
(s/def :attachment/filename ::non-blank)
|
||||
(s/def :attachment/content-type #{"image/jpeg" "image/png" "image/gif" "image/webp"})
|
||||
(s/def :attachment/size-bytes ::positive-int)
|
||||
(s/def :attachment/storage-key ::non-blank)
|
||||
|
||||
(s/def ::attachment
|
||||
(s/keys :req-un [:attachment/id :attachment/message-id :attachment/filename
|
||||
:attachment/content-type :attachment/size-bytes :attachment/storage-key]))
|
||||
|
||||
;; Reaction
|
||||
(s/def :reaction/message-id ::uuid)
|
||||
(s/def :reaction/user-id ::uuid)
|
||||
(s/def :reaction/emoji ::non-blank)
|
||||
|
||||
(s/def ::reaction
|
||||
(s/keys :req-un [:reaction/message-id :reaction/user-id :reaction/emoji]))
|
||||
|
||||
;; Webhook
|
||||
(s/def :webhook/id ::uuid)
|
||||
(s/def :webhook/community-id ::uuid)
|
||||
(s/def :webhook/channel-id ::uuid)
|
||||
(s/def :webhook/name ::non-blank)
|
||||
(s/def :webhook/token-hash ::non-blank)
|
||||
|
||||
(s/def ::webhook
|
||||
(s/keys :req-un [:webhook/id :webhook/community-id :webhook/channel-id
|
||||
:webhook/name :webhook/token-hash]))
|
||||
|
||||
;; Mention
|
||||
(s/def :mention/id ::uuid)
|
||||
(s/def :mention/message-id ::uuid)
|
||||
(s/def :mention/target-type #{:user :here :channel})
|
||||
(s/def :mention/target-id ::optional-uuid)
|
||||
|
||||
(s/def ::mention
|
||||
(s/keys :req-un [:mention/id :mention/message-id :mention/target-type]
|
||||
:opt-un [:mention/target-id]))
|
||||
|
||||
;; Notification
|
||||
(s/def :notification/id ::uuid)
|
||||
(s/def :notification/user-id ::uuid)
|
||||
(s/def :notification/type #{:mention :dm :thread-reply :invite})
|
||||
(s/def :notification/source-id ::uuid)
|
||||
(s/def :notification/read boolean?)
|
||||
|
||||
(s/def ::notification
|
||||
(s/keys :req-un [:notification/id :notification/user-id :notification/type
|
||||
:notification/source-id :notification/read]))
|
||||
|
||||
;; Invite
|
||||
(s/def :invite/id ::uuid)
|
||||
(s/def :invite/community-id ::uuid)
|
||||
(s/def :invite/created-by ::uuid)
|
||||
(s/def :invite/code ::non-blank)
|
||||
(s/def :invite/max-uses (s/nilable int?))
|
||||
(s/def :invite/uses int?)
|
||||
(s/def :invite/expires-at ::optional-inst)
|
||||
|
||||
(s/def ::invite
|
||||
(s/keys :req-un [:invite/id :invite/community-id :invite/created-by :invite/code :invite/uses]
|
||||
:opt-un [:invite/max-uses :invite/expires-at]))
|
||||
|
||||
;; API User
|
||||
(s/def :api-user/id ::uuid)
|
||||
(s/def :api-user/name ::non-blank)
|
||||
(s/def :api-user/community-id ::uuid)
|
||||
|
||||
(s/def ::api-user
|
||||
(s/keys :req-un [:api-user/id :api-user/name :api-user/community-id]))
|
||||
|
||||
;; API Token
|
||||
(s/def :api-token/id ::uuid)
|
||||
(s/def :api-token/api-user-id ::uuid)
|
||||
(s/def :api-token/token-hash ::non-blank)
|
||||
(s/def :api-token/expires-at ::optional-inst)
|
||||
|
||||
(s/def ::api-token
|
||||
(s/keys :req-un [:api-token/id :api-token/api-user-id :api-token/token-hash]
|
||||
:opt-un [:api-token/expires-at]))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Validation
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn validate
|
||||
"Validate data against a spec. Returns data if valid, throws ex-info if not."
|
||||
[spec data]
|
||||
(if (s/valid? spec data)
|
||||
data
|
||||
(throw (ex-info "Validation failed"
|
||||
{:type :ajet.chat/validation-error
|
||||
:spec spec
|
||||
:explain (s/explain-str spec data)}))))
|
||||
|
||||
(defn valid?
|
||||
"Check if data matches spec."
|
||||
[spec data]
|
||||
(s/valid? spec data))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Request Validation Specs
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(s/def :req/create-community
|
||||
(s/keys :req-un [:community/name :community/slug]))
|
||||
|
||||
(s/def :req/update-community
|
||||
(s/keys :opt-un [:community/name :community/slug]))
|
||||
|
||||
(s/def :req/create-channel
|
||||
(s/keys :req-un [:channel/name]
|
||||
:opt-un [:channel/type :channel/visibility :channel/topic :channel/category-id]))
|
||||
|
||||
(s/def :req/send-message
|
||||
(s/keys :req-un [:message/body-md]
|
||||
:opt-un [:message/parent-id]))
|
||||
|
||||
(s/def :req/edit-message
|
||||
(s/keys :req-un [:message/body-md]))
|
||||
|
||||
(s/def :req/create-dm
|
||||
(s/keys :req-un [::user-id]))
|
||||
|
||||
(s/def :req/create-group-dm
|
||||
(s/keys :req-un [::user-ids]))
|
||||
|
||||
(s/def :req/create-invite
|
||||
(s/keys :opt-un [:invite/max-uses ::expires-in-hours]))
|
||||
|
||||
(s/def :req/update-profile
|
||||
(s/keys :opt-un [:user/display-name :user/status-text]))
|
||||
@@ -0,0 +1,172 @@
|
||||
(ns ajet.chat.shared.storage
|
||||
"S3-compatible file storage client for MinIO.
|
||||
|
||||
Operations: upload!, download, delete!, presigned-url.
|
||||
Files stored with key format: attachments/{uuid}/{filename}."
|
||||
(:require [clojure.tools.logging :as log])
|
||||
(:import [software.amazon.awssdk.services.s3 S3Client S3Configuration S3Configuration$Builder]
|
||||
[software.amazon.awssdk.services.s3.model
|
||||
PutObjectRequest GetObjectRequest DeleteObjectRequest
|
||||
HeadBucketRequest CreateBucketRequest
|
||||
NoSuchBucketException]
|
||||
[software.amazon.awssdk.services.s3.presigner S3Presigner]
|
||||
[software.amazon.awssdk.services.s3.presigner.model GetObjectPresignRequest]
|
||||
[software.amazon.awssdk.core.sync RequestBody]
|
||||
[software.amazon.awssdk.auth.credentials StaticCredentialsProvider AwsBasicCredentials]
|
||||
[software.amazon.awssdk.regions Region]
|
||||
[java.net URI]
|
||||
[java.time Duration]
|
||||
[java.io InputStream]))
|
||||
|
||||
(def ^:private max-file-size (* 10 1024 1024)) ;; 10MB
|
||||
|
||||
(def ^:private allowed-content-types
|
||||
#{"image/jpeg" "image/png" "image/gif" "image/webp"})
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Client Creation
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn make-client
|
||||
"Create an S3 client for MinIO.
|
||||
|
||||
Config shape: {:endpoint \"http://localhost:9000\"
|
||||
:access-key \"minioadmin\"
|
||||
:secret-key \"minioadmin\"
|
||||
:bucket \"ajet-chat\"}"
|
||||
[{:keys [endpoint access-key secret-key]}]
|
||||
(let [creds (StaticCredentialsProvider/create
|
||||
(AwsBasicCredentials/create access-key secret-key))]
|
||||
(-> (S3Client/builder)
|
||||
(.endpointOverride (URI. endpoint))
|
||||
(.credentialsProvider creds)
|
||||
(.region Region/US_EAST_1)
|
||||
(.serviceConfiguration
|
||||
(reify java.util.function.Consumer
|
||||
(accept [_ builder]
|
||||
(.pathStyleAccessEnabled ^S3Configuration$Builder builder true))))
|
||||
(.build))))
|
||||
|
||||
(defn make-presigner
|
||||
"Create an S3 presigner for generating temporary download URLs."
|
||||
[{:keys [endpoint access-key secret-key]}]
|
||||
(let [creds (StaticCredentialsProvider/create
|
||||
(AwsBasicCredentials/create access-key secret-key))]
|
||||
(-> (S3Presigner/builder)
|
||||
(.endpointOverride (URI. endpoint))
|
||||
(.credentialsProvider creds)
|
||||
(.region Region/US_EAST_1)
|
||||
(.build))))
|
||||
|
||||
(defn close-client
|
||||
"Close an S3 client."
|
||||
[^S3Client client]
|
||||
(.close client))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Bucket Management
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn ensure-bucket!
|
||||
"Create bucket if it doesn't exist."
|
||||
[^S3Client client bucket]
|
||||
(try
|
||||
(.headBucket client (-> (HeadBucketRequest/builder)
|
||||
(.bucket bucket)
|
||||
(.build)))
|
||||
(log/info "Bucket exists:" bucket)
|
||||
(catch NoSuchBucketException _
|
||||
(.createBucket client (-> (CreateBucketRequest/builder)
|
||||
(.bucket bucket)
|
||||
(.build)))
|
||||
(log/info "Created bucket:" bucket))))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Validation
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn validate-upload!
|
||||
"Validate content-type and file size. Throws ex-info on invalid."
|
||||
[content-type size-bytes]
|
||||
(when-not (allowed-content-types content-type)
|
||||
(throw (ex-info "Invalid content type. Only images allowed (JPEG, PNG, GIF, WebP)."
|
||||
{:type :ajet.chat/validation-error
|
||||
:content-type content-type
|
||||
:allowed allowed-content-types})))
|
||||
(when (> size-bytes max-file-size)
|
||||
(throw (ex-info (str "File too large. Max size: 10MB, got: " (/ size-bytes 1024 1024.0) "MB")
|
||||
{:type :ajet.chat/validation-error
|
||||
:size-bytes size-bytes
|
||||
:max-bytes max-file-size}))))
|
||||
|
||||
(defn storage-key
|
||||
"Generate storage key: attachments/{uuid}/{filename}."
|
||||
[attachment-id filename]
|
||||
(str "attachments/" attachment-id "/" filename))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Operations
|
||||
;;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn upload!
|
||||
"Upload bytes to storage.
|
||||
|
||||
Returns the storage key."
|
||||
[^S3Client client bucket key ^bytes data content-type]
|
||||
(let [req (-> (PutObjectRequest/builder)
|
||||
(.bucket bucket)
|
||||
(.key key)
|
||||
(.contentType content-type)
|
||||
(.contentLength (long (alength data)))
|
||||
(.build))]
|
||||
(.putObject client req (RequestBody/fromBytes data))
|
||||
(log/info "Uploaded:" key "(" (alength data) "bytes)")
|
||||
key))
|
||||
|
||||
(defn upload-stream!
|
||||
"Upload an InputStream to storage."
|
||||
[^S3Client client bucket key ^InputStream stream content-type content-length]
|
||||
(let [req (-> (PutObjectRequest/builder)
|
||||
(.bucket bucket)
|
||||
(.key key)
|
||||
(.contentType content-type)
|
||||
(.contentLength (long content-length))
|
||||
(.build))]
|
||||
(.putObject client req (RequestBody/fromInputStream stream content-length))
|
||||
(log/info "Uploaded:" key "(" content-length "bytes)")
|
||||
key))
|
||||
|
||||
(defn download
|
||||
"Download file bytes from storage. Returns byte array or nil if not found."
|
||||
[^S3Client client bucket key]
|
||||
(try
|
||||
(let [req (-> (GetObjectRequest/builder)
|
||||
(.bucket bucket)
|
||||
(.key key)
|
||||
(.build))]
|
||||
(.readAllBytes (.getObject client req)))
|
||||
(catch software.amazon.awssdk.services.s3.model.NoSuchKeyException _
|
||||
nil)))
|
||||
|
||||
(defn delete!
|
||||
"Delete a file from storage."
|
||||
[^S3Client client bucket key]
|
||||
(let [req (-> (DeleteObjectRequest/builder)
|
||||
(.bucket bucket)
|
||||
(.key key)
|
||||
(.build))]
|
||||
(.deleteObject client req)
|
||||
(log/info "Deleted:" key)))
|
||||
|
||||
(defn presigned-url
|
||||
"Generate a temporary pre-signed download URL (default: 1 hour)."
|
||||
[^S3Presigner presigner bucket key & [{:keys [duration-minutes] :or {duration-minutes 60}}]]
|
||||
(let [get-req (-> (GetObjectRequest/builder)
|
||||
(.bucket bucket)
|
||||
(.key key)
|
||||
(.build))
|
||||
presign-req (-> (GetObjectPresignRequest/builder)
|
||||
(.signatureDuration (Duration/ofMinutes duration-minutes))
|
||||
(.getObjectRequest get-req)
|
||||
(.build))]
|
||||
(str (.url (.presignGetObject presigner presign-req)))))
|
||||
Reference in New Issue
Block a user