Compojure and SQLite Part 2

Continuing from the previous post, I added table inserts. In addition, I started adding some decorators to help avoid repeating code. Since there was some refactoring, many functions changed a lot.

Here's the top chunk:
(ns db-edit
(:require [clojure.contrib.sql :as sql])
(:use clojure.contrib.json.write)
(:use compojure))

; Information about the SQLite database
(def db-params {:classname "org.sqlite.JDBC"
:subprotocol "sqlite"
:subname "./database.sqlite"})

(def http-error-map
{400 {:name "Bad Request"
:long "The request could not be understood by the server due to malformed syntax."}
401 {:name "Unauthorized"
:long "The request requires user authentication."} ; Note WWW-Authenticate header should be added
404 {:name "Not Found"
:long "The server has not found anything matching the Request-URI."}})

(defn error [err]
(if-let [errMap (get http-error-map err)]
{:status err
:headers {}
:body (str "HTTP error " err ": " (get errMap :name) "\n" (get errMap :long))}
{:status err
:headers {}
:body (str "HTTP Error " err " encountered")}))

(defn sanitize-sql
"Cleans the string of nasty SQL related special chars"
[s]
(. s (replaceAll "/[\\s'\";#%]/" "")))

(defn cleanPath
"Sanitize the incoming string for '..'"
[p]
(.. p (replaceAll "/\\.+" "/") (replaceAll "/+" "/")))

(defn log [ level & rest ]
(if (== level :debug)
(. org.mortbay.log.Log info (str rest))
(if (== level :info)
(. org.mortbay.log.Log debug (str rest))
(. org.mortbay.log.Log warn (str rest)))))


None of that code change, although I did add the log function to help with debugging. It just sends messages to the Jetty log since I'm using Jetty as the servlet container.

The three functions for retrieving data were simplified a little. They no longer have sql/with-connection or json-str. The functions now have nothing specific to compojure or the web, and they don't have anything for setting up the database connection. The functions are now much more focused on exactly what they are intended to do. Here are the new definitions:
(defn get-table-meta
"Demonstrate getting table info"
[f]
(map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getTables nil nil nil nil)))))

(defn get-column-meta
"Given a table name, return a collection of the field names"
[t f]
(map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getColumns nil nil t nil)))))

(defn get-table
"Given a table name, return a collection of structmaps for all the data in the table"
[t]
(sql/with-query-results
res
[(str "SELECT * FROM " (sanitize-sql t))]
(into [] res)))


In order to make sure those functions have a database connection and have their output converted to JSON, I added two chunks of middleware:
(defn with-db
[handler]
(fn [request]
(sql/with-connection db-params (handler request))))

(defn with-json
[handler]
(fn [request]
(json-str (handler request))))


In Compojure, middleware is a wrapper around the request handlers. Middleware functions return a function that does something either to the request before it calls the request handler, or something to the response of the handler. In the first example above, the with-db function calls the handler as the body of the sql/with-connection function. There's no magic here. A handler function used to look like:
(defn get-table-meta
"Demonstrate getting table info"
[f]
(sql/with-connection db-params (map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getTables nil nil nil nil))))))


But with the decorator, calling with-connection is factored out.

In the second example decorator with-json, the result of the handler is converted to a JSON string. This has the potential for causing problems. If a handler can return an error code or a response map it won't return an error or the expected response; it'll return the json string version of the error and response map. Fortunately, decorators have to be explicitly added to handlers:

(defn tables-handler [request]
(get-table-meta table-name))
(defn columns-handler [request]
(get-column-meta (:table (:params request)) column-name))
(defn table-handler [request]
(get-table (:table (:params request))))
(defn insert-handler [request]
(insert-row (:table (:params request)) (dissoc (conj (:params request) {}) :table)))

(decorate tables-handler (with-json) (with-db))
(decorate table-handler (with-json) (with-db))
(decorate columns-handler (with-json) (with-db))
(decorate insert-handler (with-json) (with-db))

