Skip to content

Commit

Permalink
Added reactions.
Browse files Browse the repository at this point in the history
  • Loading branch information
kawasima committed Jul 1, 2016
1 parent 9760825 commit 9a3823a
Show file tree
Hide file tree
Showing 20 changed files with 558 additions and 170 deletions.
15 changes: 15 additions & 0 deletions dev/cljs/user.cljs
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,21 @@

(figwheel/start {:websocket-url "ws://localhost:3449/figwheel-ws"})

(set! js/md (-> (js/markdownit
#js {:highlight (fn [s lang]
(when (and lang (.getLanguage js/hljs lang))
(try
(str "<pre class=\"hljs\"><code>"
(-> js/hljs
(.highlight lang s true)
(.-value))
"</code></pre>"))))})
(.use js/markdownitEmoji)))

(set! (.. js/md -renderer -rules -emoji)
(fn [token idx]
(.parse js/twemoji (.-content (aget token idx)))))

(def app-state (atom {:boards {}
:users #{}
:page :board}))
Expand Down
15 changes: 8 additions & 7 deletions project.clj
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
(defproject net.unit8/back-channeling (clojure.string/trim-newline (slurp "VERSION"))
:source-paths ["src/clj"]
:java-source-paths ["src/java"]
:test-paths ["test/clj"]
:min-lein-version "2.0.0"
:dependencies [[org.clojure/clojure "1.8.0"]
[org.clojure/tools.logging "0.3.1"]
Expand All @@ -22,9 +23,9 @@
[bouncer "1.0.0"]
[secretary "1.2.3"]
[org.omcljs/om "1.0.0-alpha36"]
[io.undertow/undertow-websockets-jsr "1.1.1.Final"]
[io.undertow/undertow-websockets-jsr "1.3.23.Final"]
[com.google.guava/guava "19.0"]
[com.datomic/datomic-free "0.9.5359"
[com.datomic/datomic-free "0.9.5385"
:exclusions [org.slf4j/slf4j-api
org.slf4j/slf4j-nop
joda-time
Expand All @@ -34,8 +35,8 @@
[datomic-schema "1.3.0"]
[liberator "0.14.1"]

[ring/ring-defaults "0.2.0" :exclusions [[javax.servlet/servlet-api]]]
[ring "1.4.0" :exclusions [ring/ring-jetty-adapter]]]
[ring/ring-defaults "0.2.1" :exclusions [[javax.servlet/servlet-api]]]
[ring "1.5.0" :exclusions [ring/ring-jetty-adapter]]]

:plugins [[lein-cljsbuild "1.1.3"]
[lein-environ "1.0.3"]]
Expand Down Expand Up @@ -76,11 +77,11 @@
[org.clojure/tools.nrepl "0.2.12"]
[eftest "0.1.1"]
[com.gearswithingears/shrubbery "0.3.1"]
[kerodon "0.7.0"]
[binaryage/devtools "0.6.1"]
[kerodon "0.8.0"]
[binaryage/devtools "0.7.2"]
[com.cemerick/piggieback "0.2.1"]
[duct/figwheel-component "0.3.2"]
[figwheel "0.5.0-6"]]
[figwheel "0.5.4-5"]]
:source-paths ["dev"]
:repl-options {:init-ns user
:nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]}
Expand Down
2 changes: 2 additions & 0 deletions resources/public/js/vendors/markdown-it-emoji.min.js

Large diffs are not rendered by default.

15 changes: 8 additions & 7 deletions src/clj/back_channeling/component/datomic.clj
Original file line number Diff line number Diff line change
Expand Up @@ -23,17 +23,18 @@
(defn dbparts []
[(d/part "message")])

(defrecord DatomicConnection [uri]
(defrecord DatomicConnection [uri recreate?]
component/Lifecycle
(start [component]
(if (:connection component)
component
(let [create? (d/create-database uri)]
(assoc component
:connection (d/connect uri)))))
(do (when recreate?
(d/delete-database uri))
(let [create? (d/create-database uri)]
(assoc component
:connection (d/connect uri))))))
(stop [component]
(dissoc component :connection)))

(defn datomic-connection
[uri]
(DatomicConnection. uri))
(defn datomic-connection [options]
(map->DatomicConnection options))
63 changes: 57 additions & 6 deletions src/clj/back_channeling/component/migration.clj
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,18 @@
[posted-at :instant]
[posted-by :ref]
[content :string :fulltext]
[format :enum [:plain :markdown :voice]]))
[format :enum [:plain :markdown :voice]]
[reactions :ref :many]))
(schema comment-reaction
(fields
[reaction-at :instant]
[reaction-by :ref]
[reaction :ref]))
(schema reaction
(fields
[name :string :unique-value]
[label :string]
[src :uri]))
(schema user
(fields
[name :string :unique-value]
Expand Down Expand Up @@ -56,17 +67,57 @@
(defn dbparts []
[(part "message")])

(defn create-default-values [conn]
@(d/transact conn
[{:db/id #db/id[:db.part/user]
:board/name "default"
:board/description "Default board"}
{:db/id #db/id[:db.part/user -1]
:reaction/name "GM"
:reaction/label "( ノ゚Д゚)"}
{:db/id #db/id[:db.part/user -2]
:reaction/name "THX"
:reaction/label "(´▽`)"}
{:db/id #db/id[:db.part/user -3]
:reaction/name "SRY"
:reaction/label "(m´・ω・`)m"}
{:db/id #db/id[:db.part/user -4]
:reaction/name "BYE"
:reaction/label "( ´Д`)ノ"}
{:db/id #db/id[:db.part/user -5]
:reaction/name "BR"
:reaction/label "( `・ω・´)ノ"}
{:db/id #db/id[:db.part/user -6]
:reaction/name "GJ"
:reaction/label "(・∀・)"}
{:db/id #db/id[:db.part/user -7]
:reaction/name "BAD"
:reaction/label "(・A・)"}
{:db/id #db/id[:db.part/user -8]
:reaction/name "OK"
:reaction/label "(`・ω・´)ゞ"}
{:db/id #db/id[:db.part/user -9]
:reaction/name "NG"
:reaction/label "(´・д・`)"}
{:db/id #db/id[:db.part/user -10]
:reaction/name "HERE"
:reaction/label "(゚д゚)/"}
{:db/id #db/id[:db.part/user -11]
:reaction/name "OMG"
:reaction/label "ヽ(`Д´)ノ"}
{:db/id #db/id[:db.part/user -12]
:reaction/name "LOL"
:reaction/label "((´∀`))"}
]))

(defn create-schema [conn]
(let [schema (concat
(s/generate-parts (dbparts))
#_(generate-enums [])
(s/generate-schema (dbschema)))]
@(d/transact conn schema)
(when-not (d/q '{:find [?e .] :where [[?e :board/name "default"]]} (d/db conn))
@(d/transact conn
[{:db/id #db/id[:db.part/user]
:board/name "default"
:board/description "Default board"}]))))
(create-default-values conn))))


