Initial checkin
This commit is contained in:
commit
c9adaa5eef
7
.gitignore
vendored
Normal file
7
.gitignore
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
.DS_Store
|
||||
.idea
|
||||
*.log
|
||||
tmp/
|
||||
|
||||
.cpcache/
|
||||
.nrepl-port
|
36
deps.edn
Normal file
36
deps.edn
Normal file
@ -0,0 +1,36 @@
|
||||
{
|
||||
:paths ["src"]
|
||||
:deps {
|
||||
org.clojure/clojure { :mvn/version "1.10.3" }
|
||||
org.clojure/core.async { :mvn/version "1.5.648" }
|
||||
org.clojure/core.match { :mvn/version "1.0.0" }
|
||||
org.clojure/test.check { :mvn/version "1.1.1" }
|
||||
|
||||
net.bis5.mattermost4j/mattermost4j-core { :mvn/version "0.24.0" }
|
||||
|
||||
org.fudo/fudo-clojure {
|
||||
:git/url "https://git.fudo.org/fudo-public/fudo-clojure.git"
|
||||
:sha "2d9303f55f7eac9c2f8989e9a0dde3dc97811220"
|
||||
}
|
||||
}
|
||||
:aliases {
|
||||
:test {
|
||||
:extra-paths ["test"]
|
||||
:extra-deps {
|
||||
io.github.cognitect-labs/test-runner
|
||||
{
|
||||
:git/url "https://github.com/cognitect-labs/test-runner.git"
|
||||
:sha "e1e292d8332eb7167e402ecb22f36f1443ba85e6"
|
||||
}
|
||||
}
|
||||
:main-opts ["-m" "cognitect.test-runner"]
|
||||
:exec-fn cognitect.test-runner.api/test
|
||||
}
|
||||
:uberjar {
|
||||
:replace-deps {uberdeps/uberdeps {:mvn/version "1.1.4"}}
|
||||
:replace-paths []
|
||||
:main-opts ["-m" "uberdeps.uberjar"
|
||||
"--target" "./target/bebot.jar"]
|
||||
}
|
||||
}
|
||||
}
|
18
src/bebot/api/channel.clj
Normal file
18
src/bebot/api/channel.clj
Normal file
@ -0,0 +1,18 @@
|
||||
(ns bebot.api.channel)
|
||||
|
||||
(defprotocol IBebotChannelApi
|
||||
(send-post! [self message])
|
||||
(mark-read! [self])
|
||||
|
||||
(last-read [self])
|
||||
|
||||
(get-new-posts! [self])
|
||||
(peek-new-posts! [self])
|
||||
(get-posts-since! [self instant])
|
||||
|
||||
(get-new-mentions! [self])
|
||||
(peek-new-mentions! [self])
|
||||
(get-mentions-since! [self instant])
|
||||
|
||||
(post-channel! [self])
|
||||
(mention-channel! [self]))
|
17
src/bebot/api/client.clj
Normal file
17
src/bebot/api/client.clj
Normal file
@ -0,0 +1,17 @@
|
||||
(ns bebot.api.client)
|
||||
|
||||
(defprotocol IBebotClientStubApi
|
||||
(initialize! [self])
|
||||
(get-me! [self]))
|
||||
|
||||
(defprotocol IBebotClientApi
|
||||
(create-post! [self post])
|
||||
(open-channel! [self chan-id])
|
||||
(open-direct-channel! [self user-id])
|
||||
(mark-read! [self chan-id])
|
||||
(get-post! [self post-id])
|
||||
(get-posts! [self chan-id])
|
||||
(get-posts-since! [self chan-id time])
|
||||
(get-channel! [self chan-id])
|
||||
(get-user! [self user-id])
|
||||
(get-user-by-username! [self username]))
|
149
src/bebot/client.clj
Normal file
149
src/bebot/client.clj
Normal file
@ -0,0 +1,149 @@
|
||||
(ns bebot.client
|
||||
(:require [bebot.model :refer [id user-id new-post to-model mentions-user? channel-last-view from-model created-at]]
|
||||
[bebot.api.client :as client]
|
||||
[bebot.api.channel :as chan]
|
||||
[fudo-clojure.result :refer [let-result exception-failure success failure map-success dispatch-result]]
|
||||
[clojure.core.async :as async :refer [go-loop chan timeout >! <!]])
|
||||
(:import (net.bis5.mattermost.client4 ApiResponse
|
||||
MattermostClient)
|
||||
net.bis5.mattermost.model.ChannelView))
|
||||
|
||||
(defn- to-result [resp]
|
||||
(if (.hasError resp)
|
||||
(let [err (.readError resp)
|
||||
msg (.getMessage err)
|
||||
status-code (.getStatusCode err)
|
||||
full-msg (str "[" status-code "] " msg)]
|
||||
;; A silly hack to catch the stack trace at this point
|
||||
(try
|
||||
(throw (ex-info full-msg
|
||||
{:status-code status-code
|
||||
:error err}))
|
||||
(catch clojure.lang.ExceptionInfo e
|
||||
(exception-failure e))))
|
||||
(success (to-model (.readEntity resp)))))
|
||||
|
||||
(defn- to-millis [instant]
|
||||
(.toEpochMilli instant))
|
||||
|
||||
(defn- pthru [o] (clojure.pprint/pprint o) o)
|
||||
|
||||
(defn- sort-by-create-date [objs]
|
||||
(defn compare-dates [a b]
|
||||
(.isBefore (created-at a) (created-at b)))
|
||||
(sort compare-dates objs))
|
||||
|
||||
(defn- remove-posts-by [user posts]
|
||||
(defn post-by-user? [post] (= (id user) (user-id post)))
|
||||
(filter (complement post-by-user?) posts))
|
||||
|
||||
#_(defn make-lazy-seq
|
||||
([f] (make-lazy-seq f 60))
|
||||
([f delay]
|
||||
(lazy-seq (concat (f) (make-lazy-seq f delay)))))
|
||||
|
||||
(defn- yield-to-channel [coll-gen & { :keys [poll-delay buffer-size] :or {poll-delay 30 buffer-size 10}}]
|
||||
(let [out-chan (chan 10)]
|
||||
(go-loop [result (coll-gen)]
|
||||
(dispatch-result result
|
||||
([os] (doseq [o (sort-by-create-date os)]
|
||||
(>! out-chan (success o))))
|
||||
([e] (>! out-chan (exception-failure e))))
|
||||
(<! (timeout (* poll-delay 1000)))
|
||||
(recur (coll-gen)))
|
||||
out-chan))
|
||||
|
||||
(defrecord BebotChannel [client channel last-viewed me]
|
||||
chan/IBebotChannelApi
|
||||
(send-post! [_ message]
|
||||
(client/create-post! client (new-post channel message)))
|
||||
|
||||
(mark-read! [_]
|
||||
(client/mark-read! client (id channel)))
|
||||
|
||||
(last-read [_] @last-viewed)
|
||||
|
||||
(get-new-posts! [self]
|
||||
(let-result [msgs (chan/peek-new-posts! self)
|
||||
read-instant (client/mark-read! client (id channel))]
|
||||
(do (swap! last-viewed (fn [_] read-instant))
|
||||
(success (remove-posts-by me msgs)))))
|
||||
|
||||
(peek-new-posts! [self]
|
||||
(chan/get-posts-since! self @last-viewed))
|
||||
|
||||
(get-posts-since! [_ instant]
|
||||
(let-result [msgs (client/get-posts-since! client (id channel) instant)]
|
||||
(success (remove-posts-by me msgs))))
|
||||
|
||||
(get-new-mentions! [self]
|
||||
(map-success (chan/get-new-posts! self)
|
||||
(partial filter (mentions-user? me))))
|
||||
|
||||
(peek-new-mentions! [self]
|
||||
(map-success (chan/peek-new-posts! self)
|
||||
(partial filter (mentions-user? me))))
|
||||
|
||||
(get-mentions-since! [self instant]
|
||||
(map-success (chan/get-posts-since! self instant)
|
||||
(partial filter (mentions-user? me))))
|
||||
|
||||
(post-channel! [self]
|
||||
(yield-to-channel (fn [] (chan/get-new-posts! self)) :poll-delay 5))
|
||||
|
||||
(mention-channel! [self]
|
||||
(yield-to-channel (fn [] (chan/get-new-mentions! self)))))
|
||||
|
||||
(defrecord BebotClient [client me]
|
||||
client/IBebotClientApi
|
||||
(create-post! [_ post]
|
||||
(to-result (.createPost client (from-model post))))
|
||||
|
||||
(get-channel! [_ chan-id]
|
||||
(to-result (.getChannel client chan-id nil)))
|
||||
|
||||
(get-user! [_ user-id]
|
||||
(to-result (.getUser client user-id nil)))
|
||||
|
||||
(get-user-by-username! [_ username]
|
||||
(to-result (.getUserByUsername client username nil)))
|
||||
|
||||
(open-channel! [self chan-id]
|
||||
(let-result [chan (client/get-channel! self chan-id)
|
||||
read-instant (client/mark-read! self chan-id)]
|
||||
(success (->BebotChannel self chan (atom read-instant) me))))
|
||||
|
||||
(open-direct-channel! [self user-id]
|
||||
(let-result [chan (to-result (.createDirectChannel client (id me) user-id))]
|
||||
(success (client/open-channel! self (id chan)))))
|
||||
|
||||
(mark-read! [_ chan-id]
|
||||
(let [chan-view (ChannelView. chan-id)]
|
||||
(let-result [views (to-result (.viewChannel client (id me) chan-view))]
|
||||
(if-let [view-time (channel-last-view views chan-id)]
|
||||
(success view-time)
|
||||
(failure (str "unable to mark read, not found: " chan-id)
|
||||
{:channel-views views})))))
|
||||
|
||||
(get-post! [_ post-id]
|
||||
(to-result (.getPost client post-id nil)))
|
||||
|
||||
(get-posts! [_ chan-id]
|
||||
(to-result (.getPostsForChannel client chan-id)))
|
||||
|
||||
(get-posts-since! [_ chan-id instant]
|
||||
(to-result (.getPostsSince client chan-id (to-millis instant)))))
|
||||
|
||||
(defrecord BebotClientStub [client]
|
||||
client/IBebotClientStubApi
|
||||
(get-me! [_]
|
||||
(to-result (.getMe client nil)))
|
||||
(initialize! [self]
|
||||
(map-success (client/get-me! self) (fn [me] (->BebotClient client me)))))
|
||||
|
||||
(defn create-connection [url access-token]
|
||||
(->BebotClientStub (doto (MattermostClient. url)
|
||||
(.setAccessToken access-token))))
|
||||
|
||||
(defn connect [url access-token]
|
||||
(client/initialize! (create-connection url access-token)))
|
146
src/bebot/model.clj
Normal file
146
src/bebot/model.clj
Normal file
@ -0,0 +1,146 @@
|
||||
(ns bebot.model
|
||||
(:require [clojure.string :as str])
|
||||
(:import (net.bis5.mattermost.model Channel
|
||||
ChannelViewResponse
|
||||
Post
|
||||
PostList
|
||||
User)))
|
||||
|
||||
(defn- pthru [o] (clojure.pprint/pprint o) o)
|
||||
|
||||
(defn- to-instant [millis]
|
||||
(java.time.Instant/ofEpochMilli millis))
|
||||
|
||||
(defn- comma-split [str]
|
||||
(filter (comp not empty?)
|
||||
(str/split str #",")))
|
||||
|
||||
(defprotocol IBebotObject
|
||||
(id [self])
|
||||
(created-at [self])
|
||||
(updated-at [self])
|
||||
(deleted-at [self]))
|
||||
|
||||
(defprotocol IBebotUserOwnedObject
|
||||
(user-id [self]))
|
||||
|
||||
(defprotocol IBebotTeamOwnedObject
|
||||
(team-id [self]))
|
||||
|
||||
(defprotocol IBebotChannelObject
|
||||
(channel-id [self]))
|
||||
|
||||
(defprotocol IBebotChannel
|
||||
(channel-type [self])
|
||||
(channel-name [self])
|
||||
(display-name [self])
|
||||
(header [self])
|
||||
(purpose [self])
|
||||
(last-post-at [self])
|
||||
(message-count [self]))
|
||||
|
||||
(defprotocol IBebotPost
|
||||
(post-type [self])
|
||||
(pinned? [self])
|
||||
(parent-id [self])
|
||||
(message [self])
|
||||
(hashtags [self]))
|
||||
|
||||
(defprotocol IBebotUser
|
||||
(username [self])
|
||||
(email [self])
|
||||
(first-name [self])
|
||||
(last-name [self])
|
||||
(roles [self])
|
||||
(bot? [self]))
|
||||
|
||||
(defrecord BebotChannel [c]
|
||||
IBebotObject
|
||||
(id [_] (.getId c))
|
||||
(created-at [_] (-> c (.getCreateAt) to-instant))
|
||||
(updated-at [_] (some-> c (.getUpdateAt) to-instant))
|
||||
(deleted-at [_] (some-> c (.getDeleteAt) to-instant))
|
||||
|
||||
IBebotTeamOwnedObject
|
||||
(team-id [_] (.getTeamId c))
|
||||
|
||||
IBebotChannel
|
||||
(channel-type [_] (.getType c))
|
||||
(channel-name [_] (.getName c))
|
||||
(display-name [_] (.getDisplayName c))
|
||||
(header [_] (.getHeader c))
|
||||
(purpose [_] (.getPurpose c))
|
||||
(last-post-at [_] (-> c (.getLastPostat) to-instant))
|
||||
(message-count [_] (.getTotalMsgContut c)))
|
||||
|
||||
(defrecord BebotPost [p]
|
||||
IBebotObject
|
||||
(id [_] (.getId p))
|
||||
(created-at [_] (-> p (.getCreateAt) to-instant))
|
||||
(updated-at [_] (some-> p (.getUpdateAt) to-instant))
|
||||
(deleted-at [_] (some-> p (.getDeleteAt) to-instant))
|
||||
|
||||
IBebotUserOwnedObject
|
||||
(user-id [_] (.getUserId p))
|
||||
|
||||
IBebotChannelObject
|
||||
(channel-id [_] (.getChannelId p))
|
||||
|
||||
IBebotPost
|
||||
(post-type [_] (.getType p))
|
||||
(pinned? [_] (.isPinned p))
|
||||
(parent-id [_] (.getParentId p))
|
||||
(message [_] (.getMessage p))
|
||||
(hashtags [_] (-> p (.getHashtags) comma-split)))
|
||||
|
||||
(defrecord BebotUser [u]
|
||||
IBebotUser
|
||||
(username [_] (.getUsername u))
|
||||
(email [_] (.getEmail u))
|
||||
(first-name [_] (.getFirstName u))
|
||||
(last-name [_] (.getLastName u))
|
||||
(roles [_] (-> u (.getRoles) comma-split))
|
||||
(bot? [_] (.isBot u))
|
||||
|
||||
IBebotObject
|
||||
(id [_] (.getId u))
|
||||
(created-at [_] (-> u (.getCreateAt) to-instant))
|
||||
(updated-at [_] (some-> u (.getUpdateAt) to-instant))
|
||||
(deleted-at [_] (some-> u (.getDeleteAt) to-instant)))
|
||||
|
||||
(defprotocol IChannelViews
|
||||
(channel-last-view [self chan-id]))
|
||||
|
||||
(defrecord ChannelViews [o]
|
||||
IChannelViews
|
||||
(channel-last-view [_ chan-id]
|
||||
(some-> o (.getLastViewedAtTimes) (get chan-id) (to-instant))))
|
||||
|
||||
(defmulti to-model
|
||||
"Given a mattermost4j object, convert it to the appropriate internal representation."
|
||||
class)
|
||||
|
||||
(defmethod to-model User [o] (->BebotUser o))
|
||||
(defmethod to-model Post [o] (->BebotPost o))
|
||||
(defmethod to-model Channel [o] (->BebotChannel o))
|
||||
(defmethod to-model PostList [o] (map ->BebotPost (vals (.getPosts o))))
|
||||
(defmethod to-model ChannelViewResponse [o] (->ChannelViews o))
|
||||
(defmethod to-model :default [o] (ex-info (str "unsupported class: " (class o))
|
||||
{:argument o}))
|
||||
|
||||
(defprotocol IOutgoingObject
|
||||
(from-model [self]))
|
||||
|
||||
(defrecord OutgoingPost [chan-id message]
|
||||
IOutgoingObject
|
||||
(from-model [_] (Post. chan-id message)))
|
||||
|
||||
(defn new-post [channel message]
|
||||
(->OutgoingPost (id channel) message))
|
||||
|
||||
(defn mentions-username? [username]
|
||||
(let [mention-rx (re-pattern (str "^@" username "( .+)?"))]
|
||||
(fn [post] (->> post message (re-matches mention-rx) nil? not))))
|
||||
|
||||
(defn mentions-user? [user]
|
||||
(mentions-username? (username user)))
|
Loading…
Reference in New Issue
Block a user