(defroutes my-routes
(POST "/insert/:table" insert-handler)
(ANY "/columns/:table" columns-handler)
(ANY "/table/:table" table-handler)
(ANY "/tables" tables-handler)
(ANY "/*" (or (serve-file "./static" (cleanPath (params :*))) :next))
(ANY "/*" (error 400)))

(run-server {:port 8080}
"/*" (servlet my-routes))


As you can see the route definitions now use simple function handler functions. While before one of the routes was (ANY "/columns/:table" (get-column-meta (params :table) column-name)) it's now (ANY "/columns/:table" columns-handler) and the columns-handler function takes care of pulling out the arguments from the request and calling the get-column-meta function. This way the decorators can be added to the handlers, and keeps logic out of the otherwise simple path specification of the defroutes.

Inserting a new record is pretty simple:
(defn insert-row [table fields]
(sql/insert-records table fields)
["Added record", fields])


That's it. The with-db decorator is added so it has a db connection to use, and the handler takes care of making sure the arguments are correct.

Here's the full code:

./db-edit.clj:
(ns db-edit
(:require [clojure.contrib.sql :as sql])
(:use clojure.contrib.json.write)
(:use compojure))

; Information about the SQLite database
(def db-params {:classname "org.sqlite.JDBC"
:subprotocol "sqlite"
:subname "./database.sqlite"})

(def http-error-map
{400 {:name "Bad Request"
:long "The request could not be understood by the server due to malformed syntax."}
401 {:name "Unauthorized"
:long "The request requires user authentication."} ; Note WWW-Authenticate header should be added
404 {:name "Not Found"
:long "The server has not found anything matching the Request-URI."}})

(defn error [err]
(if-let [errMap (get http-error-map err)]
{:status err
:headers {}
:body (str "HTTP error " err ": " (get errMap :name) "\n" (get errMap :long))}
{:status err
:headers {}
:body (str "HTTP Error " err " encountered")}))

(defn sanitize-sql
"Cleans the string of nasty SQL related special chars"
[s]
(. s (replaceAll "/[\\s'\";#%]/" "")))

(defn cleanPath
"Sanitize the incoming string for '..'"
[p]
(.. p (replaceAll "/\\.+" "/") (replaceAll "/+" "/")))

(defn log [ level & rest ]
(if (== level :debug)
(. org.mortbay.log.Log info (str rest))
(if (== level :info)
(. org.mortbay.log.Log debug (str rest))
(. org.mortbay.log.Log warn (str rest)))))

(defn with-db
[handler]
(fn [request]
(sql/with-connection db-params (handler request))))

(defn with-json
[handler]
(fn [request]
(json-str (handler request))))

(defn get-table-meta
"Demonstrate getting table info"
[f]
(map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getTables nil nil nil nil)))))

(defn get-column-meta
"Given a table name, return a collection of the field names"
[t f]
(map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getColumns nil nil t nil)))))

(defn get-table
"Given a table name, return a collection of structmaps for all the data in the table"
[t]
(sql/with-query-results
res
[(str "SELECT * FROM " (sanitize-sql t))]
(into [] res)))

(defn table-name
"Given a mapstruct from the get-table-meta function, give back a string"
[t]
(:table_name t))

(defn column-name
"Given a mapstruct from the table-col-names, give back the column name"
[c]
(:column_name c))

(defn insert-row [table fields]
(sql/insert-records table fields)
["Added record", fields])

(defn tables-handler [request]
(get-table-meta table-name))
(defn columns-handler [request]
(get-column-meta (:table (:params request)) column-name))
(defn table-handler [request]
(get-table (:table (:params request))))
(defn insert-handler [request]
(insert-row (:table (:params request)) (dissoc (conj (:params request) {}) :table)))

(decorate tables-handler (with-json) (with-db))
(decorate table-handler (with-json) (with-db))
(decorate columns-handler (with-json) (with-db))
(decorate insert-handler (with-json) (with-db))

(defroutes my-routes
(POST "/insert/:table" insert-handler)
(ANY "/columns/:table" columns-handler)
(ANY "/table/:table" table-handler)
(ANY "/tables" tables-handler)
(ANY "/*" (or (serve-file "./static" (cleanPath (params :*))) :next))
(ANY "/*" (error 400)))