(defrecord ModelMigration []
component/Lifecycle
Expand Down
40 changes: 24 additions & 16 deletions src/clj/back_channeling/component/socketapp.clj
Original file line number Diff line number Diff line change
Expand Up @@ -5,20 +5,10 @@
(back-channeling.component [token :as token]))
(:import [io.undertow.websockets.core WebSockets WebSocketCallback]))

(defn broadcast-message [{:keys [channels path]} message]
(doseq [[channel user] (get @channels path)]
(WebSockets/sendText (pr-str message) channel
(proxy [WebSocketCallback] []
(complete [channel context])
(onError [channel context throwable])))))

(defn multicast-message [{:keys [channels path]} message users]
(doseq [[channel user] (get @channels path)]
(when (users user)
(WebSockets/sendText (pr-str message) channel
(proxy [WebSocketCallback] []
(complete [channel context])
(onError [channel context throwable]))))))

(defprotocol ISendMessage
(broadcast-message [this message])
(multicast-message [this message users]))

(defn find-users [{:keys [channels path]}]
(->> (get @channels path)
Expand Down Expand Up @@ -74,7 +64,7 @@
(log/debug "message=" message)
(handle-command component
(edn/read-string message) ch))

:on-close
(fn [ch close-reason]
(log/info "disconnect" ch "for" close-reason)
Expand All @@ -83,7 +73,25 @@
[:leave (find-user-by-channel component ch)] ch)))))

(stop [component]
(dissoc component :path :on-message :on-close :channels)))
(dissoc component :path :on-message :on-close :channels))

ISendMessage
(broadcast-message [{:keys [channels path]} message]
(doseq [[channel user] (get @channels path)]
(WebSockets/sendText (pr-str message) channel
(proxy [WebSocketCallback] []
(complete [channel context])
(onError [channel context throwable])))))

(multicast-message [{:keys [channels path]} message users]
(doseq [[channel user] (get @channels path)]
(when (users user)
(WebSockets/sendText (pr-str message) channel
(proxy [WebSocketCallback] []
(complete [channel context])
(onError [channel context throwable]))))))

)

(defn socketapp-component [options]
(map->SocketApp options))
38 changes: 24 additions & 14 deletions src/clj/back_channeling/component/token.clj
Original file line number Diff line number Diff line change
@@ -1,29 +1,39 @@

(ns back-channeling.component.token
"Provides a token for authorization."
(:require [com.stuartsierra.component :as component]
[clojure.tools.logging :as log]
[clojure.core.cache :as cache])
(:import [java.util UUID]))

(defn new-token [component user]
(let [token (java.util.UUID/randomUUID)]
(swap! (:token-cache component) assoc token user)
token))

(defn auth-by [component token]
(let [uuid-token (UUID/fromString token)]
(cache/lookup @(:token-cache component) uuid-token)))

(defprotocol ITokenProvider
(new-token [this user])
(auth-by [this token]))

(defrecord TokenProvider []
(defrecord TokenProvider [disposable?]
component/Lifecycle

(start [component]
(let [token-cache (atom (cache/ttl-cache-factory {} :ttl (* 30 60 1000)))]
(assoc component :token-cache token-cache)))
(if (:token-cache component)
component
(let [token-cache (atom (cache/ttl-cache-factory {} :ttl (* 30 60 1000)))]
(assoc component :token-cache token-cache))))

(stop [component]
(dissoc component :token-cache)))
(if disposable?
(dissoc component :token-cache)
component))

ITokenProvider
(new-token [component user]
(let [token (java.util.UUID/randomUUID)]
(swap! (:token-cache component) assoc token user)
token))

(auth-by [component token]
(let [uuid-token (condp instance? token
String (UUID/fromString token)
UUID token)]
(cache/lookup @(:token-cache component) uuid-token))))

(defn token-provider-component [options]
(map->TokenProvider options))
4 changes: 2 additions & 2 deletions src/clj/back_channeling/config.clj
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,8 @@
(def defaults
{:http {:port 3009}
:socketapp {:path "/ws"}
:datomic {:uri "datomic:mem://bc"}})
:datomic {:uri "datomic:mem://bc"
:recreate? false}})

(def environ {:http {:port (some-> env :port Integer.)}
:datomic {:uri (some-> env :datomic-url) }})

Loading

0 comments on commit 9a3823a

Please sign in to comment.