How to implement 10k connections echo server in Clojure?
clojure.contrib.server-socket is not the answer since it crates a new OS thread for every connection.
The great thing about Clojure is you have all these great libraries out there for the JVM like netty, which are highly optimized, configurable, and well thought out. Something like this should get you going:
(ns netty
(:gen-class)
(:import
[java.net InetSocketAddress]
[java.util.concurrent Executors]
[org.jboss.netty.bootstrap ServerBootstrap]
[org.jboss.netty.channel Channels ChannelPipelineFactory
SimpleChannelHandler]
[org.jboss.netty.channel.socket.nio NioServerSocketChannelFactory]
[org.jboss.netty.buffer ChannelBuffers]))
(declare make-handler)
(defn start
"Start a Netty server. Returns the pipeline."
[port handler]
(let [channel-factory (NioServerSocketChannelFactory.
(Executors/newCachedThreadPool)
(Executors/newCachedThreadPool))
bootstrap (ServerBootstrap. channel-factory)
pipeline (.getPipeline bootstrap)]
(.addLast pipeline "handler" (make-handler))
(.setOption bootstrap "child.tcpNoDelay", true)
(.setOption bootstrap "child.keepAlive", true)
(.bind bootstrap (InetSocketAddress. port))
pipeline))
(defn make-handler
"Returns a Netty handler."
[]
(proxy [SimpleChannelHandler] []
(channelConnected [ctx e]
(let [c (.getChannel e)]
(println "Connected:" c)))
(channelDisconnected [ctx e]
(let [c (.getChannel e)]
(println "Disconnected:" c)))
(messageReceived [ctx e]
(let [c (.getChannel e)
cb (.getMessage e)
msg (.toString cb "UTF-8")]
(println "Message:" msg "from" c)))
(exceptionCaught
[ctx e]
(let [throwable (.getCause e)]
(println "#exceptionCaught" throwable))
(-> e .getChannel .close))))
Related
Does Clojure have an equivalent of Java's try-with-resources construct?
If not, what is the normal way to handle this idiom in Clojure code?
The pre-Java-7 idiom for safely opening and closing resources is verbose enough that they actually added support for try-with-resources to the language. It seems strange to me that I can't find a macro for this use case in the standard Clojure library.
An example to a mainstream Clojure-based project repository—showing how this issue is handled in practice—would be very helpful.
You can use with-open to bind a resource to a symbol and make sure the resource is closed once the control flow left the block.
The following example is from clojuredocs.
(with-open [r (clojure.java.io/input-stream "myfile.txt")]
(loop [c (.read r)]
(when (not= c -1)
(print (char c))
(recur (.read r)))))
This will be expanded to the following:
(let [r (clojure.java.io/input-stream "myfile.txt")]
(try
(loop [c (.read r)]
(when (not= c -1)
(print (char c))
(recur (.read r))))
(finally (.close r))))
You can see that a let block is created with a try-finally to the call .close() method.
you can do something more close to java, making up some macro on top of with-open. It could look like this:
(defmacro with-open+ [[var-name resource & clauses] & body]
(if (seq clauses)
`(try (with-open [~var-name ~resource] ~#body)
~#clauses)
`(with-open [~var-name ~resource] ~#body)))
so you can pass additional clauses alongside the binding.
(with-open+ [x 111]
(println "body"))
expands to simple with-open:
(let*
[x 111]
(try (do (println "body")) (finally (. x clojure.core/close))))
while additional clauses lead to wrapping the it in try-catch:
(with-open+ [x 111
(catch RuntimeException ex (println ex))
(finally (println "finally!"))]
(println "body"))
expands to
(try
(let*
[x 111]
(try (do (println "body")) (finally (. x clojure.core/close))))
(catch RuntimeException ex (println ex))
(finally (println "finally!")))
But still it is quite an opinionated solution.
What's best way in clojure to implement something like an actor or agent (asynchronously updated, uncoordinated reference) that does the following?
gets sent messages/data
executes some function on that data to obtain new state; something like (fn [state new-msgs] ...)
continues to receive messages/data during that update
once done with that update, runs the same update function against all messages that have been sent in the interim
An agent doesn't seem quite right here. One must simultaneously send function and data to agents, which doesn't leave room for a function which operates on all data that has come in during the last update. The goal implicitly requires a decoupling of function and data.
The actor model seems generally better suited in that there is a decoupling of function and data. However, all actor frameworks I'm aware of seem to assume each message sent will be processed separately. It's not clear how one would turn this on it's head without adding extra machinery. I know Pulsar's actors accept a :lifecycle-handle function which can be used to make actors do "special tricks" but there isn't a lot of documentation around this so it's unclear whether the functionality would be helpful.
I do have a solution to this problem using agents, core.async channels, and watch functions, but it's a bit messy, and I'm hoping there is a better solution. I'll post it as a solution in case others find it helpful, but I'd like to see what other's come up with.
Here's the solution I came up with using agents, core.async channels, and watch functions. Again, it's a bit messy, but it does what I need it to for now. Here it is, in broad strokes:
(require '[clojure.core.async :as async :refer [>!! <!! >! <! chan go]])
; We'll call this thing a queued-agent
(defprotocol IQueuedAgent
(enqueue [this message])
(ping [this]))
(defrecord QueuedAgent [agent queue]
IQueuedAgent
(enqueue [_ message]
(go (>! queue message)))
(ping [_]
(send agent identity)))
; Need a function for draining a core async channel of all messages
(defn drain! [c]
(let [cc (chan 1)]
(go (>! cc ::queue-empty))
(letfn
; This fn does all the hard work, but closes over cc to avoid reconstruction
[(drainer! [c]
(let [[v _] (<!! (go (async/alts! [c cc] :priority true)))]
(if (= v ::queue-empty)
(lazy-seq [])
(lazy-seq (cons v (drainer! c))))))]
(drainer! c))))
; Constructor function
(defn queued-agent [& {:keys [buffer update-fn init-fn error-handler-builder] :or {:buffer 100}}]
(let [q (chan buffer)
a (agent (if init-fn (init-fn) {}))
error-handler-fn (error-handler-builder q a)]
; Set up the queue, and watcher which runs the update function when there is new data
(add-watch
a
:update-conv
(fn [k r o n]
(let [queued (drain! q)]
(when-not (empty? queued)
(send a update-fn queued error-handler-fn)))))
(QueuedAgent. a q)))
; Now we can use these like this
(def a (queued-agent
:init-fn (fn [] {:some "initial value"})
:update-fn (fn [a queued-data error-handler-fn]
(println "Receiving data" queued-data)
; Simulate some work/load on data
(Thread/sleep 2000)
(println "Done with work; ready to queue more up!"))
; This is a little warty at the moment, but closing over the queue and agent lets you requeue work on
; failure so you can try again.
:error-handler-builder
(fn [q a] (println "do something with errors"))))
(defn -main []
(doseq [i (range 10)]
(enqueue a (str "data" i))
(Thread/sleep 500) ; simulate things happening
; This part stinks... have to manually let the queued agent know that we've queued some things up for it
(ping a)))
As you'll notice, having to ping the queued-agent here every time new data is added is pretty warty. It definitely feels like things are being twisted out of typical usage.
Agents are the inverse of what you want here - they are a value that gets sent updating functions. This easiest with a queue and a Thread. For convenience I am using future to construct the thread.
user> (def q (java.util.concurrent.LinkedBlockingDeque.))
#'user/q
user> (defn accumulate
[summary input]
(let [{vowels true consonents false}
(group-by #(contains? (set "aeiouAEIOU") %) input)]
(-> summary
(update-in [:vowels] + (count vowels))
(update-in [:consonents] + (count consonents)))))
#'user/accumulate
user> (def worker
(future (loop [summary {:vowels 0 :consonents 0} in-string (.take q)]
(if (not in-string)
summary
(recur (accumulate summary in-string)
(.take q))))))
#'user/worker
user> (.add q "hello")
true
user> (.add q "goodbye")
true
user> (.add q false)
true
user> #worker
{:vowels 5, :consonents 7}
I came up with something closer to an actor, inspired by Tim Baldridge's cast on actors (Episode 16). I think this addresses the problem much more cleanly.
(defmacro take-all! [c]
`(loop [acc# []]
(let [[v# ~c] (alts! [~c] :default nil)]
(if (not= ~c :default)
(recur (conj acc# v#))
acc#))))
(defn eager-actor [f]
(let [msgbox (chan 1024)]
(go (loop [f f]
(let [first-msg (<! msgbox) ; do this so we park efficiently, and only
; run when there are actually messages
msgs (take-all! msgbox)
msgs (concat [first-msg] msgs)]
(recur (f msgs)))))
msgbox))
(let [a (eager-actor (fn f [ms]
(Thread/sleep 1000) ; simulate work
(println "doing something with" ms)
f))]
(doseq [i (range 20)]
(Thread/sleep 300)
(put! a i)))
;; =>
;; doing something with (0)
;; doing something with (1 2 3)
;; doing something with (4 5 6)
;; doing something with (7 8 9 10)
;; doing something with (11 12 13)
I have a Ring handler which uses several functions to build the response. If any of these functions throw an exception, it should be caught so a custom response body can be written before returning a 500.
I'm writing the unit test for the handler, and I want to ensure that an exception thrown by any of these functions will be handled as described above. My instinct was to use with-redefs inside a doseq:
(doseq [f [ns1/fn1 ns1/fn2 ns2/fn1]]
(with-redefs [f (fn [& args] (throw (RuntimeException. "fail!"))]
(let [resp (app (request :get "/foo")))))]
(is (= (:status resp) 500))
(is (= (:body resp) "Something went wrong")))))
Of course, given that with-redefs wants to change the root bindings of vars, it is treating f as a symbol. Is there any way to get it to rebind the var referred to by f? I suspect that I'm going to need a macro to accomplish this, but I'm hoping that someone can come up with a clever solution.
with-redefs is just sugar over repeated calls to alter-var-root, so you can just write the desugared form yourself, something like:
(doseq [v [#'ns1/fn1 #'ns1/fn2 #'ns2/fn1]]
(let [old #v]
(try
(alter-var-root v (constantly (fn [& args]
(throw (RuntimeException. "fail!")))))
(let [resp (app (request :get "/foo")))
(is (= (:status resp) 500))
(is (= (:body resp) "Something went wrong")))
(finally (alter-var-root v (constantly old))))))
Following on from amalloy's great answer, here's a utility function that I wrote to use in my tests:
(defn with-mocks
"Iterates through a list of functions to-mock, rebinding each to mock-fn, and calls
test-fn with the optional test-args.
Example:
(defn foobar [a b]
(try (+ (foo a) (bar b))
(catch Exception _ 1)))
(deftest test-foobar
(testing \"Exceptions are handled\"
(with-mocks
[#'foo #'bar]
(fn [& _] (throw (RuntimeException. \"\")))
(fn [a b] (is (= 1 (foobar a b)))) 1 2)))"
[to-mock mock-fn test-fn & test-args]
(doseq [f to-mock]
(let [real-fn #f]
(try
(alter-var-root f (constantly mock-fn))
(apply test-fn test-args)
(finally
(alter-var-root f (constantly real-fn)))))))
I have a situation where I am creating and destroying objects in one clojure namespace, and want another namespace to co-ordinate. However I do not want the first namespace to have to call the second explicitly on object destruction.
In Java, I could use a listener. Unfortunately the underlying java libraries do not signal events on object destruction. If I were in Emacs-Lisp, then I'd use hooks which do the trick.
Now, in clojure I am not so sure. I have found the Robert Hooke library https://github.com/technomancy/robert-hooke. But this is more like defadvice in elisp terms -- I am composing functions. More over the documentation says:
"Hooks are meant to extend functions you don't control; if you own the target function there are obviously better ways to change its behaviour."
Sadly, I am not finding it so obvious.
Another possibility would be to use add-watch, but this is marked as alpha.
Am I missing another obvious solution?
Example Added:
So First namespace....
(ns scratch-clj.first
(:require [scratch-clj.another]))
(def listf (ref ()))
(defn add-object []
(dosync
(ref-set listf (conj
#listf (Object.))))
(println listf))
(defn remove-object []
(scratch-clj.another/do-something-useful (first #listf))
(dosync
(ref-set listf (rest #listf)))
(println listf))
(add-object)
(remove-object)
Second namespace
(ns scratch-clj.another)
(defn do-something-useful [object]
(println "object removed is:" object))
The problem here is that scratch-clj.first has to require another and explicitly push removal events across. This is a bit clunky, but also doesn't work if I had "yet-another" namespace, which also wanted to listen.
Hence I thought of hooking the first function.
Is this solution suitable to your requirements?
scratch-clj.first:
(ns scratch-clj.first)
(def listf (atom []))
(def destroy-listeners (atom []))
(def add-listeners (atom []))
(defn add-destroy-listener [f]
(swap! destroy-listeners conj f))
(defn add-add-listener [f]
(swap! add-listeners conj f))
(defn add-object []
(let [o (Object.)]
(doseq [f #add-listeners] (f o))
(swap! listf conj o)
(println #listf)))
(defn remove-object []
(doseq [f #destroy-listeners] (f (first #listf)))
(swap! listf rest)
(println #listf))
Some listeners:
(ns scratch-clj.another
(:require [scratch-clj.first :as fst]))
(defn do-something-useful-on-remove [object]
(println "object removed is:" object))
(defn do-something-useful-on-add [object]
(println "object added is:" object))
Init binds:
(ns scratch-clj.testit
(require [scratch-clj.another :as another]
[scratch-clj.first :as fst]))
(defn add-listeners []
(fst/add-destroy-listener another/do-something-useful-on-remove)
(fst/add-add-listener another/do-something-useful-on-add))
(defn test-it []
(add-listeners)
(fst/add-object)
(fst/remove-object))
test:
(test-it)
=> object added is: #<Object java.lang.Object#c7aaef>
[#<Object java.lang.Object#c7aaef>]
object removed is: #<Object java.lang.Object#c7aaef>
()
It sounds a lot like what you're describing is callbacks.
Something like:
(defn make-object
[destructor-fn]
{:destructor destructor-fn :other-data "data"})
(defn destroy-object
[obj]
((:destructor obj) obj))
; somewhere at the calling code...
user> (defn my-callback [o] (pr [:destroying o]))
#'user/my-callback
user> (destroy-object (make-object my-callback))
[:destroying {:destructor #<user$my_callback user$my_callback#73b8cdd5>, :other-data "data"}]
nil
user>
So, here is my final solution following mobytes suggestion. A bit more work, but
I suspect that I will want this in future.
Thanks for all the help
;; hook system
(defn make-hook []
(atom []))
(defn add-hook [hook func]
(do
(when-not
(some #{func} #hook)
(swap! hook conj func))
#hook))
(defn remove-hook [hook func]
(swap! hook
(partial
remove #{func})))
(defn clear-hook [hook]
(reset! hook []))
(defn run-hook
([hook]
(doseq [func #hook] (func)))
([hook & rest]
(doseq [func #hook] (apply func rest))))
(defn phils-hook []
(println "Phils hook"))
(defn phils-hook2 []
(println "Phils hook2"))
(def test-hook (make-hook))
(add-hook test-hook phils-hook)
(add-hook test-hook phils-hook2)
(run-hook test-hook)
(remove-hook test-hook phils-hook)
(run-hook test-hook)
I'm using agents to manipulate a structure, but I don't have all my side effects.
All the messages are sent(I've printed and counted them), but there are times when I don't have all my side-effects. As if not all of my functions were applied on the agent's state, or if the last send is applied on a previous state..
I experimented with doall, dorun but haven't find a solution, appreciate any help.
;; aux function for adding an element to a hashmap
(defn extend-regs [reg s o]
(let [os (get reg s)]
(if (nil? os)
(assoc reg s [o])
(assoc reg s (conj os o)))))
;; the agent's altering function - adding an element to the :regs field(a hashmap)
(defn add-reg! [d s o]
(send d (fn [a] (assoc a :regs (extend-regs (:regs a) s o)))))
;; Creating the agents, dct/init returns an agent
;; pds: data for fields
(defn pdcts->init-dcts! [pds]
(doall (map dct/init (map :nam pds) (repeat nil))))
;; Altering one agent's state, dct/add-reg sends an assoc message to the agent
;; d: agent, pd: data for fields
(defn dct->add-regs! [d pd]
(dorun (map (fn [s r] (dct/add-reg! d s r))
(:syms pd)
(:regs pd)))
d)
;; Going through all agents
;; ds: agents, pds: datas
(defn dcts->add-regs! [ds pds]
(dorun (map (fn [d pd] (dct->add-regs! d pd))
ds
pds))
ds)
EDIT: =====================================================
Okay it turned out I just haven't wait enough to my threads to finish their tasks. Now the question is how can I monitor my agents. How can I know that there are unfinished threads in the queue? I've only found swank.core/active-threads and similar ones but they are not a solution.
I do not have a solution for your problem, but I can't resist suggesting some improvement on the first two functions:
(defn extend-regs [reg s o]
(let [os (get reg s)]
(if (nil? os)
(assoc reg s [o])
(assoc reg s (conj os o)))))
;; => place the 'if inside the assoc:
(defn extend-regs [reg s o]
(let [os (get reg s)]
(assoc reg s (if (nil? os) [o] (conj os o)))))
;; => this (if (nil? x) ...) is the pattern of function fnil, so ...
(defn extend-regs [reg s o]
(let [os (get reg s)]
(assoc reg s ((fnil conj []) os o))))
;; with update-in, this will be even clearer, and we can remove the let altogether:
(defn extend-regs [reg s o]
(update-in reg [s] (fnil conj []) o))
As for the second:
(defn add-reg! [d s o]
(send d (fn [a] (assoc a :regs (extend-regs (:regs a) s o)))))
;; => We can, again, use update-in instead of assoc:
(defn add-reg! [d s o]
(send d (fn [a] (update-in a [:regs] extend-regs s o))))
;; or, if you can get rid of extend-regs:
(defn add-reg! [d s o]
(send d (fn [a] (update-in a [:regs s] (fnil conj []) o)))
Finally, as a matter of style, I would place add-reg in a separate function, and directly use the idiom of sending to the agent in the client code (or have a simplified add-reg! function):
(defn add-reg [v s o] (update-in v [:regs s] (fnil conj []) o))
(defn add-reg! [d s o] (send d add-reg))
I know this doesn't answer your initial question, but it was fun to write this step by step refactoring
Use await or await-for to wait until an agent finished it's current work queue:
(await agent1 agent2 agent3)
or
(apply await list-of-agents)
A minor improvement of add-reg:
(defn extend-regs [reg s o]
(update-in reg [s] conj o))
This works because of
(conj nil :b) ; => [:b]
thus
(update-in {} [:a] conj :b) ; => {:a [:b]}
finally we have.
(defn add-reg! [d s o]
(send d update-in s [:regs] conj o)