(run-server {:port 8080}
"/*" (servlet my-routes))


static/index.html:
<script type="text/javascript">
// You may specify partial version numbers, such as "1" or "1.3",
// with the same result. Doing so will automatically load the
// latest version matching that partial revision pattern
// (i.e. both 1 and 1.3 would load 1.3.2 today).
google.load("jquery", "1.3.2");
google.load("jqueryui", "1.7.1");
google.setOnLoadCallback(function() {
loadTableNames();
});
</script>
<script type="text/javascript"
src="db-edit.js"></script>
</head>
<body>
<h1>DB Edit</h1>
<div id="content"></div>
</body>
</html>


static/db-edit.js
function tableNamesJSON(json) {
var str="<ul>\n";
$.each(json, function(i, t) {
str+=" <li><a href='#' onClick='loadTable(\""+t+"\")'>"+t+"</a></li>\n";
});
str+="</ul>\n";
return str;
}

function loadTableNames() {
$.getJSON("/tables", function(data, textStatus) {
$("#content").html(tableNamesJSON(data));
});
}

function tableDataJSON(json, columns) {
var str="";
$.each(json, function(i, r) {
str+=" <tr>\n"
$.each(r, function(j, c) {
str+=" <td>"+c+"</td>\n";
});
str+=" </tr>\n"
});
return str;
}

function columnsJSON(json) {
var str="";
$.each(json, function(i, c) {
str+=" <td>"+c+"</td>\n";
});
return str;
}

function loadTable(t) {
$("#content").html("<table id='t' border='1'><tr id='t_head'></tr></table>");
$.getJSON("/columns/"+t, function(data, status) {
$("#t_head").html(columnsJSON(data));
loadTableData(t, data);
});
$("#content").append(createInsertForm(t));
}

function loadTableData(t, columns) {
$.getJSON("/table/"+t, function(data, textStatus) {
$("#t").append(tableDataJSON(data, columns));
});
}

function createInsertForm(t) {
$.getJSON("/columns/"+t, function(data, status) {
var str="<form method='POST' action='/insert/"+t+"'>\n";
$.each(data, function(i, c) {
str+=" "+c+": <input type='text' name='"+c+"'>\n";
numCol=i;
});
str+=" <input type='submit'>\n";
str+="</form>";
$("#content").append(str);
});
}


Update: Escape JS and HTML. Thanks to a handy dandy page.

Compojure and SQLite

Continuing with learning Clojure and Compojure better, I decided I'd wade through some basic DB access. Eric Lavigne has a great post with all the basics. I decided to write a small web app that allows a database to be viewer and (eventually) modified. Again, fairly simple so I don't confuse myself. The full clj file is include at the bottom of the post.

The app starts with some basic definitions:
(ns db-edit
(:require [clojure.contrib.sql :as sql])
(:use clojure.contrib.json.write)
(:use compojure))

Creates a name space for the app called "db-edit", and imports the clojure sql and json libs, as well as the compojure stuff. I'm still not quite sure of the full meaning of clojure name spaces, or the syntax used, but it works.

Next, define the stuff for creating a database connection:
(def db-params {:classname "org.sqlite.JDBC"
:subprotocol "sqlite"
:subname "./database.sqlite"})

The :classname is obviously the class to use for database access. The :subprotocol is the second part of the standard Connection.getConnection url parameter (the form of that url is "jdbc:subprotocol:subname") and is DB driver dependent. The :subname, is of course the third part of the url parameter.

Following the DB definition are some handy definitions for HTTP errors:
(def http-error-map
{400 {:name "Bad Request"
:long "The request could not be understood by the server due to malformed syntax."}
401 {:name "Unauthorized"
:long "The request requires user authentication."} ; Note WWW-Authenticate header should be added
404 {:name "Not Found"
:long "The server has not found anything matching the Request-URI."}})

