├── .gitignore
├── dev
    ├── user.clj
    └── dev.clj
├── resources
    ├── events.js
    └── logback.xml
├── src
    └── chatserver
    │   ├── main.clj
    │   ├── website.clj
    │   ├── system.clj
    │   └── events.clj
├── project.clj
└── README.md


/.gitignore:
--------------------------------------------------------------------------------
 1 | /target
 2 | /classes
 3 | /checkouts
 4 | pom.xml
 5 | pom.xml.asc
 6 | *.jar
 7 | *.class
 8 | /.lein-*
 9 | /.nrepl-port
10 | .hgignore
11 | .hg/
12 | 


--------------------------------------------------------------------------------
/dev/user.clj:
--------------------------------------------------------------------------------
 1 | (ns user)
 2 | 
 3 | ;; This is an old trick from Pedestal. When system.clj doesn't compile,
 4 | ;; it can prevent the REPL from starting, which makes debugging very
 5 | ;; difficult. This extra step ensures the REPL starts, no matter what.
 6 | 
 7 | (defn dev
 8 |   []
 9 |   (require 'dev)
10 |   (in-ns 'dev))
11 | 
12 | 
13 | (defn go
14 |   []
15 |   (println "Don't you mean (dev) ?"))
16 | 


--------------------------------------------------------------------------------
/resources/events.js:
--------------------------------------------------------------------------------
 1 | // POST messages using AJAX
 2 | $("#chat").click(function(ev) {
 3 |     console.log("posting message: " + $("#message").val())
 4 |     $.ajax({
 5 |     type: "POST",
 6 |     url: "/events/messages",
 7 |     data: $("#message").val(),
 8 |     contentType: "text/plain"
 9 |     })
10 | });
11 | 
12 | 
13 | // Listen for messages using HTML5 Server Sent Events (SSE)
14 | es = new EventSource("/events/events");
15 | es.addEventListener("message",
16 |                     function(ev) {
17 |                         console.log("message: " + ev.data)
18 |                         $("#messages").append("<li>"+ev.data+"</li>");
19 |                     });
20 | 


--------------------------------------------------------------------------------
/resources/logback.xml:
--------------------------------------------------------------------------------
 1 | <configuration scan="true" scanPeriod="1 seconds" debug="false">
 2 | 
 3 |   <appender name="CONSOLE" class="ch.qos.logback.core.ConsoleAppender">
 4 |     <encoder>
 5 |       <pattern>%d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n</pattern>
 6 |     </encoder>
 7 |     <filter class="ch.qos.logback.classic.filter.ThresholdFilter">
 8 |       <level>DEBUG</level>
 9 |     </filter>
10 |   </appender>
11 | 
12 |   <!-- Just switch level to DEBUG on this and/or some of the loggers
13 |        below -->
14 |   <logger name="chatserver" level="DEBUG"/>
15 | 
16 |   <!-- TODO (modular) Automatically generate based on project options -->
17 |   <logger name="cylon" level="INFO"/>
18 |   <logger name="modular.http-kit" level="INFO"/>
19 |   <logger name="modular.bidi" level="INFO"/>
20 | 
21 |   <root level="INFO">
22 |     <appender-ref ref="CONSOLE"/>
23 |   </root>
24 | 
25 | </configuration>
26 | 


--------------------------------------------------------------------------------
/src/chatserver/main.clj:
--------------------------------------------------------------------------------
 1 | (ns chatserver.main
 2 |   "Main entry point"
 3 |   (:require clojure.pprint)
 4 |   (:gen-class))
 5 | 
 6 | (defn -main [& args]
 7 |   ;; We eval so that we don't AOT anything beyond this class
 8 |   (eval '(do (require 'chatserver.system)
 9 |              (require 'chatserver.main)
10 |              (require 'com.stuartsierra.component)
11 | 
12 |              (require 'clojure.java.browse)
13 | 
14 |              (println "Starting chatserver")
15 | 
16 |              (let [system (->
17 |                            (chatserver.system/new-production-system)
18 |                            com.stuartsierra.component/start)]
19 | 
20 |                (println "System started")
21 |                (println "Ready...")
22 | 
23 |                (let [url (format "http://localhost:%d/" (-> system :http-listener-listener :port))]
24 |                  (println (format "Browsing at %s" url))
25 |                  (clojure.java.browse/browse-url url))))))
26 | 


--------------------------------------------------------------------------------
/project.clj:
--------------------------------------------------------------------------------
 1 | (defproject chatserver "0.1.0-SNAPSHOT"
 2 |   :description "A chatserver"
 3 |   :url "http://github.com/juxt/chatserver"
 4 | 
 5 |   :exclusions [com.stuartsierra/component]
 6 | 
 7 |   :dependencies
 8 |   [
 9 |    [hiccup "1.0.5"]
10 |       [com.stuartsierra/component "0.2.2"]
11 |    [juxt.modular/bidi "0.9.1"]
12 |    #_[juxt.modular/http-kit "0.5.4"]
13 |    [juxt.modular/aleph "0.0.8"]
14 |    [yada "0.2.3"]
15 |    [juxt.modular/maker "0.5.0"]
16 |    [juxt.modular/wire-up "0.5.0"]
17 |    [org.clojure/clojure "1.7.0-alpha4"]
18 |    [org.clojure/core.async "0.1.346.0-17112a-alpha"]
19 |    [org.clojure/tools.logging "0.2.6"]
20 |    [org.clojure/tools.reader "0.8.13"]
21 |    [org.slf4j/jcl-over-slf4j "1.7.2"]
22 |    [org.slf4j/jul-to-slf4j "1.7.2"]
23 |    [org.slf4j/log4j-over-slf4j "1.7.2"]
24 |    [org.webjars/jquery "2.1.0"]
25 |    [prismatic/plumbing "0.3.5"]
26 |    [prismatic/schema "0.3.5"]
27 |    [ch.qos.logback/logback-classic "1.0.7" :exclusions [org.slf4j/slf4j-api]]
28 |    ]
29 | 
30 |   :main chatserver.main
31 | 
32 |   :repl-options {:init-ns user
33 |                  :welcome (println "Type (dev) to start")}
34 | 
35 | 
36 |   :profiles {:dev {:dependencies [[org.clojure/tools.namespace "0.2.5"]]
37 |                    :source-paths ["dev"
38 |                                   ]}})
39 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # chatserver
 2 | 
 3 | To demonstrate an asynchronous chatserver using yada's server-sent-events
 4 | 
 5 | Also see https://github.com/juxt/chatclient
 6 | 
 7 | ## Usage
 8 | 
 9 | To run the application, install [Leiningen](http://leiningen.org/) and type
10 | 
11 | ```
12 | lein run
13 | ```
14 | 
15 | ## Development
16 | 
17 | For rapid development, use the REPL from the command line or via your
18 | favorite code editor.
19 | 
20 | ```
21 | lein repl
22 | user> (dev)
23 | dev> (go)
24 | ```
25 | 
26 | After making code changes, reset your application's state (causing all
27 | your modifications to be reloaded too).
28 | 
29 | ```
30 | dev> (reset)
31 | ```
32 | 
33 | Rinse and repeat.
34 | 
35 | ## Copyright and License
36 | 
37 | The MIT License (MIT)
38 | 
39 | Copyright © 2015 Malcolm Sparks
40 | 
41 | Permission is hereby granted, free of charge, to any person obtaining a copy of
42 | this software and associated documentation files (the "Software"), to deal in
43 | the Software without restriction, including without limitation the rights to
44 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
45 | the Software, and to permit persons to whom the Software is furnished to do so,
46 | subject to the following conditions:
47 | 
48 | The above copyright notice and this permission notice shall be included in all
49 | copies or substantial portions of the Software.
50 | 
51 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
52 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
53 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
54 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
55 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
56 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
57 | 


--------------------------------------------------------------------------------
/dev/dev.clj:
--------------------------------------------------------------------------------
 1 | (ns dev
 2 |   (:require
 3 |    [clojure.pprint :refer (pprint)]
 4 |    [clojure.reflect :refer (reflect)]
 5 |    [clojure.repl :refer (apropos dir doc find-doc pst source)]
 6 |    [clojure.tools.namespace.repl :refer (refresh refresh-all)]
 7 |    [clojure.java.io :as io]
 8 |    [com.stuartsierra.component :as component]
 9 |    [chatserver.system :refer (config new-system-map new-dependency-map new-co-dependency-map)]
10 |    [modular.maker :refer (make)]
11 |    [modular.wire-up :refer (normalize-dependency-map)]
12 |    [clojure.core.async :as a]))
13 | 
14 | (def system nil)
15 | 
16 | (defn new-dev-system
17 |   "Create a development system"
18 |   []
19 |   (let [config (config)
20 |         s-map (->
21 |                (new-system-map config)
22 |                #_(assoc
23 |                  ))]
24 |     (-> s-map
25 |         (component/system-using (new-dependency-map))
26 |         )))
27 | 
28 | (defn init
29 |   "Constructs the current development system."
30 |   []
31 |   (alter-var-root #'system
32 |     (constantly (new-dev-system))))
33 | 
34 | (defn start
35 |   "Starts the current development system."
36 |   []
37 |   (alter-var-root
38 |    #'system
39 |    component/start
40 | ))
41 | 
42 | (defn stop
43 |   "Shuts down and destroys the current development system."
44 |   []
45 |   (alter-var-root #'system
46 |                   (fn [s] (when s (component/stop s)))))
47 | 
48 | (defn go
49 |   "Initializes the current development system and starts it running."
50 |   []
51 |   (init)
52 |   (start)
53 |   :ok
54 |   )
55 | 
56 | (defn reset []
57 |   (stop)
58 |   (refresh :after 'dev/go))
59 | 
60 | ;; REPL Convenience helpers
61 | 
62 | (defn routes []
63 |   (-> system :modular-bidi-router-webrouter :routes))
64 | 
65 | (defn match-route [path]
66 |   (bidi.bidi/match-route (routes) path))
67 | 
68 | (defn path-for [path & args]
69 |   (apply modular.bidi/path-for
70 |          (-> system :modular-bidi-router-webrouter) path args))
71 | 
72 | ;; ~/chatserver/dev/dev.clj
73 | (defn get-channel [] (-> system :sse-demo-events-events :channel))
74 | 


--------------------------------------------------------------------------------
/src/chatserver/website.clj:
--------------------------------------------------------------------------------
 1 | (ns chatserver.website
 2 |   (:require
 3 |    [clojure.core.async :refer (go >! <! buffer dropping-buffer sliding-buffer chan take!)]
 4 |    [clojure.pprint :refer (pprint)]
 5 |    [clojure.tools.logging :refer :all]
 6 |    [bidi.bidi :refer (path-for RouteProvider handler)]
 7 |    [bidi.ring :refer (redirect)]
 8 |    [com.stuartsierra.component :refer (Lifecycle using)]
 9 |    [hiccup.core :as hiccup]
10 |    [ring.util.response :refer (response redirect-after-post)]))
11 | 
12 | (defn index [req]
13 |   {:status 200
14 |    :body (hiccup/html
15 |           [:body
16 |            [:h1 "HTTP Async - I woz 'ere"]
17 |            [:p [:a {:href "/system.html"} "System"]]
18 |            [:p [:a {:href "/channel.html"} "Channel"]]
19 |            ])})
20 | 
21 | (defn show-system []
22 |   (fn [req]
23 |     {:status 200
24 |      :body (hiccup/html
25 |             [:body
26 |              [:h2 "System"]
27 |              [:pre (hiccup/h (with-out-str (pprint @(find-var 'dev/system))))]])}))
28 | 
29 | (defn show-channel [ch]
30 |   (fn [req]
31 |     {:status 200
32 |      :body (hiccup/html
33 |             [:body
34 |              [:h2 "Channel"]
35 |              [:p "Channel type: " (type ch)]
36 |              [:p "Buffer type: " (.-buf ch)]
37 |              [:p "Channel count: " (count (.-buf ch))]
38 |              [:p "Channel value: " (pr-str (.-buf (.-buf ch)))]
39 |              [:form {:action "/drop" :method :post}
40 |               [:input {:type :submit :value "Drop"}]]])}))
41 | 
42 | (defn drop-from-channel [ch]
43 |   (fn [req]
44 |     (go (<! ch))
45 |     (redirect-after-post "/channel.html")))
46 | 
47 | ;; Components are defined using defrecord.
48 | 
49 | (defrecord Website []
50 |   Lifecycle
51 |   (start [component]
52 |     (let [ch (chan (buffer 10))]
53 |       ;; Let's load the channel up with some data
54 |       (go (dotimes [n 26] (>! ch (char (+ (int \A) n)))))
55 |       (assoc component :channel ch)))
56 |   (stop [component] component)
57 | 
58 |   RouteProvider
59 |   ;; Return a bidi route structure, mapping routes to wrapped
60 |   ;; handlers. This additional level of indirection means we can
61 |   ;; generate hyperlinks from known keywords.
62 |   (routes [component]
63 |     ["/" {"index.html" (handler ::index index)
64 |           "" (redirect ::index)
65 |           "system.html" (handler ::show-system (show-system))
66 |           "channel.html" (handler ::show-channel (show-channel (:channel component)))
67 |           "drop" (handler ::drop (drop-from-channel (:channel component)))}]))
68 | 
69 | ;; While not mandatory, it is common to use a function to construct an
70 | ;; instance of the component. This affords the opportunity to control
71 | ;; the construction with parameters, provide defaults and declare
72 | ;; dependency relationships with other components.
73 | 
74 | (defn new-website []
75 |   (-> (map->Website {})))
76 | 


--------------------------------------------------------------------------------
/src/chatserver/system.clj:
--------------------------------------------------------------------------------
  1 | (ns chatserver.system
  2 |   "Components and their dependency relationships"
  3 |   (:refer-clojure :exclude (read))
  4 |   (:require
  5 |    [clojure.java.io :as io]
  6 |    [clojure.tools.reader :refer (read)]
  7 |    [clojure.string :as str]
  8 |    [clojure.tools.reader.reader-types :refer (indexing-push-back-reader)]
  9 |    [com.stuartsierra.component :refer (system-map system-using using)]
 10 |    [modular.maker :refer (make)]
 11 |    [modular.bidi :refer (new-router new-web-resources)]
 12 |    [modular.aleph :refer (new-webserver)]
 13 |    [chatserver.events :refer (new-events-website)]
 14 |    [chatserver.website :refer (new-website)]))
 15 | 
 16 | (defn ^:private read-file
 17 |   [f]
 18 |   (read
 19 |    ;; This indexing-push-back-reader gives better information if the
 20 |    ;; file is misconfigured.
 21 |    (indexing-push-back-reader
 22 |     (java.io.PushbackReader. (io/reader f)))))
 23 | 
 24 | (defn ^:private config-from
 25 |   [f]
 26 |   (if (.exists f)
 27 |     (read-file f)
 28 |     {}))
 29 | 
 30 | (defn ^:private user-config
 31 |   []
 32 |   (config-from (io/file (System/getProperty "user.home") ".chatserver.edn")))
 33 | 
 34 | (defn ^:private config-from-classpath
 35 |   []
 36 |   (if-let [res (io/resource "chatserver.edn")]
 37 |     (config-from (io/file res))
 38 |     {}))
 39 | 
 40 | (defn config
 41 |   "Return a map of the static configuration used in the component
 42 |   constructors."
 43 |   []
 44 |   (merge (config-from-classpath)
 45 |          (user-config)))
 46 | 
 47 | (defn http-listener-components
 48 |   [system config]
 49 |   (assoc system
 50 |     :http-listener-listener
 51 |     (new-webserver :port 3001)))
 52 | 
 53 | (defn modular-bidi-router-components
 54 |   [system config]
 55 |   (assoc system
 56 |     :modular-bidi-router-webrouter
 57 |     (make new-router config)))
 58 | 
 59 | (defn jquery-components
 60 |   "Serve JQuery resources from a web-jar."
 61 |   [system config]
 62 |   (assoc system
 63 |     :jquery-resources
 64 |     (->
 65 |       (make new-web-resources config :uri-context "/jquery" :resource-prefix "META-INF/resources/webjars/jquery/2.1.0" :key :jquery-resources)
 66 |       (using []))))
 67 | 
 68 | (defn sse-demo-website-components
 69 |   [system config]
 70 |   (assoc system
 71 |              :sse-demo-website-website
 72 |     (->
 73 |       (make new-website config)
 74 |       (using []))))
 75 | 
 76 | (defn sse-demo-events-components
 77 |   [system config]
 78 |   (assoc system
 79 |     :sse-demo-events-events
 80 |     (->
 81 |       (make new-events-website config)
 82 |       (using []))))
 83 | 
 84 | (defn new-system-map
 85 |   [config]
 86 |   (apply system-map
 87 |     (apply concat
 88 |       (-> {}
 89 | 
 90 |           (http-listener-components config)
 91 |           (modular-bidi-router-components config)
 92 |           (jquery-components config)
 93 |           (sse-demo-website-components config)
 94 |           (sse-demo-events-components config)))))
 95 | 
 96 | (defn new-dependency-map
 97 |   []
 98 |   {:http-listener-listener {:request-handler :modular-bidi-router-webrouter},
 99 |    :modular-bidi-router-webrouter {:jquery :jquery-resources,
100 |                                    :website :sse-demo-website-website,
101 |                                    :events :sse-demo-events-events}})
102 | 
103 | (defn new-co-dependency-map
104 |   []
105 |   {})
106 | 
107 | (defn new-production-system
108 |   "Create the production system"
109 |   ([opts]
110 |    (-> (new-system-map (merge (config) opts))
111 |      (system-using (new-dependency-map))))
112 |   ([] (new-production-system {})))
113 | 


--------------------------------------------------------------------------------
/src/chatserver/events.clj:
--------------------------------------------------------------------------------
  1 | (ns chatserver.events
  2 |   (:require
  3 |    [clojure.core.async :as async :refer (go go-loop >! <! buffer dropping-buffer sliding-buffer chan put! mult tap)]
  4 |    [clojure.java.io :as io]
  5 |    [clojure.pprint :refer (pprint)]
  6 |    [clojure.tools.logging :refer :all]
  7 |    [bidi.bidi :refer (path-for RouteProvider handler)]
  8 |    [bidi.ring :refer (redirect)]
  9 |    [com.stuartsierra.component :refer (Lifecycle using)]
 10 |    [hiccup.core :as hiccup]
 11 |    [ring.util.response :refer (response redirect-after-post)]
 12 |    [ring.middleware.params :refer (params-request)]
 13 |    [yada.yada :refer (yada)]))
 14 | 
 15 | (defn index [req]
 16 |   {:status 200
 17 |    :body (hiccup/html
 18 |           [:body
 19 |            [:h1 "HTTP Async"]
 20 |            [:p [:a {:href "system.html"} "System"]]
 21 |            [:p [:a {:href "chat.html"} "Chat"]]
 22 |            ])})
 23 | 
 24 | (defn show-system []
 25 |   (fn [req]
 26 |     {:status 200
 27 |      :body (hiccup/html
 28 |             [:body
 29 |              [:h2 "System"]
 30 |              [:pre (hiccup/h (with-out-str (pprint @(find-var 'dev/system))))]])}))
 31 | 
 32 | (defn show-chat [{:keys [messages]}]
 33 |   (fn [req]
 34 |     {:status 200
 35 |      :body (hiccup/html
 36 |             [:html
 37 |              [:head
 38 |               [:title "Chat"]
 39 |               [:script {:src "/jquery/jquery.min.js"}]]
 40 |              [:body
 41 |               [:h2 "Chat"]
 42 |               [:ul#messages
 43 |                (for [msg @messages]
 44 |                  [:li msg])]
 45 |               [:div
 46 |                [:input#message {:type :text :name :message}]
 47 |                [:button#chat "Chat"]]
 48 |               [:script (slurp (io/resource "events.js"))]]])}))
 49 | 
 50 | (defn post-to-channel [{:keys [messages channel]}]
 51 |   (fn [req]
 52 |     (let [msg (slurp (:body req))]
 53 |       (swap! messages conj msg)
 54 |       (put! channel msg)
 55 |       {:status 200
 56 |        :headers {"access-control-allow-origin" "*"}
 57 |        :body "Thank you"})))
 58 | 
 59 | ;; Original http-kit implementation, commented out now we're using aleph+yada
 60 | #_(defn server-event-source
 61 |   "Take a mult and return a handler that will produce HTML5 server-sent
 62 |   event (SSE) streams"
 63 |   [mlt]
 64 |   (fn [req]
 65 |     (let [ch (chan 16)]
 66 |       (tap mlt ch)
 67 |       (httpkit/with-channel req browser-connection
 68 |         (httpkit/on-close browser-connection (fn [_]
 69 |                                                (async/untap mlt ch)
 70 |                                                (async/close! ch)))
 71 | 
 72 |         (httpkit/send! browser-connection
 73 |                        {:status 200
 74 |                         :headers {"Content-Type" "text/event-stream"}} false)
 75 |         (go-loop []
 76 |           (when-let [data (<! ch)]
 77 | 
 78 |             ;; WARNING: Calls to httpkit/send! will not block, so
 79 |             ;; httpkit's queue will grow until we run out of memory -
 80 |             ;; there is no back pressure here, see here for discussion:
 81 |             ;; https://groups.google.com/forum/#!topic/clojure/DbBzM3AG9wM
 82 |             ;; This is why we have moved from httpkit to aleph+yada
 83 |             (httpkit/send! browser-connection (str "data: " data "\r\n\r\n") false)
 84 | 
 85 |             (recur)))))))
 86 | 
 87 | ;; Components are defined using defrecord.
 88 | 
 89 | (defrecord Website []
 90 |   Lifecycle
 91 |   (start [component]
 92 |     (let [ch (chan (buffer 10))]
 93 |       ;; Let's create a mult
 94 |       (assoc component
 95 |              :channel ch
 96 |              :messages (atom [])
 97 |              :mult (mult ch))))
 98 |   (stop [component] component)
 99 | 
100 |   RouteProvider
101 |   ;; Return a bidi route structure, mapping routes to keywords defined
102 |   ;; above. This additional level of indirection means we can generate
103 |   ;; hyperlinks from known keywords.
104 |   (routes [component]
105 |     ["/events/"
106 |      {"index.html" (handler ::index index)
107 |       "" (redirect ::index)
108 |       "system.html" (handler ::show-system (show-system))
109 |       "chat.html" (handler ::show-chat (show-chat component))
110 |       "messages" (handler ::post (post-to-channel component))
111 |       "events" (handler ::events (yada
112 |                                   :allow-origin true
113 |                                   :events (fn [ctx]
114 |                                             (let [ch (chan 256)]
115 |                                               (tap (:mult component) ch)
116 |                                               (go (>! ch "First message!"))
117 |                                               ch)
118 |                                             )))}]))
119 | 
120 | ;; While not mandatory, it is common to use a function to construct an
121 | ;; instance of the component. This affords the opportunity to control
122 | ;; the construction with parameters, provide defaults and declare
123 | ;; dependency relationships with other components.
124 | 
125 | (defn new-events-website []
126 |   (-> (map->Website {})))
127 | 


--------------------------------------------------------------------------------