This commit is contained in:
2024-03-07 21:52:16 -08:00
parent 18801e1e1c
commit c95571a03f

View File

@@ -4,14 +4,20 @@
[clojure.pprint :refer [pprint]]
[clojure.string :as str]
[clojure.java.io :as io]
[camel-snake-kebab.core :refer [->kebab-case]])
[clojure.core.async :refer [>! <! chan go-loop timeout pipeline]]
[camel-snake-kebab.core :refer [->kebab-case]]
[slingshot.slingshot :refer [try+ throw+]])
(:import java.net.InetAddress
java.net.URLEncoder
java.net.URI
java.util.UUID
org.apache.tika.Tika))
org.apache.tika.Tika
clojure.lang.ExceptionInfo))
(defn pthru [o] (pprint o) o)
(defn pthru [o]
(pprint o)
(flush)
o)
(defmulti decode-body :content-type)
(defmethod decode-body :json [res]
@@ -26,19 +32,19 @@
(defmulti exec-request! :method)
(defmethod exec-request! :get
[& {:keys [url accept] :as opts}]
(-> (pthru url)
(-> url
(http/get opts)
(assoc :content-type accept)
(decode-body)))
(defmethod exec-request! :post
[& {:keys [url accept] :as opts}]
(-> (pthru url)
(-> url
(http/post (encode-body opts))
(assoc :content-type accept)
(decode-body)))
(defmethod exec-request! :put
[& {:keys [url accept] :as opts}]
(-> (pthru url)
(-> url
(http/put (encode-body opts))
(assoc :content-type accept)
(decode-body)))
@@ -46,23 +52,6 @@
[& {:keys [method]}]
(throw (RuntimeException. (str "Bad method: " method))))
(defn- put-bytes!
([url] (put-bytes! url {}))
([url opts] (-> url
(http/put (-> opts
(update :accept (fn [_] :json))
(update :content-type (fn [_] :json))))
:body
(json/read-str :key-fn keyword))))
(defn- put-multipart!
([url] (put-multipart! url {}))
([url opts] (-> url
(http/put (-> opts
(update :accept (fn [_] :json))))
:body
(json/read-str :key-fn keyword))))
(defn- matrix-url
[base components & {:keys [api version]
:or {api "client" version 3}}]
@@ -90,11 +79,11 @@
:base_url))
(defn get-jwt-token! [& {:keys [domain username password]}]
(-> (exec-request! {:url (get-token-issuer! provider-url)
(-> (exec-request! {:url (str (get-token-issuer! domain) "/")
:method :post
:accept :json
:form-params {:grant_type "client_credentials"
:client_id (get-client-id! client-id)
:client_id (get-client-id! domain)
:username username
:password password}})
:access_token))
@@ -167,15 +156,33 @@
(defn- assoc-if-present [m k v]
(if v (assoc m k v) m))
(defn- make-room [client room-id]
{ :client client :room-id room-id })
(defn create-private-room! [client & {:keys [name alias topic invitees]
:or {invitees []}}]
(post! client [:createRoom]
{:content-type :json
:body (-> {:preset "private_chat"}
(assoc-if-present :name name)
(assoc-if-present :alias alias)
(assoc-if-present :topic topic)
(assoc :invite invitees))}))
(->> (post! client [:createRoom]
{:content-type :json
:body (-> {:preset "private_chat"}
(assoc-if-present :name name)
(assoc-if-present :alias alias)
(assoc-if-present :topic topic)
(assoc :invite invitees))})
:room_id
(make-room client)))
(defn join-public-room! [client & {:keys [alias]}]
(try
(->> (post! client [:join alias]
{:content-type :json
:body {:reason "mabel client joining"}})
(pthru)
:room_id
(make-room client))
(catch ExceptionInfo e
(let [info (ex-info e)]
(if (= (:status info) 403)
(throw+ {:type ::forbidden :room-alias alias} e))))))
(defn get-room-members! [client room-id]
(get! client [:rooms room-id :members]))
@@ -191,15 +198,62 @@
(get! client [:rooms room-id :messages]
{:query-params {:dir "b"}}))
(defn get-current-event-stamp! [client]
(-> (get! client [:sync]) :next_batch))
(defn get-room-messages! [client room-id]
(->> (get-room-events! client room-id)
(->> (get! client [:rooms room-id :messages]
{:query-params {:dir "b"}})
:chunk
(filter is-message?)))
(defn get-room-events-from! [client room-id from]
(get! client [:rooms room-id :messages]
{:query-params {:dir "b" :from from}}))
(defn room-event-channel!
([room] (room-event-channel! room {}))
([{:keys [room-id client]}
{:keys [buffer poll-freq]
:or {buffer 5
poll-freq 5}}]
(let [evt-chan (chan buffer)
seen-messages (atom #{})]
(go-loop [response (get-room-events-from! client room-id
(get-current-event-stamp! client))]
(doseq [{:keys [event_id] :as evt} (:chunk response)]
(when (not (contains? @seen-messages event_id))
(swap! seen-messages conj event_id)
(>! evt-chan evt)))
(<! (timeout (* poll-freq 1000)))
(recur (get-room-events-from! client room-id (:end response))))
evt-chan)))
(defn- parallelism []
(-> (Runtime/getRuntime)
(.availableProcessors)
(+ 1)))
(defn pipe [in xf]
(let [out (chan)]
(pipeline (parallelism) out xf in)
out))
(defn room-message-channel! [& args]
(pipe (apply room-event-channel! args)
(filter is-message?)))
(defn room-self-mention-channel! [{{:keys [user-id]} :client :as room} & rest]
(pipe (apply room-message-channel! (cons room rest))
(filter (partial mentions? user-id))))
(defn get-room-mentions! [client room-id user]
(filter (partial mentions? user)
(get-room-messages! client room-id)))
(defn get-room-self-mentions! [{:keys [user-id] :as client} room-id]
(get-room-mentions! client room-id user-id))
(defn send-message! [client room-id msg]
(let [txn-id (str (UUID/randomUUID))]
(put! client [:rooms room-id :send "m.room.message" txn-id]
@@ -237,3 +291,15 @@
:url (str media-uri)}
:accept :json
:content-type :json}))))
(defn room-message! [{:keys [client room-id]} msg]
(send-message! client room-id msg))
(defn room-image! [{:keys [client room-id]} bytes filename]
(send-image! client room-id bytes filename))
(defn room-mentions! [{:keys [client room-id]} user]
(get-room-mentions! client room-id user))
(defn room-self-mentions! [{:keys [room-id client]}]
(get-room-self-mentions! client room-id))