It's just a map from HTTP error codes to an English name and a longer description of it. Followed by:
(defn error [err]
(if-let [errMap (get http-error-map err)]
{:status err
:headers {}
:body (str "HTTP error " err ": " (get errMap :name) "\n" (get errMap :long))}
{:status err
:headers {}
:body (str "HTTP Error " err " encountered")}))

The error function returns a compojure response for the error. It sets the HTTP status to the error code, and the gives a body with the name and description.

Since there's going to be some static file serving and some user submitted data going into the db, two functions are defined to do a cheap ass sanitization of strings. Although the path sanitizer is probably good enough, the sql one is probably not something you'd in a real production app. Of course, in a real production app you wouldn't be getting table names from the user, so it may be a moot point.
(defn sanitize-sql
"Cleans the string of nasty SQL related special chars"
[s]
(. s (replaceAll "/[\\s'\";#%]/" "")))

(defn cleanPath
"Sanitize the incoming string for '..'"
[p]
(.. p (replaceAll "/\\.+" "/") (replaceAll "/+" "/")))


Now, I'm going to go out of order. Here are the routes the app is going to handle:

• /columns/TableName will return a JSON array with the column names of the table
  
• /table/TableName will return a JSON array of objects. Each object is a row of the table
  
• /tables will return a JSON array with the names of all tables in the database
  
• Anything else is searched for in the ./static directory and served up as a regular file
  

(defroutes my-routes
(ANY "/columns/:table" (get-column-meta (params :table) column-name))
(ANY "/table/:table" (get-table (params :table)))
(ANY "/tables" (get-table-meta table-name))
(ANY "/*" (or (serve-file "./static" (cleanPath (params :*))) :next))
(ANY "/*" (error 400)))

(run-server {:port 8080}
"/*" (servlet my-routes))


The serve-file line is taken pretty much directly out of one of the wikibooks pages. The error line, doesn't do anything unless the file serve fails (that's the point of the :next).

Now, into the database stuff. First up: getting the list of table names:
(defn get-table-meta
"Demonstrate getting table info"
[f]
(sql/with-connection db-params
(json-str (map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getTables nil nil nil nil)))))))

(defn table-name
"Given a mapstruct from the get-table-meta function, give back a string"
[t]
(:table_name t))

The get-table-meta is pretty much taken directly from the sql contrib docs but you also give it a function to extract only the meta information you need. The getTables method returns (in clojure) a sequence of structmaps. The table-name function just retrieves the table name from the structmap. I'm still not sure what that -> operator is doing... I think it's creating a function, but I'm not sure why the example code did it that way.

Finding the column names of a table is nearly the same:
(defn get-column-meta
"Given a table name, return a collection of the field names"
[t f]
(sql/with-connection db-params
(json-str (map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getColumns nil nil t nil)))))))

(defn column-name
"Given a mapstruct from the table-col-names, give back the column name"
[c]
(:column_name c))

The main function takes the table name and the filter function (I only column-name is used at the moment), and returns a JSON array of column names. The filter function could return a structmap which includes the type as well and the JSON would be an array of objects.

The final chunk is the function to return an entire table as an array of json objects:
(defn get-table
"Given a table name, return a collection of structmaps for all the data in the table"
[t]
(json-str (sql/with-connection
db-params
(sql/with-query-results
res
[(str "SELECT * FROM " (sanitize-sql t))]
(into [] res)))))

You can't parametrize the table name of an SQL statement, so concatenating the user given table name to the select is a rather unsafe operation. The sanitize-sql is used, but it's not exactly industrial strength security.

That's all there was to it. I'm still not up to speed on Clojure idioms so I still have to look into certain things to see how they work. But putting it together was relatively painless considering I haven't written Java for several years and I'm still new to Clojure. I'm still pleased with Compojure, the goal of the program was quite simple so I hoped the code would be equally simple and I was not disappointed. The code is short and fairly clear, without too many magic chunks.

Next time, a basic UI and probably inserting rows.

Full code:
(ns db-edit
(:require [clojure.contrib.sql :as sql])
(:use clojure.contrib.json.write)
(:use compojure))

