Initial checkin

This commit is contained in:
niten 2022-05-27 10:57:33 -07:00
commit c9adaa5eef
6 changed files with 373 additions and 0 deletions

7
.gitignore vendored Normal file
View File

@ -0,0 +1,7 @@
.DS_Store
.idea
*.log
tmp/
.cpcache/
.nrepl-port

36
deps.edn Normal file
View 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
View 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
View 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
View 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
View 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)))