Ring: Bringing it All Back Home

;; Bringing the session data back onto the server where we can play with it

;;  necessary dependencies
;; [[org.clojure/clojure "1.4.0"]
;;  [ring/ring "1.1.7"]]
;; -------------

;; Here's our moral maze app, reduced to its bare essentials, keeping
;; all its data in cookies on the user's browser:

(require 'ring.adapter.jetty
         'ring.middleware.stacktrace
         'ring.middleware.session.cookie
         'ring.middleware.session
         'clojure.pprint)

;; middleware for spying on request maps

(defn html-escape [string]
  (clojure.string/escape string {\< "&lt;", \" "&quot;", \& "&amp;", \> "&gt;"}))

(defn html-pre-escape [string]
  (str "<pre>" (html-escape string) "</pre>"))

(defn format-request [name request kill-keys kill-headers]
  (let [r1 (reduce dissoc request kill-keys)
        r (reduce (fn [h n] (update-in h [:headers] dissoc n)) r1 kill-headers)]
  (with-out-str
    (println "-------------------------------")
    (println name)
    (println "-------------------------------")
    (clojure.pprint/pprint r)
    (println "-------------------------------"))))

(def kill-keys [:body :request-method :character-encoding :remote-addr :server-name :server-port :ssl-client-cert :scheme  :content-type  :content-length])
(def kill-headers ["user-agent" "accept" "accept-encoding" "accept-language" "accept-charset" "connection" "host"])

(defn wrap-spy [handler spyname]
  (fn [request]
    (let [incoming (format-request (str spyname " (request):") request kill-keys kill-headers)]
      (println incoming)
      (let [response (handler request)]
        (let [outgoing (format-request (str spyname " (response):") response kill-keys kill-headers)]
          (println outgoing)
          (if (= (type (response :body)) java.lang.String)
                     (update-in response  [:body] (fn[x] (str (html-pre-escape incoming) x  (html-pre-escape outgoing))))
                     response))))))

;; response map makers

(defn status-response [code body]
  {:status code
   :headers {"Content-Type" "text/html"}
   :body body})

(def response (partial status-response 200))

;; functions for outputting strings as html without causing bad things to happen
(defn hppp[x]  (html-pre-escape (with-out-str (binding [clojure.pprint/*print-right-margin* 120] (clojure.pprint/pprint x)))))
(defn hpp[x]  (html-pre-escape (str x)))
(defn hp[x]   (html-escape (str x)))

;; plumbing

(declare handler)

(def app
  (-> #'handler
      (ring.middleware.stacktrace/wrap-stacktrace)
      (wrap-spy "handler" )
      (ring.middleware.session/wrap-session {:store (ring.middleware.session.cookie/cookie-store {:key "a 16-byte secret"})})
      ;(wrap-spy "what the server sees" )
      (ring.middleware.stacktrace/wrap-stacktrace)))

(defonce server (ring.adapter.jetty/run-jetty #'app {:port 8080 :join? false}))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Finally here is the app itself, reduced, I hope, to the absolute essentials

(defn good [request]
  (assoc (response "<h1>good</h1> <a href=\"/\">choose again</a>" )
    :session (update-in (request :session) [:good] (fnil inc 0))))

(defn evil [request]
  (assoc (response "<h1>evil</h1> <a href=\"/\">choose again</a>" )
    :session (update-in (request :session) [:evil] (fnil inc 0))))

(defn home [request]
  (let
      [good   (get-in request [:session :good] 0)
       evil   (get-in request [:session :evil] 0)]
    (response (str "<h1>The Moral Maze</h1>"
                   "Good " good " : Evil " evil
                   "<p> What do you choose: "
                   "<a href=\"/good\">good</a> or <a href=\"/evil\">evil</a>?"))))

(defn handler [request]
  (case (request :uri)
    "/" (home request)
    "/good" (good request)
    "/evil" (evil request)
    (status-response 404 (str "<h1>404 Not Found: " (:uri request) "</h1>" ))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; I keep adding pages, and I get annoyed with having to copy and
;; paste the handler all the time, so thank you to Nikita Beloglazov
;; who told me how to write this replacement:

(defmacro routefn [& addresses]
  `(fn[~'request]
     (case (~'request :uri)
       ~@(mapcat (fn[x] [(str "/" x) (list x 'request)]) addresses)
       "/" (home ~'request)
       (status-response 404 (str "<h1>404 Not Found: " (:uri ~'request) "</h1>" )))))

(def handler (routefn good evil))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; After a bit of worrying, I am very keen on this structure.

;; Consider how easy it is to test: We don't need to involve a real
;; webserver or real state at all, we can just test that the handlers
;; do what they're supposed to do when sent appropriate data:

;; Does a root page exist?
((handler {:uri "/"}) :status) ; -> 200

;; Does looking at the evil page add an evil counter to your session?
((handler {:uri "/evil" :session {:mysesh 'yo}}) :session) ; -> {:evil 1, :mysesh yo}

;; We can define a function which passes a session through a url as if
;; it had been passed in from a browser, processed, and then sent back
;; to be stored in the browser:
(defn sprocess [session uri]
  (let [ns (:session (handler{:uri uri :session session}))]
    (if (nil? ns) session ns)))


;; So here is what happens when a completely unknown browser asks for the home page
(sprocess {} "/home") ;-> {}
;; And if it looks at the evil page:
(sprocess {} "/evil") ;-> {:evil 1}
;; And if it looks at it again:
(sprocess {:evil 1} "/evil") ;{:evil 2}

;; More concisely, we can change those two looks together
(sprocess (sprocess {} "/evil") "/evil") ;-> {:evil 2}

;; And use the -> macro to make it more readable
(-> {}
    (sprocess "/home")
    (sprocess "/good")
    (sprocess "/evil")
    (sprocess "/good")) ;-> {:evil 1, :good 2}

;; Modifying an accumulator using a sequence of things is a common pattern:
(reduce sprocess {} ["/evil" "/evil" "/good" "/evil" ]) ;-> {:good 1, :evil 3}


;; So our tests for the moral maze website might look something like this:
(use 'clojure.test)

(deftest sitetest
  (testing "page status"
    (is (= (map (fn[x] ((handler {:uri x}) :status)) ["/" "/good" "/evil" ]) '(200 200 200)))
    (is (= (map (fn[x] ((handler {:uri x}) :status)) ["/home" "/favicon.ico" ]) '(404 404))))
  (testing "html"
    (is (re-find #"Good\W*0\W:\WEvil\W0" ((handler {:uri "/"}) :body)))
    (is (re-find #"Good\W*10\W:\WEvil\W0" ((handler {:uri "/" :session {:good 10}}) :body)))
    (is (re-find #"Good\W*10\W:\WEvil\W20" ((handler {:uri "/" :session {:good 10 :evil 20}}) :body))))
  (testing "session"
    (is (= 21 (((handler {:uri "/evil" :session {:good 10 :evil 20}}) :session) :evil)))
    (is (= 10 (((handler {:uri "/evil" :session {:good 10 :evil 20}}) :session) :good)))
    (is (= (reduce sprocess {:userid "fred" :good 2}
                   ["/evil" "/good" "/" "/home" "/evil" "/favicon.ico" "/evil" "/evil"])
           {:good 3, :evil 4, :userid "fred"}))))




;; They can be hand-run with:
;; (run-tests)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; A major advantage of this design is also a major problem with
;; it. All the data is stored in the user's browser in a cookie.

;; This means we can't do statistics on the data, because we don't
;; have it all available at once.

;; But it turns out to be quite easy to bring the data back onto the
;; server where we can see it, because we can use in-memory sessions
;; instead of cookie sessions, and we can also tell ring where to keep
;; them:

(defonce db (atom {}))

(def app
  (-> #'handler
      (ring.middleware.stacktrace/wrap-stacktrace)
      (wrap-spy "handler" )
      (ring.middleware.session/wrap-session {:store (ring.middleware.session.memory/memory-store db)})
      ;(wrap-spy "what the server sees" )
      (ring.middleware.stacktrace/wrap-stacktrace)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Let's make a page where we can see our data:

(defn database [request]
  (response
   (str "<h1>Database</h1>"
          "<pre>" "(swap! db (fn[x] (merge x " (hppp @db) ")))" "</pre>")))

(def handler (routefn good evil database))


;; Of course, now we've lost some of the advantages of the cookie
;; backed sessions.  A server restart will kill all our data, and we
;; can't any longer run many servers in parallel.

;; I'm hoping that it might be possible to move this data into a
;; database at some point to cure these problems.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; But now that our data *is* on the server, we can do our statistics:

(defn highscores [request]
  (let [score (fn[[k v]]
                (let [e (v :evil 0)
                      g (v :good 0)
                      r (if (zero? (+ e g)) 1/2 (/ e (+ e g)))]
                  [ r k g e]))
        hst (sort (map score @db))]
    (response (str
               "<h1>High Score Table</h1>"
             "<table>"
             (str "<tr>""<th>" "User ID"  "<th/>""<th>" "Chose Good" "<th/>""<th>" "Chose Evil" "<th/>" "</tr>")
             (apply str (for [i hst] (str "<tr>""<td>" (i 1)  "<td/>""<td>"  (i 2) "<td/>""<td>" (i 3) "<td/>" "</tr>")))
             "</table>"
             ))))


(def handler (routefn good evil database highscores))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; The user ids are a bit distracting, so let's give our users the
;; chance to choose names of their own:

;; For this we'll need the parameter handling middleware
(use 'ring.middleware.params)

(def app
  (-> #'handler
      (ring.middleware.stacktrace/wrap-stacktrace)
      (wrap-spy "handler" )
      (ring.middleware.params/wrap-params)
      (ring.middleware.session/wrap-session {:store (ring.middleware.session.memory/memory-store db)})
      ;(wrap-spy "what the server sees" )
      (ring.middleware.stacktrace/wrap-stacktrace)))


(defn home [request]
  (let
      [good   (get-in request [:session :good] 0)
       evil   (get-in request [:session :evil] 0)
       name   (get-in request [:session :name] "one who wishes anonymity")]
    (response (str "<h1>The Moral Maze</h1>"
                   "<p>Welcomes: <b>" name "</b>"
                   " (<a href=\"/namechange\">change</a>)"
                   "<p>Good " good " : Evil " evil
                   "<p> What do you choose: "
                   "<a href=\"/good\">good</a> or <a href=\"/evil\">evil</a>?"
                   "<p><hr/><a href=\"/database\">database</a> or <a href=\"/highscores\">high scores</a>"))))

(defn namechange [request]
  (response (str "<form name=\"form\" method=\"post\" action=\"/change-my-name\">"
                 "<input name=\"newname\" value=\"" ((request :session) :name "type name here") "\">")))

(defn change-my-name [request]
  (let [newname ((request :params) "newname")]
    (assoc (response (str "ok " newname "<p><a href=\"/\">back</a>"))
      :session (assoc (request :session) :name newname))))

(def handler (routefn good evil database highscores namechange change-my-name))

;; Now we can put the user's chosen names in the table instead

(defn highscores [request]
  (let [score (fn[[k v]]
                (let [e (v :evil 0)
                      g (v :good 0)
                      n (v :name "anon")
                      r (if (zero? (+ e g)) 1/2 (/ e (+ e g)))]
                  [ r n g e k]))
        hst (sort (map score @db))]
    (response (str
               "<h1>High Score Table</h1>"
             "<table border=1 frame=box rules=rows>"
             (str "<tr>""<th>" "Name"  "<th/>""<th>" "Chose Good" "<th/>""<th>" "Chose Evil" "<th/>" "</tr>")
             (apply str (for [i hst] (str "<tr>""<td>" (hp (i 1))  "<td/>""<td>"  (hp (i 2)) "<td/>""<td>" (hp (i 3)) "<td/>" "</tr>")))
             "</table>"
             ))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; One remaining problem that we have is that a user's identity is tied to his browser cookie.

;; If someone deletes their cookies, their account can never again be accessed.

;; If they use a different browser, then they will create a second independent account.

;; Well, this feels like a really nasty hack, but it's easy enough to
;; reassociate their browser with a different session:

(defn change-my-identity [request]
  (let [newid ((request :params) "newidentity")]
    (if-let [newsessioncookie (ffirst (filter (fn[[k v]] (=  (v :name) newid)) @db))]
        (assoc (response (str "if you say so...<i>" newid "</i><p><a href=\"/\">home</a>"))
          :cookies {"ring-session" {:value newsessioncookie}})
        (response "<span style=\"color:red\"><b><i>I think not!</i></b></span>"))))


(defn changeidentity [request]
  (response (str "<form name=\"form\" method=\"post\" action=\"/change-my-identity\">"
                 "If you ain't " ((request :session) :name "dat geezer") " den who <i>are</i> you? :"
                 "<input name=\"newidentity\" value=\"" ((request :session) :name "type name here") "\">")))




(defn home [request]
  (let
      [good   (get-in request [:session :good] 0)
       evil   (get-in request [:session :evil] 0)
       name   (get-in request [:session :name] "one who wishes anonymity")]
    (response (str "<h1>The Moral Maze</h1>"
                   "<p>Welcomes: <b>" name "</b>"
                   " (<a href=\"/namechange\">change</a>)"
                   "<p> (<a href=\"/changeidentity\">not " name  "? log in as someone else.</a>)"
                   "<p>Good " good " : Evil " evil
                   "<p> What do you choose: "
                   "<a href=\"/good\">good</a> or <a href=\"/evil\">evil</a>?"
                   "<p><hr/><a href=\"/database\">database</a> or <a href=\"/highscores\">high scores</a>"))))


(def handler (routefn good evil database highscores namechange change-my-identity change-my-name changeidentity))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Finally we need to protect the valuable data in our accounts with passwords

;; We change the name-change pages to ask for passwords too

(defn change-my-name [request]
  (let [newname ((request :params) "newname")
        newpassword ((request :params) "password")]
    (if (and newname newpassword)
      (assoc
          (response (str "ok " newname "<p><a href=\"/\">back</a>"))
        :session (assoc (request :session) :name newname :password newpassword))
      (response "fail"))))

(defn namechange [request]
  (response (str "<form name=\"form\" method=\"post\" action=\"/change-my-name\">"
                 "Name: <input name=\"newname\" value=\"" ((request :session) :name "type name here") "\">"
                 "<p>Password: <input name=\"password\" value=\"" ((request :session) :password "f@ilz0r!") "\">"
                 "<input type=\"submit\" value=\"Click!\" />"
                 "</form>")))

;; And the identity-changing pages to check

(defn changeidentity [request]
  (response (str "<form name=\"form\" method=\"post\" action=\"/change-my-identity\">"
                 "If you ain't " ((request :session) :name "dat geezer") " den who <i>are</i> you? :<p>"
                 "Name    : <input name=\"newidentity\" value=\"" ((request :session) :name "type name here") "\">"
                 "Password: <input name=\"password\" value=\"\">"
                 "<input type=\"submit\" value=\"Click!\" />"
                 "</form>")))


(defn change-my-identity [request]
  (let [newid ((request :params) "newidentity")
        password ((request :params) "password")]
    (if-let [newsessioncookie (ffirst (filter (fn[[k v]] (and (=  (v :name) newid) (= (v :password) password))) @db))]
        (assoc (response (str "if you say so...<i>" newid "</i><p><a href=\"/\">home</a>"))
          :cookies {"ring-session" {:value newsessioncookie}})
        (response "<span style=\"color:red\"><b><i>I think not!</i></b></span>"))))


;; When playing with this, I found it useful to add a separate password page which only an administrator can see

(defn passwords [request]
  (if ((request :session) :admin)
    (response (hppp (for [[ k {n :name p :password}] @db] [n p])))
    (response "no way!")))
  
(def handler
  (routefn good evil highscores
           database passwords
           namechange change-my-name
           changeidentity change-my-identity))

;; And an admin user who can see it

(swap! db (fn[x] (merge { "no session" {:name "admin" :password "pa55word" :admin true }})))

A Warm Welcome to Readers from China (你好世界)

;; A warm welcome to readers from China!

;; After many years when this blog's audience was strictly Empire and
;; Colonies only, I've recently noticed a vast number of hits from
;; China.

;; It turns out I'm on the front page if you search for Clojure on
;; baidu, which goes to show what a very fine search engine it is.

;; This blog is about my continuous process of learning Clojure. In it
;; I have conversations with my REPL about stuff I don't understand,
;; hoping to understand it by poking it with a stick and seeing what
;; happens.


;; I'm told that this is how to say hello world in Mandarin:
(defn 你好世界 []
  (print "你好世界"))

;; Clojure seems to deal well with this:
user> (你好世界)
你好世界
nil

;; Is this right? And how do I pronounce it?

Regular Expressions in Clojure

;; Regular Expressions in Clojure

;; Every time I want to use a regex in clojure I find myself having to
;; learn how to do it again.

;; for some reason the functions just won't stick in my mind.

;; There are six functions starting with re- in clojure.core:

(def d (with-out-str 
         (doc re-seq)
         (doc re-pattern)
         (doc re-find)
         (doc re-groups)
         (doc re-matcher)
         (doc re-matches)))

;; This is probably the function that you want:
(re-seq   #"f.nd" d) ;-> ("find" "find" "find" "find" "find")

;; re-pattern is for making regular expressions out of strings
(re-pattern "f.nd") ;-> #"f.nd"

;; But normally we'd just use the syntactic sugar #"f.nd" directly

;; The return type is dependent on the regex in a nasty way:

(re-seq   #"f..d" d)   ;-> ("find" "find" "find" "find" "find")
(re-seq   #"f(.)nd" d) ;-> (["find" "i"] ["find" "i"] ["find" "i"] ["find" "i"] ["find" "i"])

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; Here are some classic example regexes (ripped off from
;; http://myregexp.com/examples.html), because I can never remember
;; how the more complicated cases work:

;; Behold the non-capturing group (?:...), the alternation | , the
;; greedy 0 or 1 ?, the greedy 3 {3} and the word boundary \b:

(re-seq #"\b(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\b"
        "Here's an ip address:111.123.0.127, and here is another 136.54.23.108 
but this is not one 1.1.1.257 and neither is this: 243.1.231 or this 1.1.1.1.1 but is this?255.000.1.255")

;; Here we demonstrate the both the 'repeated capturing group' problem for MAC addresses
(re-seq #"^([0-9a-fA-F][0-9a-fA-F]:){5}([0-9a-fA-F][0-9a-fA-F])$"
        "AA:0a:be:23:01:02") ;-> (["AA:0a:be:23:01:02" "01:" "02"])

;; And a use case for re-pattern, together with the (?m) multiline flag
(re-seq (re-pattern (str "(?m)^" 
                         (clojure.string/join ":" (repeat 6 "([0-9a-fA-F][0-9a-fA-F])"))
                         "$"))
        "AA:0a:be:23:01:02\nAA:0a:be:123:01:02\nAG:0a:be:23:01:02\n00:01:02:03:04:55\nAA:0a:be:23:0:02:AA\n:0a:be:23:01:02\n")
;-> (["AA:0a:be:23:01:02" "AA" "0a" "be" "23" "01" "02"] 
;->  ["00:01:02:03:04:55" "00" "01" "02" "03" "04" "55"])


(re-seq #"\b(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\b"
        "Here's an ip address:111.123.0.127, and here is another 136.54.23.108 
but this is not one 1.1.1.257 and neither is this: 243.1.231 or this 1.1.1.1.1 but is this?255.000.1.255")


(re-seq #"\b([a-zA-Z0-9]([a-zA-Z0-9\-]{0,61}[a-zA-Z0-9])?\.)+[a-zA-Z]{2,6}\b"
"Amongst the worlds domain names are such as www.google.com, ssh.aspden.com,
 aspden.com, aspden.co.uk, 123.com, ssh.123.com and .com")








;; The other four functions in clojure seem to be to part of the implementation
;; of re-seq, and directly manipulate highly stateful
;; java.util.regex.Matcher objects

;; re-find, re-groups, re-matcher, and re-matches seem to be only
;; useful as part of re-seq, and I wonder if they should be
;; deprecated, or moved to a namespace that needs to be specifically
;; imported.

;; Although if you just want the first match then :
(re-find   #"f.nd" d)
;; seems to be an acceptable alternative to:
(first (re-seq #"f.nd" d))

Understanding Ring : A Web App that Keeps its Data in Memory

Here I modify the moral maze app to hand out user ids and store the user's actions in an in-memory database.

;;  necessary dependencies
;; [[org.clojure/clojure "1.4.0"]
;;  [ring/ring "1.1.6"]]
;; -------------

;; I've gone a bit beyond the ring wiki tutorials now. 

;; In case it's not obvious, I have no idea what I'm doing!  I'm
;; trying to work out what sort of structure a real webapp built on
;; ring should have, so I'm trying various approaches.

;; There are all sorts of helpful libraries and frameworks I could be
;; using, but I'm avoiding them deliberately because I think it's
;; important to understand what I'm doing. And if you can't write it,
;; you don't understand it.

;; If anyone's got any good links to 'what a web-app should look like
;; structurally' articles, then please let me know, or leave them in
;; the comments. I can't find anything like that, which is weird for
;; such a widespread problem, and that's one of the reasons why I'm
;; trying to write one. I don't mean particularly in Clojure, I just
;; mean at all.

;; In the previous articles, I made an app which kept all its state in
;; sessions. Those sessions could be put in a cookie backed store, so
;; that all a user's data is stored encrypted on a user's computer,
;; and that might be a nice solution for certain problems.

;; A problem with that is that the only time that the app can see
;; the user's data is when they communicate with the server.

;; So for instance, if the app wanted to know whether people who
;; started off good were likely to turn to evil in later life,
;; information which might well be very useful, it would have a devil
;; of a job to find out.

;; So now I'd like to make a similar app which stores data on the
;; server, and uses the sessions/cookies only to remember the identity
;; of the user of the browser.

;; Eventually I want to move that data into a database on the server,
;; but for now I'm going to keep it in server memory. Of course that
;; means that it will get lost when the server restarts, but one thing
;; at a time.

;; Clojure's memory model is already quite database-like, so
;; presumably it won't be that hard to move the data into a database
;; eventually.

;; To make it easier to think about, I'm going to simplify the problem
;; somewhat. The flash messages are just a distracting detail, and the
;; global counters are redundant if we have all the data in
;; memory. The redirects to the home page make it harder to understand
;; what's going on, so I'm going to remove them an replace them with
;; links back. I'm going to put the session data in a cookie-backed
;; session so that there's no session-related state in the server to
;; worry about.

;; So here's a simplified version of the already very simple character
;; test, which I'll then try to convert to a more centralised design.

(require 'ring.adapter.jetty
         'ring.middleware.stacktrace
         'ring.middleware.session.cookie
         'ring.middleware.session
         'clojure.pprint)

;; middleware for spying on request maps

(defn html-escape [string]
  (str "<pre>" (clojure.string/escape string {\< "&lt;", \> "&gt;"}) "</pre>"))

(defn format-request [name request kill-keys kill-headers]
  (let [r1 (reduce dissoc request kill-keys)
        r (reduce (fn [h n] (update-in h [:headers] dissoc n)) r1 kill-headers)]
  (with-out-str
    (println "-------------------------------")
    (println name)
    (println "-------------------------------")
    (clojure.pprint/pprint r)
    (println "-------------------------------"))))

(def kill-keys [:body :request-method :character-encoding :remote-addr :server-name :server-port :ssl-client-cert :scheme  :content-type  :content-length])
(def kill-headers ["user-agent" "accept" "accept-encoding" "accept-language" "accept-charset" "connection" "host"])

(defn wrap-spy [handler spyname]
  (fn [request]
    (let [incoming (format-request (str spyname ":\n Incoming Request:") request kill-keys kill-headers)]
      (println incoming)
      (let [response (handler request)]
        (let [outgoing (format-request (str spyname ":\n Outgoing Response Map:") response kill-keys kill-headers)]
          (println outgoing)
          (if (= (type (response :body)) java.lang.String)
                     (update-in response  [:body] (fn[x] (str (html-escape incoming) x  (html-escape outgoing))))
                     response))))))

;; response map makers

(defn status-response [code body]
  {:status code
   :headers {"Content-Type" "text/html"}
   :body body})

(def response (partial status-response 200))

;; plumbing

(declare handler)

(def app
  (-> #'handler
      (ring.middleware.stacktrace/wrap-stacktrace)
      (wrap-spy "what the handler sees" )
      (ring.middleware.session/wrap-session {:store (ring.middleware.session.cookie/cookie-store {:key "a 16-byte secret"})})
      (wrap-spy "what the server sees" )
      (ring.middleware.stacktrace/wrap-stacktrace)))

(defonce server (ring.adapter.jetty/run-jetty #'app {:port 8080 :join? false}))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Finally here is the app itself, reduced, I hope, to the absolute essentials

(defn good [request]
  (let [ good   (get-in request [:session :good] 0) ] 
    (assoc (response "<h1>good</h1> <a href=\"/\">choose again</a>" )
      :session (assoc (request :session) :good (inc good)))))

(defn evil [request]
  (let [ evil   (get-in request [:session :evil] 0) ]  
    (assoc (response "<h1>evil</h1> <a href=\"/\">choose again</a>" )
      :session (assoc (request :session) :evil (inc evil)))))

(defn home [request]
  (let
      [good   (get-in request [:session :good] 0)
       evil   (get-in request [:session :evil] 0)]
    (response (str "<h1>The Moral Maze</h1>"
                   "Good " good " : Evil " evil "<p>"
                   "What do you choose: "
                   "<a href=\"/good\">good</a> or <a href=\"/evil\">evil</a>?"))))

(defn handler [request]
  (case (request :uri)
    "/" (home request)
    "/good" (good request)
    "/evil" (evil request)
    (status-response 404 (str "<h1>404 Not Found: " (:uri request) "</h1>" ))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Now, if we get a request from someone we've never seen before, we
;; want to assign her an identity, something like anonymoususer1
;; If we generate random UUIDs then we should be safe from collisions

(defn getanon []
  (str "anonymoususer" (. java.util.UUID randomUUID )))

(defn subhandler [request]
  (case (request :uri)
    "/" (home request)
    "/good" (good request)
    "/evil" (evil request)
    (status-response 404 (str "<h1>404 Not Found: " (:uri request) "</h1>" ))))

(defn handler [request]
  (if-let [userid ((request :session) :_userid)]
    (do 
      (println "request from:" userid)
      (subhandler (assoc request :userid userid)))
    (let [userid (getanon)]
      (println "assigning new:" userid)
      (let [oldsession (request :session)]
        (let [response (subhandler (assoc request :userid userid))]
          (if-let [newsession (response :session)]
            (assoc response :session (assoc newsession :_userid userid))
            (assoc response :session (assoc oldsession :_userid userid))))))))


;; Let's greet our user

(defn home [request]
  (let
      [good   (get-in request [:session :good] 0)
       evil   (get-in request [:session :evil] 0)]
    (response (str "<h1>The Moral Maze</h1>"
                   "hello "(request :userid)"<p>"
                   "Good " good " : Evil " evil "<p>"
                   "What do you choose: "
                   "<a href=\"/good\">good</a> or <a href=\"/evil\">evil</a>?"))))


;; Everything should work the same as it did, but a new user is allocated a
;; unique identifier that lasts as long as she doesn't delete her
;; cookies.


;; That means that we can store the results of all her actions on the
;; server's "in-memory database", and stop messing around with the
;; browser's cookie.

(defonce results (atom []))

(defn good [request]
  (swap! results conj [(request :userid), :good])
  (response "<h1>good</h1> <a href=\"/\">choose again</a>" ))

(defn evil [request]
  (swap! results conj [(request :userid), :evil])
  (response "<h1>evil</h1> <a href=\"/\">choose again</a>" ))

(defn home [request]
  (let
      [ r (map second (filter #( = (first %) (request :userid))  @results))
        f (frequencies r)]
    (response (str "<h1>The Moral Maze</h1>"
                   "hello " (request :userid) "<p>"
                   "your choices:" (with-out-str (clojure.pprint/pprint r))
                   "<p>Good " (f :good 0) " : Evil " (f :evil 0) "<p>"
                   "What do you choose: "
                   "<a href=\"/good\">good</a> or <a href=\"/evil\">evil</a>?"))))

Maths Tuition (Cambridge STEP)

A plug for my friend Chris Metcalfe ( email chris@cambridgesteptuition.co.uk tel: 07752 532811)

If anyone has children (or is a child!) wanting to do maths in Cambridge then they'll need to pass the ferocious STEP examination.

A friend of mine is setting up as a private tutor for these specific exams, and is in the process of making a website.

Chris is a brilliant teacher, and is familiar with STEP both through having been an examiner for it for many years, and from having been on the sharp end of it when we were eighteen years old.

I recommend him absolutely unreservedly.

The new website's here http://www.cambridgesteptuition.co.uk, although at the moment it's just a plain page with contact details.

Chris has taught maths to bright students aspiring to Cambridge at Villiers Park for many years, and while there he produced some short videos and activity sheets to be used while teaching bright teenagers that despite being completely impossible to find are the site's most popular pages:

http://www.villierspark-online-extension-activities.org.uk/ActivityList.aspx?subject_id=13


I've resisted putting adverts on this blog for years, despite its rather surprising popularity, but I'm making an exception for this because Chris was clearly born to teach maths, and loves it, and I really hope that he makes a success of his new venture.

Please recommend him to all your friends. He really is as good as I'm trying to make him sound, and you really won't regret it!

Ring: Using Sessions in a Web Application

My first attempt to actually use sessions has left me feeling very uncomfortable.

Does anyone know what I'm supposed to do instead?

;;  necessary dependencies
;; [[org.clojure/clojure "1.4.0"]
;;  [ring/ring "1.1.6"]]
;; -------------

;; Here's an app, built in a way which should surprise no-one who's read the previous posts:

(require 'ring.adapter.jetty
         'ring.middleware.stacktrace
         'ring.middleware.session
         'clojure.pprint)

(defn html-escape [string]
  (str "<pre>" (clojure.string/escape string {\< "&lt;", \> "&gt;"}) "</pre>"))

(defn format-request [name request kill-keys kill-headers]
  (let [r1 (reduce dissoc request kill-keys)
        r (reduce (fn [h n] (update-in h [:headers] dissoc n)) r1 kill-headers)]
  (with-out-str
    (println "-------------------------------")
    (println name)
    (println "-------------------------------")
    (clojure.pprint/pprint r)
    (println "-------------------------------"))))


(def kill-keys [:body :request-method :character-encoding :remote-addr :server-name :server-port :ssl-client-cert :scheme  :content-type  :content-length])
(def kill-headers ["user-agent" "accept" "accept-encoding" "accept-language" "accept-charset" "connection" "host"])

(defn wrap-spy [handler spyname]
  (fn [request]
    (let [incoming (format-request (str spyname ":\n Incoming Request:") request kill-keys kill-headers)]
      (println incoming)
      (let [response (handler request)]
        (let [outgoing (format-request (str spyname ":\n Outgoing Response Map:") response kill-keys kill-headers)]
          (println outgoing)
          (update-in response  [:body] (fn[x] (str (html-escape incoming) x  (html-escape outgoing)))))))))



(declare handler)

(def app
  (-> #'handler
      (ring.middleware.stacktrace/wrap-stacktrace)
      (wrap-spy "what the handler sees" )
      (ring.middleware.session/wrap-session )
      (wrap-spy "what the web server sees" )
      (ring.middleware.stacktrace/wrap-stacktrace)
      ))

(defn handler [request]
  {:status 200
   :headers {"Content-Type" "text/html"}
   :body (let [s (request :session)]
           (if (empty? s) 
             (str "<h1>Hello World!</h1>" )
             (str "<h1>Your Session</h1><p>" s "</p>" )))
   :session "I am a session. Fear me."})

(defonce server (ring.adapter.jetty/run-jetty #'app {:port 8080 :join? false}))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Everything so far should be comprehensible.

;; Let's see if we can use the tools we have so far to build a little personality test


(defn status-response [code body]
  {:status code
   :headers {"Content-Type" "text/html"}
   :body body})

(def response (partial status-response 200))

(defn handler [request]
  (case (request :uri)
    "/" (response "<h1>The Moral Maze</h1>What do you choose: <a href=\"/good\">good</a> or <a href=\"/evil\">evil</a>?")
    "/good" (response "<h1>good</h1> <a href=\"/\">choose again</a>" )
    "/evil" (response "<h1>evil</h1> <a href=\"/\">choose again</a>")
    (status-response 404 (str "<h1>404 Not Found: " (:uri request) "</h1>" ))))



;; So far so good. 

;; Ring has an implementation of 'flash messages', which allows one page to send a message to another.

;; We need to plumb it in:

(require 'ring.middleware.flash)

(def app
  (-> #'handler
      (ring.middleware.stacktrace/wrap-stacktrace)
      (wrap-spy "what the handler sees" )
      (ring.middleware.flash/wrap-flash)
      (wrap-spy "what the flash middleware sees" )      
      (ring.middleware.session/wrap-session )
      (wrap-spy "what the web server sees" )
      (ring.middleware.stacktrace/wrap-stacktrace)))


(defn handler [request]
  (case (request :uri)
    "/" (response (str "<h1>The Moral Maze</h1>"
                       (if-let [f (request :flash)]
                         (str "You last chose " (if (= f :evil) "evil" "good") ".<p> What do you choose now:")
                         "What do you choose:")
                       "<a href=\"/good\">good</a> or <a href=\"/evil\">evil</a>?"))
    "/good" (assoc (response "<h1>good</h1> <a href=\"/\">choose again</a>" ) :flash :good)
    "/evil" (assoc (response "<h1>evil</h1> <a href=\"/\">choose again</a>" ) :flash :evil)
    (status-response 404 (str "<h1>404 Not Found: " (:uri request) "</h1>" ))))

;; This works fine in firefox, but the flash messages get lost in chrome because of its constant pestering
;; about favicon.ico. So we'd better make the flash messages persist in that case:

(defn handler [request]
  (case (request :uri)
    "/" (response (str "<h1>The Moral Maze</h1>"
                       (if-let [f (request :flash)]
                         (str "You last chose " (if (= f :evil) "evil" "good") ".<p> What do you choose now:")
                         "What do you choose:")
                       "<a href=\"/good\">good</a> or <a href=\"/evil\">evil</a>?"))
    "/good" (assoc (response "<h1>good</h1> <a href=\"/\">choose again</a>" ) :flash :good)
    "/evil" (assoc (response "<h1>evil</h1> <a href=\"/\">choose again</a>" ) :flash :evil)
    "/favicon.ico" {:flash (request :flash)}
    (status-response 404 (str "<h1>404 Not Found: " (:uri request) "</h1>" ))))



;; So far so good, but what if we want to keep scores for each user?

(defn home [request]
  (let
      [f         (request :flash)
       good   (get-in request [:session :good] 0)
       evil   (get-in request [:session :evil] 0)]
    (response (str "<h1>The Moral Maze</h1>"
                   "Good " good " : Evil " evil "<p>"
                   (if f
                     (str "You last chose " (if (= f :evil) "evil" "good") ".<p> What do you choose now:")
                     "What do you choose: ")
                   "<a href=\"/good\">good</a> or <a href=\"/evil\">evil</a>?"))))

(defn good [request]
  (let [ good   (get-in request [:session :good] 0) ]   
    (assoc (response "<h1>good</h1> <a href=\"/\">choose again</a>" ) 
      :flash :good 
      :session (assoc (request :session) :good (inc good)))))

(defn evil [request]
  (let [ evil   (get-in request [:session :evil] 0) ]   
    (assoc (response "<h1>evil</h1> <a href=\"/\">choose again</a>" ) 
      :flash :evil 
      :session (assoc (request :session) :evil (inc evil)))))

(defn handler [request]
  (case (request :uri)
    "/" (home request)
    "/good" (good request)
    "/evil" (evil request)
    "/favicon.ico" {:flash (request :flash)}
    (status-response 404 (str "<h1>404 Not Found: " (:uri request) "</h1>" ))))


;; Let's hide our workings and save the user from potential overclicking injuries

(require 'ring.util.response)

(defn good [request]
  (let [ good   (get-in request [:session :good] 0) ]   
    (assoc (ring.util.response/redirect "/")
      :flash :good 
      :session (assoc (request :session) :good (inc good)))))

(defn evil [request]
  (let [ evil   (get-in request [:session :evil] 0) ]   
    (assoc (ring.util.response/redirect "/")
      :flash :evil 
      :session (assoc (request :session) :evil (inc evil)))))

;; And then as a final flourish we'll keep total statistics as well

(def goodness (atom 0))
(def evilness (atom 0))

(defn good [request]
  (let [ good   (get-in request [:session :good] 0) ] 
    (swap! goodness inc)
    (assoc (ring.util.response/redirect "/")
      :flash :good 
      :session (assoc (request :session) :good (inc good)))))

(defn evil [request]
  (let [ evil   (get-in request [:session :evil] 0) ]  
    (swap! evilness inc)
    (assoc (ring.util.response/redirect "/")
      :flash :evil 
      :session (assoc (request :session) :evil (inc evil)))))

(defn home [request]
  (let
      [f         (request :flash)
       good   (get-in request [:session :good] 0)
       evil   (get-in request [:session :evil] 0)]
    (response (str "<h1>The Moral Maze</h1>"
                   "Good " good " : Evil " evil "<p>"
                   (if f
                     (str "You last chose " (if (= f :evil) "evil" "good") ".<p> What do you choose now:")
                     "What do you choose: ")
                   "<a href=\"/good\">good</a> or <a href=\"/evil\">evil</a>?"
                   "<p> Global Good: " (deref goodness) " Evil: " (deref evilness)))))


;; This all seems to work. But for some reason it makes me deeply uncomfortable.

;; I suppose I shouldn't really be using get requests to modify state,
;; and none of my data is going to survive a server restart, but I
;; don't think that's it.

;; There just seems to be something overcomplicated and fragile about
;; this, even though I don't seem to be able to break it.

;; Can anyone find a way of exposing the problem more clearly, or suggest a better way?