; Information about the SQLite database
(def db-params {:classname "org.sqlite.JDBC"
:subprotocol "sqlite"
:subname "./database.sqlite"})

(def http-error-map
{400 {:name "Bad Request"
:long "The request could not be understood by the server due to malformed syntax."}
401 {:name "Unauthorized"
:long "The request requires user authentication."} ; Note WWW-Authenticate header should be added
404 {:name "Not Found"
:long "The server has not found anything matching the Request-URI."}})

(defn error [err]
(if-let [errMap (get http-error-map err)]
{:status err
:headers {}
:body (str "HTTP error " err ": " (get errMap :name) "\n" (get errMap :long))}
{:status err
:headers {}
:body (str "HTTP Error " err " encountered")}))

(defn sanitize-sql
"Cleans the string of nasty SQL related special chars"
[s]
(. s (replaceAll "/[\\s'\";#%]/" "")))

(defn cleanPath
"Sanitize the incoming string for '..'"
[p]
(.. p (replaceAll "/\\.+" "/") (replaceAll "/+" "/")))

(defn get-table-meta
"Demonstrate getting table info"
[f]
(sql/with-connection db-params
(json-str (map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getTables nil nil nil nil)))))))

(defn get-column-meta
"Given a table name, return a collection of the field names"
[t f]
(sql/with-connection db-params
(json-str (map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getColumns nil nil t nil)))))))

(defn get-table
"Given a table name, return a collection of structmaps for all the data in the table"
[t]
(json-str (sql/with-connection
db-params
(sql/with-query-results
res
[(str "SELECT * FROM " (sanitize-sql t))]
(into [] res)))))

(defn table-name
"Given a mapstruct from the get-table-meta function, give back a string"
[t]
(:table_name t))

(defn column-name
"Given a mapstruct from the table-col-names, give back the column name"
[c]
(:column_name c))


(defn insert-row [table params] (error 404))

(defroutes my-routes
(POST "/insert/:table" (insert-row (params :table) params))
(ANY "/columns/:table" (get-column-meta (params :table) column-name))
(ANY "/table/:table" (get-table (params :table)))
(ANY "/tables" (get-table-meta table-name))
(ANY "/*" (or (serve-file "./static" (cleanPath (params :*))) :next))
(ANY "/*" (error 400)))

(run-server {:port 8080}
"/*" (servlet my-routes))


Update: The second part includes inserting data, decorators, and middleware.

Basic Compojure Calculator

Compojure turned out to be relatively simple for making a basic URL driven calculator. Go to a URL like http://localhost:8080/add/4/5 and you get a page that simply says, "9". The Compojure documentation isn't complete yet (the site is quite upfront about that, and honesty is always nice), but along with examples online, there's probably enough to make a real web app. The full code is at the end of the post, but first I'll try to explain the code section by section.

(use 'compojure)
Gives the defroute thing (function or macro? I still get them confused) that we'll need later.

(def op-mapping
{"add" +,
"subtract" -,
"multiply" *,
"divide" /})
Obviously this just makes a hash mapping the English name for an operator to the actual function. The English names are what are used in the URL.

(defn doop [op ls rs]
"Do the operation on the two values"
(if (contains? op-mapping op)
(str ((get op-mapping op) ls rs))
"Unrecognized operation"))
Looks for the operation in the map, return an error if it can't be found. Otherwise run the function it maps to on the two given values. Nothing is Compojure specific yet.

(defroutes calc
(GET "/:op/:ls/:rs" (doop (params :op) (. Float valueOf (params :ls)) (. Float valueOf (params :rs))))
(ANY "/*" "Bad URL"))
This is the first chunk of Compojure specific code. All it does is define a route, the URL to what-do-you-want-to-do mapping. The first GET definition is a pretty neat way of specifying parameters. The pattern is given "/:op/:ls/:rs" and then the route parameters are available later with (params :op) and the like. Makes it easy to parse things out and you don't have to number everything.

(run-server {:port 8080}
"/*" (servlet calc))
The last chunk of Compojure specific code. Also the last chunk of the web app. It just starts up the web server and points it to the route chains.

Every small chunk was simple, clear, and had a specific useful purpose. Overall, the web framework is looking good so far. I think I'll keep experimenting with it.

Now for the full code:
(use 'compojure)

;;; Available operations
(def op-mapping
{"add" +,
"subtract" -,
"multiply" *,
"divide" /})

(defn doop [op ls rs]
"Do the operation on the two values"
(if (contains? op-mapping op)
(str ((get op-mapping op) ls rs))
"Unrecognized operation"))

(defroutes calc
(GET "/:op/:ls/:rs" (doop (params :op) (. Float valueOf (params :ls)) (. Float valueOf (params :rs))))
(ANY "/*" "Bad URL"))

(run-server {:port 8080}
"/*" (servlet calc))


Clojure and Compojure

A while back I tried out Clojure. It was my first real foray into the land of Lisp like languages, other than copying, pasting, and slightly modifying elisp chunks for Emacs which doesn't really count. It was very... interesting. I was writing a small IM bot to try it out, but couldn't find any reliable Java libraries for protocols other than XMPP. Nevertheless, I did get a basic bot working with XMPP and learned some basic Clojure as well.

The language recently had its 1.0 release and I figure it's time to try it out again. The last time I tried it out, the docs were somewhat confusing, but the main problem was simply getting the libraries to interact with Clojure well and I ran out of time. The only major issue I had at the time was needing some small Java code to handle something... static variables or overriding private methods or something like that. This time, I'm going to try making a small web site using Clojure and Compojure.

Compojure looks like an interesting, fairly minimal web framework.

Step 1, download:
$ git clone git://github.com/weavejester/compojure.git
Initialized empty Git repository in compojure/.git/
remote: Counting objects: 3371, done.
remote: Compressing objects: 100% (1619/1619), done.
remote: Total 3371 (delta 1680), reused 2806 (delta 1335)
Receiving objects: 100% (3371/3371), 5.25 MiB | 55 KiB/s, done.
Resolving deltas: 100% (1680/1680), done.


Yay! Easy enough.

Step 2, get other packages it needs like Clojure and Jetty, and compile Compojure:
$ ant deps
Buildfile: build.xml

deps:
[get] Getting: http://cloud.github.com/downloads/weavejester/compojure/deps.zip
[get] To: compojure/deps.zip
[unzip] Expanding: compojure/deps.zip into compojure

BUILD SUCCESSFUL
Total time: 2 minutes 20 seconds
$ ls deps
clojure-contrib.jar commons-io-1.4.jar jetty-util-6.1.15.jar
clojure.jar grizzly-http-servlet-1.9.10.jar servlet-api-2.5-20081211.jar
commons-codec-1.3.jar grizzly-http-webserver-1.9.10.jar
commons-fileupload-1.2.1.jar jetty-6.1.15.jar
$ ant
....
BUILD SUCCESSFUL
Total time: 6 seconds


Step 3, Write basic helloworld and start the server:
helloworld$ cat helloworld.clj
(ns example-app
(:use compojure.http.servlet)
(:use compojure.server.jetty))

(defn hello-world [request]
{:status 200
:headers {}
:body "Hello World"})

(run-server {:port 8080}
"/*" (servlet hello-world))
helloworld$ /usr/lib/j2sdk/bin/java -cp $(for i in ../compojure/deps/*.jar; do echo -n $i: ; done)../compojure/compojure.jar clojure.lang.Script ./helloworld.clj
2009-06-08 22:43:51.799::INFO: Logging to STDERR via org.mortbay.log.StdErrLog
clojure.proxy.javax.servlet.http.HttpServlet
2009-06-08 22:43:51.859::INFO: jetty-6.1.15
2009-06-08 22:43:51.952::INFO: Started SocketConnector@0.0.0.0:8080

And in another terminal:

$ wget -O - http://localhost:8080/ 2>/dev/null
Hello World


Cool! From nothing to the simplest example in half an hour (including figuring out how to run the clj file form the command line). Next time, hopefully I'll have managed a more complicated web app.