Welcome back! We will be revisiting the pagination from last time, however we are going to try and make this easier on ourselves, I built a package for pagination mito-pager, the idea is that much of what we looked at in the last lesson was very boiler plate and repetitive so we should look at removing this.
I will say, my mito-pager can do a little more than just what I show here, it has two modes, you can use paginate-dao (named this way so that it is familiar to mito) to paginate over simple models, however, if you need to perform complex queries there is a macro with-pager that you can use to paginate. It is this second form we will use in this tutorial.
There is one thing to bear in mind, when using mito-pager, you must implement your data retrieval functions in such a way to return a values object, as mito-pager relies on this to work.
I encourge you to try the library out in other use-cases and, of course, if you have ideas, please let me know.
Most of our changes are quite limited in scope, really it’s just our controllers and models that need most of the edits.
We need to add the mito-pager package to our project asd file.
- :ningle-auth)
+ :ningle-auth
+ :mito-pager)
Here is the real payoff! I almost dreaded writing the sheer volume of the change but then realised it’s so simple, we only need to change our index function, and it may be better to delete it all and write our new simplified version.
(defun index (params)
(let* ((user (gethash :user ningle:*session*))
(req-page (or (parse-integer (or (ingle:get-param "page" params) "1") :junk-allowed t) 1))
(req-limit (or (parse-integer (or (ingle:get-param "limit" params) "50") :junk-allowed t) 50)))
(flet ((get-posts (limit offset) (ningle-tutorial-project/models:posts user :offset offset :limit limit)))
(mito-pager:with-pager ((posts pager #'get-posts :page req-page :limit req-limit))
(djula:render-template* "main/index.html" nil :title "Home" :user user :posts posts :pager pager)))))
This is much nicer, and in my opinion, the controller should be this simple.
We need to ensure we include the templates from mito-pager, this is a simple one line change.
(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
+ (djula:add-template-directory (asdf:system-relative-pathname :mito-pager "src/templates/"))
As mentioned at the top of this tutorial, we have to implement our data retrieval functions in a certain way. While there are some changes here, we ultimately end up with less code.
We can start by removing the count parameter, we wont be needing it in this implementation, and since we don’t need the count parameter anymore, the :around method can go too!
- (defgeneric posts (user &key offset limit count)
+ (defgeneric posts (user &key offset limit)
-
- (defmethod posts :around (user &key (offset 0) (limit 50) &allow-other-keys)
- (let ((count (mito:count-dao 'post))
- (offset (max 0 offset))
- (limit (max 1 limit)))
- (if (and (> count 0) (>= offset count))
- (let* ((page-count (max 1 (ceiling count limit)))
- (corrected-offset (* (1- page-count) limit)))
- (posts user :offset corrected-offset :limit limit))
- (call-next-method user :offset offset :limit limit :count count))))
There’s two methods to look at, the first is when the type of user is user:
-
- (defmethod posts ((user user) &key offset limit count)
+ (defmethod posts ((user user) &key offset limit)
...
(values
- (mito:retrieve-by-sql sql :binds params)
- count
- offset)))
+ (mito:retrieve-by-sql sql :binds params)
+ (mito:count-dao 'post))))
The second is when the type of user is null:
-
- (defmethod posts ((user null) &key offset limit count)
+ (defmethod posts ((user null) &key offset limit)
...
(values
- (mito:retrieve-by-sql sql)
- count
- offset)))
+ (mito:retrieve-by-sql sql)
+ (mito:count-dao 'post))))
As you can see, all we are really doing is relying on mito to do the lions share of the work, right down to the count.
The change here is quite simple, all we need to do is to change the path to the partial, we need to simply point to the partial provided by mito-pager.
- {% include "partials/pager.html" with url="/" title="Posts" %}
+ {% include "mito-pager/partials/pager.html" with url="/" title="Posts" %}
This one is easy, we can delete it! mito-pager provides its own template, and while you can override it (if you so wish), in this tutorial we do not need it anymore.
I hope you will agree that this time, using a prebuilt package takes a lot of the pain out of pagination. I don’t like to dictate what developers should, or shouldn’t use, so that’s why last time you were given the same information I had, so if you wish to build your own library, you can, or if you want to focus on getting things done, you are more than welcome to use mine, and of course, if you find issues please do let me know!
| Level | Learning Outcome |
|---|---|
| Understand | Understand how third-party pagination libraries like mito-pager abstract boilerplate pagination logic, and how with-pager expects a fetch function returning (values items count) to handle page clamping, offset calculation, and boundary correction automatically. |
| Apply | Apply flet to define a local adapter function that bridges the project’s posts generic function with mito-pager’s expected (lambda (limit offset) ...) interface, and use with-pager to reduce controller complexity to its essential logic. |
| Analyse | Analyse what responsibilities were transferred from the manual pagination implementation to mito-pager — count caching, boundary checking, offset calculation, page correction, and range generation — contrasting the complexity of both approaches. |
| Create | Refactor a manual pagination implementation to use mito-pager by simplifying model methods to return (values items count), replacing complex multi-step controller calculations with with-pager, and delegating the pagination template partial to the library. |
| Symbol | Type | Why it appears in this lesson | CLHS |
|---|---|---|---|
defpackage |
Macro | Define project packages like ningle-tutorial-project/models, /forms, /controllers. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defpac.htm |
in-package |
Macro | Enter each package before defining models, controllers, and functions. | http://www.lispworks.com/documentation/HyperSpec/Body/m_in_pkg.htm |
defgeneric |
Macro | Define the simplified generic posts function signature with keyword parameters offset and limit (the count parameter is removed). |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defgen.htm |
defmethod |
Macro | Implement the simplified posts methods for user and null types (the :around validation method is removed). |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defmet.htm |
flet |
Special Operator | Define the local get-posts adapter function that wraps posts to match mito-pager’s expected (lambda (limit offset) ...) interface. |
http://www.lispworks.com/documentation/HyperSpec/Body/s_flet_.htm |
let* |
Special Operator | Sequentially bind user, req-page, and req-limit in the controller where each value is used in subsequent bindings. |
http://www.lispworks.com/documentation/HyperSpec/Body/s_let_l.htm |
or |
Macro | Provide fallback values when parsing page and limit parameters, defaulting to 1 and 50 respectively. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_or.htm |
multiple-value-bind |
Macro | Capture the SQL string and bind parameters returned by sxql:yield in the model methods. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_multip.htm |
values |
Function | Return two values from posts methods — the list of results and the total count — as required by mito-pager:with-pager. |
http://www.lispworks.com/documentation/HyperSpec/Body/a_values.htm |
parse-integer |
Function | Convert string query parameters ("1", "50") to integers, with :junk-allowed t for safe parsing. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_parse_.htm |
Hello and welcome back, I hope you all had a good festive season, I took a break last month as I usually get very busy in December, but lest you think I had stopped posting, I have prepared a two part lesson this time: Pagination. We are first going to look at rolling your own pagination, but we will then look at integrating a package I wrote ningle-pager, to simplify the code. This way if my package doesn’t fit your needs, you have the information required to build your own solution.
In practical terms, something like a microblogging app would use infinite scrolling, but we don’t have anywhere enough data to present that as a lesson right now, and besides pagination has a lot of uses, Google and Amazon use it for their products, so it must be pretty useful!
In SQL, there is the ability to LIMIT results, but also, the ability to start from an OFFSET, which ultimately does the heavy lifting for us. We have previously looked at SXQL, which is a thin layer upon SQL, so we can use (limit 50) and (offset 100) (or whatever values we want) to interact with the database, we will also use GET parameters like ?page=2&limit=50 (or something). So with this information we know the url patterns and we know what SXQL forms we want to use, we just have to design how our application will work internally.
Our solution will define an interface, any controller that needs to be paginated will:
page keyword parameterlimit keyword parametervalues list that has 3 items, the results, the total count, and the offset.The work will touch the models, the controllers, and the templates:
We are gonna get deep into the weeds with clos in how we implement our pagination in this part, there’s multiple methods so we will take each implementation one by one. You can learn more about how OOP is implemented in my older videos.
We start with a generic definition, we already had one, but we are modifying it. Fun fact, the generic method defines all the parameters a method might use, but not all methods must use the arguments, which comes in real handy for us later:
(defgeneric posts (user &key offset limit count)
(:documentation "Gets the posts"))
Here we have a generic method, generic methods do nothing on their own, they help us define what a method should do, but of course under certain circumstances how a method does what it does may need to change, this allows us to implment different specialised concrete methods, we will look at this below.
What we have done with this generic method is add key arguments offset, limit, and count, as we saw previously, all this does is declare a :documentation form.
As you may, or may not know, the Common Lisp Object System (clos for short) allows us to define, as we have done previously primary methods, these are methods that specialise on one (or more) of the parameters. When passed arguments at the point the method is called, the method matching the parameter type of the arguments passed will trigger. That is why our posts method specifies user to be a user object, or null and handles the logic in different ways. It also allows us to define auxiliary methods, which are known as :before, :after, and :around. The :before methods will run, well, before the related primary method is called, with each :before method being called by its most specific signature to its least. :after methods are the total opposite, they run after a primary method is run, and they run from the least specific version to the most specific. They would be where we might want to add signals, or logging, we could have a :before, and :after around the mito:save-dao that we use and the :before method sends a pre-save signal while the :after sends a post-save signal.
It is not, however the :before/:after methods we care about here, we in fact will write an :around, which is a more fundamental building block. :around methods control, how, when, or even if, a primary method gets called, the other methods can’t control this. As previously discussed they have a specific order in which they run, so if we wanted to… say… capture arguments and do some processing on them because, I dunno, we should never trust user input, prior to running our primary method, an :around method is what we would need to use.
The real “magic” of how to do what we want to do is use an :around method. We will look at the complete implementation a little bit later, but we need to pause and ensure we really understand about method combination in Common Lisp.
As we mentioned in the defgeneric, not every method needs to use or specialise on every parameter, and in this :around method you will notice that the count is absent, that is by design, because the :around method will compute it and pass it onto the next method in the chain, instead it uses &allow-other-keys to allow these key arguments to be accepted, but also since they are unnamed, the compiler won’t emit a warning that they’re not used.
Our implementation is here:
(defmethod posts :around (user &key (offset 0) (limit 50) &allow-other-keys)
(let ((count (mito:count-dao 'post))
(offset (max 0 offset))
(limit (max 1 limit)))
(if (and (> count 0) (>= offset count))
(let* ((page-count (max 1 (ceiling count limit)))
(corrected-offset (* (1- page-count) limit)))
(posts user :offset corrected-offset :limit limit))
(call-next-method user :offset offset :limit limit :count count))))
The first thing to note is the obvious :around keyword that comes after the posts name, this is how we declare a method as an :around method. The next thing to notice is that the count parameter is not declared, instead we use the &allow-other-keys, as discussed above. This method will modify some variables or recalculate the offset if it was invalid before either calling itself (to perform the recalculations) or call the next method with, well, call-next-method.
We begin with a let form that will get the number of items by using mito:count-dao, we determine the offset by getting the max of 0 or the offset, we also define limit as the max of 1 and limit.
The key check here is in the if form, which checks that both the count is larger than zero (> count zero) and the offset is bigger than the count (>= offset count), this tells us that an invalid condition exists, we can’t request an offset to be larger than the number of items, so we have to handle it. Under these circumstances we need to get the new page-count by calculating (max 1 (ceiling count limit)), this will round up the result of dividing count by limit, and returns that, or 1.
Once we have that we can calculate a corrected offset by using the formula (* (1- page-count) limit), to run through how this formula works, here are some examples, if we assume limit is defined as 50, we can increment the page-count by one each time to see how this calculation works:
(* (1- 1) 50) -> (* 0 50) -> 0(* (1- 2) 50) -> (* 1 50) -> 50(* (1- 3) 50) -> (* 2 50) -> 100With this calculation done we can recursively call the method again, this time with the correct values, which brings us to our base case, calling the next method via call-next-method with the appropriate values which handily brings us to the specific methods now. We can actually dramatically simplify our primary methods thanks to the :around method.
Something to bear in mind, our count here is real easy, cos we are just returning all posts, but a more complex application may need more complex logic to determine what and how you are counting.
Since we don’t need to handle any error state or recovery (because the :around method handles it), we can actually write simple methods that perform a query and return the results. We have also simplified the way in which we run queries, turns out the sxql:yield returns multiple values, the first is the SQL string, the second is a list of params to be spliced into it (to avoid sql injection attacks), so we set up a multiple-value-bind form to capture these, and we put our SQL together, we previously used :? which was fine, as that is the character used to be a place holder, but this way is nicer to write. The things you learn, eh?
Please note however, where in our :around method we didn’t specify the count parameter that the generic method defines, in this primary method, we do!
All we do it use a values form to return the result of running the sql, with the parameters bound to it, the count (number of items total) and the offset from where it starts returning results from.
(defmethod posts ((user user) &key offset limit count)
(multiple-value-bind (sql params)
(sxql:yield
(sxql:select
(:post.*
(:as :user.username :username)
(:as (:count :likes.id) :like_count)
(:as (:count :user_likes.id) :liked_by_user))
(sxql:from :post)
(sxql:left-join :user :on (:= :post.user_id :user.id))
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:left-join (:as :likes :user_likes)
:on (:and (:= :post.id :user_likes.post_id)
(:= :user_likes.user_id (mito:object-id user))))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:offset offset)
(sxql:limit limit)))
(values
(mito:retrieve-by-sql sql :binds params)
count
offset)))
This makes our primary method much tighter, it runs a query and returns results, the :around method handles the recalculation logic (which is shared between this primary method and the next). Nice and simple.
So having seen the form of our new primary methods above, we follow the same patern for the primary method where the user is null. As before this primary method accepts the count parameter.
(defmethod posts ((user null) &key offset limit count)
(multiple-value-bind (sql)
(sxql:yield
(sxql:select
(:post.*
(:as :user.username :username)
(:as (:count :likes.id) :like_count))
(sxql:from :post)
(sxql:left-join :user :on (:= :post.user_id :user.id))
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit limit)
(sxql:offset offset)))
(values
(mito:retrieve-by-sql sql)
count
offset)))
The query is simpler, and we do not need to actually pass any variables into the SQL string, so we don’t need the params value returned from the multiple-value-bind, which means we also don’t need to use the :binds key argument into mito:retrieve-by-sql.
And that’s it, that’s our models done!
Our controller will be the index controller we built previously, but we need to modify it quite a bit to parse and process the information we need, pagination has a lot of data, and we will need to ensure our templates can present the UI and data in a easy to use manner.
The controller will be so radically different as to be entirely new, it may be easier for you to delete the existing index controller and replace it with what we write here.
The first thing the controller needs to do is grab the GET parameters and validate them, we follow a basic formula to achieve this for the two parameters we need (page, and limit):
(or (parse-integer (or (ingle:get-param "page" params) "1") :junk-allowed t) 1)
(or (parse-integer (or (ingle:get-param "limit" params) "50") :junk-allowed t) 50)
As you can see these are basically identical the only thing that differs are the default values, in the case of page it is "1"/1 for limit it is "50"/50. To run through the logic we have some basic possibilities we need to handle.
In the case where there is no parameter which will be the case if no page=x is in url, or the value of page is not numeric (such as a word, page=hi or something) the result of (ingle:get-param "page" params) will be nil.
In the case where page is provided and is a number, the process is the same, but (ingle:get-param "page" params) would return a number as a string.
We can see how that would evaluate here:
(or (parse-integer (or (ingle:get-param "page" params) "1") :junk-allowed t) 1)
(or (parse-integer (or nil "1") :junk-allowed t) 1)
(or (parse-integer "1" :junk-allowed t) 1)
(or 1 1)
1
The process repeats for the “limit” parameter. It’s a lot of checking and handling, it would be nice if there were a library to handle this for us, but I have not yet found one, perhaps that will be our next topic!
NOTE! In this example we are permitting arbitrary limit values (we are learning), in practice, this should be limited to a maximum value to prevent users from requesting a page that may result in a Denial Of Service type event. What the exact value should be really depends on the data, it might be fine to get thousands of numbers in one go, but if your models are complicated, a smaller number may be better.
You could do something like this to limit… the limit: (limit (min 100 (max 1 limit)))
The let binding will therefore look like this
(let ((user (gethash :user ningle:*session*))
(page (or (parse-integer (or (ingle:get-param "page" params) "1") :junk-allowed t) 1))
(limit (or (parse-integer (or (ingle:get-param "limit" params) "50") :junk-allowed t) 50)))
...)
With those parameters validated, we can focus on building our paginated controller. Thanks to the work we did in the models we can pull the values out of the posts method with multiple-value-bind:
(let ((user (gethash :user ningle:*session*))
(page (or (parse-integer (or (ingle:get-param "page" params) "1") :junk-allowed t) 1))
(limit (or (parse-integer (or (ingle:get-param "limit" params) "50") :junk-allowed t) 50)))
(multiple-value-bind (posts count offset) (ningle-tutorial-project/models:posts user :offset (* (1- page) limit) :limit limit)
...))
This enables us to now calculate the various values we need to pass through into a template to render the paginator, we need to generate 6 values.
The page variable is a way to determine what the current page is, it is calculated like so:
(1+ (floor offset limit))
From the offset we get from the multiple-value-bind we round down the value of dividing offset by the limit and add 1 to the value. If we assume, for example, an offset of 50 and a limit of 50, we can see how the page is determined.
(1+ (floor 50 50))
(1+ 1)
2
If we want to see something larger:
(1+ (floor 250 50))
(1+ 5)
6
The page-count variable is a way to determine the total number of pages:
(max 1 (ceiling count limit))
Again, from the multiple-value-bind we get the count object, so we can expand this, assuing count is 250 and limit is 50.
(max 1 (ceiling 500 50))
(max 1 10)
10
In this manner, given a total number and a page size we want to split it into, we can see the total number of pages.
Unlike the previous two calculations, prev-page can legitiately be nil. In the case we are already on the first page there’s no way for there to be a previous page, so nil is fine. If we need to have some binary conditional logic where nil is acceptable when is our friend.
(when (> page 1) (1- page))
Wwhen the page is bigger than one, return one less than the value of page, because this is a when (1- page) will be returned, or nil will be.
The inverse of the above:
(when (< page page-count) (1+ page))
When the page is smaller than the total number of pages, return one more than the value of page, or nil.
Range start is to help the UI, typically in paginators, especially in large ones, there’s a first, last, and current location, but often the current location has some pages to the left and right, this is the range. Now there’s no real right number for the ranges, but I settled on 2.
(max 1 (- page 2))
Assuming page is 1, max will return 1, but if we are on, say, page 15, the location the range starts at is 13.
Range end behaves like range start, except in the other direction, but we need to ensure we get the minimum of the page-count, in case we are on the last page.
(min page-count (+ page 2))
With these defined we can put them in a let* form.
(let ((user (gethash :user ningle:*session*))
(page (or (parse-integer (or (ingle:get-param "page" params) "1") :junk-allowed t) 1))
(limit (or (parse-integer (or (ingle:get-param "limit" params) "50") :junk-allowed t) 50)))
(multiple-value-bind (posts count offset) (ningle-tutorial-project/models:posts user :offset (* (1- page) limit) :limit limit)
(let* ((page (1+ (floor offset limit)))
(page-count (max 1 (ceiling count limit)))
(prev-page (when (> page 1) (1- page)))
(next-page (when (< page page-count) (1+ page)))
(range-start (max 1 (- page 2)))
(range-end (min page-count (+ page 2))))
...)))
The final thing we need to do is return the result of djula:render-template*, but there is still more data we need to pass through, build upon the variables we defined, there’s only 5 more.
Pages is simply a list of all the pages, which is easy enough to generate:
(loop :for idx :from range-start :to range-end :collect idx)
The show-start-gap is a boolean that tells the template to render part of the paginator UI.
(> range-start 2)
This will return t or nil depending on if range-start is larger than 2.
The show-end-gap is the inverse:
(< range-end (1- page-count))
This will return t or nil depending on if range-end is smaller than (1- page-count).
To get the start-index, this is the number starting from the offset so we can display something like “Showing x - y of z”, x would be our start-index.
(if (> count 0) (1+ offset) 0)
If the count is bigger than zero then we return one more than the offset, else we return 0 (the default starting offset being 0).
Again, this is the opposite of another thing, the start-index.
(if (> count 0) (min count (+ offset (length posts))) 0)
If count is bigger than zero then what we need is the smallest (min) of the count and offset plus the number of posts, or 0. It’s possible there isn’t a complete pages worth of items, so we need to ensure that we don’t over run.
With all that being said, we can now see the complete controller with the values rendered by djula:
(defun index (params)
(let ((user (gethash :user ningle:*session*))
(page (or (parse-integer (or (ingle:get-param "page" params) "1") :junk-allowed t) 1))
(limit (or (parse-integer (or (ingle:get-param "limit" params) "50") :junk-allowed t) 50)))
(multiple-value-bind (posts count offset) (ningle-tutorial-project/models:posts user :offset (* (1- page) limit) :limit limit)
(let* ((page (1+ (floor offset limit)))
(page-count (max 1 (ceiling count limit)))
(prev-page (when (> page 1) (1- page)))
(next-page (when (< page page-count) (1+ page)))
(range-start (max 1 (- page 2)))
(range-end (min page-count (+ page 2))))
(djula:render-template*
"main/index.html"
nil
:title "Home"
:user user
:posts posts
:form (if user (cl-forms:find-form 'post) nil)
:count count
:page page
:limit limit
:page-count page-count
:prev-page prev-page
:next-page next-page
:pages (loop :for idx :from range-start :to range-end :collect idx)
:show-start-gap (> range-start 2)
:show-end-gap (< range-end (1- page-count))
:start-index (if (> count 0) (1+ offset) 0)
:end-index (if (> count 0) (min count (+ offset (length posts))) 0))))))
I would have thought that having an invalid number would have triggered a 404, or perhaps a 400, but having tested this with Google, it seems that the convention is to default to page 1. So with that said and the controller in place, we can now write our templates.
Our index template doesn’t require much change at all, we need to only add an include (from djula) to include the contents of one template inside another. Of course we have still to write the pagination template, but that is just below.
{% extends "base.html" %}
{% block content %}
<div class="container">
<!-- Post form -->
<div class="row mb-4">
<div class="col">
{% if form %}
{% form form %}
{% endif %}
</div>
</div>
<!-- Posts Section -->
+ {% include "partials/pagination.html" with url="/" title="Posts" %}
<div class="row">
...
</div>
+ {% include "partials/pagination.html" with url="/" title="Posts" %}
</div>
{% endblock %}
Something to bear in mind here is the way this is designed is that if you need to pass in some data, in our case url, and title, we can pass through these things, we will use these in the pagination html partial.
Partials are a way to include reusable parts of html presentation in a template, they help us build isolated pieces of presentation logic that we might want to use over and over again all over our application, this is why we save them in a partials folder, because they are a partial piece of presentation logic.
This is the magic that makes the UI work, while we showed were it would be used in the index.html page, we need to look into what it does. I do use bootstrap to make things look nice, but I’m very much NOT a frontend engineer, so I can’t speak to how to make something look good without it, so inevitably much of the classes and UI come from Bootstrap.
I will have to break the html down piece by piece to explain what it’s all doing, but look at the final listing to see the complete file.
From the values we calculated though, we start by checking if the page count is bigger than 1, because if we have less than two pages, we can’t paginate, therefore the whole UI is wrapped in:
{% if page-count > 1%}
...
{% endif %}
With that we can use the start-index, end-index, and count, to display the human readable part of the paginator.
{% if page-count > 1%}
<div class="table-pagination">
<div class="pagination-summary">
Showing {{ start-index }}-{{ end-index }} of {{ count }}
</div>
...
{% endif %}
We then setup a nav, with a single ul object in it, with which we define our parts of the paginator as li tags.
{% if page-count > 1%}
...
<nav aria-label="{{ title }} pagination">
<ul class="pagination">
...
{% endif %}
Within this ul, we have to put all of our li elements which will contain the aspects of the UI. The first such item is:
...
<ul class="pagination">
<li class="page-item{% if not prev-page %} disabled{% endif %}">
{% if prev-page %}
<a class="page-link" href="{{ url }}?page={{ prev-page }}&limit={{ limit }}">Prev</a>
{% else %}
<span class="page-link">Prev</span>
{% endif %}
</li>
...
</ul>
This first li will set the disabled css class if the prev-page is not nil. It will again rely on prev-page to either render an a tag building the url up, including the prev-page, and limit, else a span is rendered. This sets up the first element in the pagination UI.
The second li item checks the page, and if it is the first page, it sets the active class and renders a span, if it is NOT 1 then a link to the first page is rendered with a a tag, building up the url as we did before.
...
<li class="page-item{% if page == 1 %} active{% endif %}">
{% if page == 1 %}
<span class="page-link">1</span>
{% else %}
<a class="page-link" href="{{ url }}?page=1&limit={{ limit }}">1</a>
{% endif %}
</li>
...
Now that we have gotten the beginning of the paginator with a “Prev” li element and the first li element, we might need to render an elipsis (…) if the number of our pages is too large. We will repeat this pattern later on, in reverse, we will use the show-start-gap boolean to render the ....
...
{% if show-start-gap %}
<li class="page-item disabled"><span class="page-link">...</span></li>
{% endif %}
...
With that done, we can now render the page numbers:
{% for p in pages %}
{% if p != 1 and p != page-count %}
<li class="page-item{% if p == page %} active{% endif %}">
{% if p == page %}
<span class="page-link">{{ p }}</span>
{% else %}
<a class="page-link" href="{{ url }}?page={{ p }}&limit={{ limit }}">{{ p }}</a>
{% endif %}
</li>
{% endif %}
{% endfor %}
We loop over the list of page numbers we passed into the template as pages, if the loop iteration is NOT the first page (remember that this is a list of page numbers and starts from 1, not 0) and the loop iteration is not the current page, then we will render the li tag. If we just so happen to be on the loop iteration that is the current page (page), we render a span tag and not a link, else we render a link so that we can directly navigate to this element in the paginator.
We then render the show-end-gap, using the pattern we used above:
...
{% if show-end-gap %}
<li class="page-item disabled"><span class="page-link">...</span></li>
{% endif %}
...
This will render an elipsis (…) where needed.
Now to the final page in the paginator, we must check if we are on the final page, which, as we have seen before, we do in the class line, and to determine if we render a span tag if we are on the final page, or a a tag if we are not.
...
<li class="page-item{% if page == page-count %} active{% endif %}">
{% if page == page-count %}
<span class="page-link">{{ page-count }}</span>
{% else %}
<a class="page-link" href="{{ url }}?page={{ page-count }}&limit={{ limit }}">{{ page-count }}</a>
{% endif %}
</li>
...
And finally, we must render the “Next” part of the pagination:
...
<li class="page-item{% if not next-page %} disabled{% endif %}">
{% if next-page %}
<a class="page-link" href="{{ url }}?page={{ next-page }}&limit={{ limit }}">Next</a>
{% else %}
<span class="page-link">Next</span>
{% endif %}
</li>
...
If there is NOT a next page we add the disabled class, we then, as we have seen before use the next-page variable to determine if we render an a tag, or a span tag.
To see how all of this comes together here are the files in their entirety.
(defpackage ningle-tutorial-project/models
(:use :cl :mito :sxql)
(:import-from :ningle-auth/models #:user)
(:export #:post
#:id
#:content
#:comments
#:likes
#:user
#:liked-post-p
#:posts
#:parent
#:toggle-like))
(in-package ningle-tutorial-project/models)
(deftable post ()
((user :col-type ningle-auth/models:user :initarg :user :accessor user)
(parent :col-type (or :post :null) :initarg :parent :reader parent :initform nil)
(content :col-type (:varchar 140) :initarg :content :accessor content)))
(deftable likes ()
((user :col-type ningle-auth/models:user :initarg :user :reader user)
(post :col-type post :initarg :post :reader post))
(:unique-keys (user post)))
(defgeneric likes (post)
(:documentation "Returns the number of likes a post has"))
(defmethod likes ((post post))
(mito:count-dao 'likes :post post))
(defgeneric comments (post user)
(:documentation "Gets the comments for a logged in user"))
(defmethod comments ((post post) (user user))
(mito:retrieve-by-sql
(sxql:yield
(sxql:select
(:post.*
(:as :user.username :username)
(:as (:count :likes.id) :like_count)
(:as (:count :user_likes.id) :liked_by_user))
(sxql:from :post)
(sxql:where (:= :parent :?))
(sxql:left-join :user :on (:= :post.user_id :user.id))
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:left-join (:as :likes :user_likes)
:on (:and (:= :post.id :user_likes.post_id)
(:= :user_likes.user_id :?)))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))
:binds (list (mito:object-id post) (mito:object-id user))))
(defmethod comments ((post post) (user null))
(mito:retrieve-by-sql
(sxql:yield
(sxql:select
(:post.*
(:as :user.username :username)
(:as (:count :likes.id) :like_count))
(sxql:from :post)
(sxql:where (:= :parent :?))
(sxql:left-join :user :on (:= :post.user_id :user.id))
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))
:binds (list (mito:object-id post))))
(defgeneric toggle-like (user post)
(:documentation "Toggles the like of a user to a given post"))
(defmethod toggle-like ((ningle-auth/models:user user) (post post))
(let ((liked-post (liked-post-p user post)))
(if liked-post
(mito:delete-dao liked-post)
(mito:create-dao 'likes :post post :user user))
(not liked-post)))
(defgeneric liked-post-p (user post)
(:documentation "Returns true if a user likes a given post"))
(defmethod liked-post-p ((ningle-auth/models:user user) (post post))
(mito:find-dao 'likes :user user :post post))
(defgeneric posts (user &key offset limit count)
(:documentation "Gets the posts"))
(defmethod posts :around (user &key (offset 0) (limit 50) &allow-other-keys)
(let ((count (mito:count-dao 'post))
(offset (max 0 offset))
(limit (max 1 limit)))
(if (and (> count 0) (>= offset count))
(let* ((page-count (max 1 (ceiling count limit)))
(corrected-offset (* (1- page-count) limit)))
(posts user :offset corrected-offset :limit limit))
(call-next-method user :offset offset :limit limit :count count))))
(defmethod posts ((user user) &key offset limit count)
(multiple-value-bind (sql params)
(sxql:yield
(sxql:select
(:post.*
(:as :user.username :username)
(:as (:count :likes.id) :like_count)
(:as (:count :user_likes.id) :liked_by_user))
(sxql:from :post)
(sxql:left-join :user :on (:= :post.user_id :user.id))
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:left-join (:as :likes :user_likes)
:on (:and (:= :post.id :user_likes.post_id)
(:= :user_likes.user_id (mito:object-id user))))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:offset offset)
(sxql:limit limit)))
(values
(mito:retrieve-by-sql sql :binds params)
count
offset)))
(defmethod posts ((user null) &key offset limit count)
(multiple-value-bind (sql)
(sxql:yield
(sxql:select
(:post.*
(:as :user.username :username)
(:as (:count :likes.id) :like_count))
(sxql:from :post)
(sxql:left-join :user :on (:= :post.user_id :user.id))
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit limit)
(sxql:offset offset)))
(values
(mito:retrieve-by-sql sql)
count
offset)))
(defpackage ningle-tutorial-project/controllers
(:use :cl :sxql)
(:import-from :ningle-tutorial-project/forms
#:post
#:content
#:parent
#:comment)
(:export #:index
#:post-likes
#:single-post
#:post-content
#:post-comment
#:logged-in-profile
#:unauthorized-profile
#:people
#:person))
(in-package ningle-tutorial-project/controllers)
(defun index (params)
(let ((user (gethash :user ningle:*session*))
(page (or (parse-integer (or (ingle:get-param "page" params) "1") :junk-allowed t) 1))
(limit (or (parse-integer (or (ingle:get-param "limit" params) "50") :junk-allowed t) 50)))
(multiple-value-bind (posts count offset) (ningle-tutorial-project/models:posts user :offset (* (1- page) limit) :limit limit)
(let* ((page (1+ (floor offset limit)))
(page-count (max 1 (ceiling count limit)))
(prev-page (when (> page 1) (1- page)))
(next-page (when (< page page-count) (1+ page)))
(range-start (max 1 (- page 2)))
(range-end (min page-count (+ page 2))))
(djula:render-template*
"main/index.html"
nil
:title "Home"
:user user
:posts posts
:form (if user (cl-forms:find-form 'post) nil)
:count count
:page page
:limit limit
:page-count page-count
:prev-page prev-page
:next-page next-page
:pages (loop :for idx :from range-start :to range-end :collect idx)
:show-start-gap (> range-start 2)
:show-end-gap (< range-end (1- page-count))
:start-index (if (> count 0) (1+ offset) 0)
:end-index (if (> count 0) (min count (+ offset (length posts))) 0))))))
(defun post-likes (params)
(let* ((user (gethash :user ningle:*session*))
(post (mito:find-dao 'ningle-tutorial-project/models:post :id (parse-integer (ingle:get-param :id params))))
(res (make-hash-table :test 'equal)))
;; Bail out if post does not exist
(unless post
(setf (getf (lack.response:response-headers ningle:*response*) :content-type) "application/json")
(setf (gethash "error" res) "post not found")
(setf (lack.response:response-status ningle:*response*) 404)
(return-from post-likes (com.inuoe.jzon.stringify res)))
;; success, continue
(setf (gethash "post" res) (mito:object-id post))
(setf (gethash "liked" res) (ningle-tutorial-project/models:toggle-like user post))
(setf (gethash "likes" res) (ningle-tutorial-project/models:likes post))
(setf (getf (lack.response:response-headers ningle:*response*) :content-type) "application/json")
(setf (lack.response:response-status ningle:*response*) 201)
(com.inuoe.jzon:stringify res)))
(defun single-post (params)
(handler-case
(let ((post (mito:find-dao 'ningle-tutorial-project/models:post :id (parse-integer (ingle:get-param :id params))))
(form (cl-forms:find-form 'comment)))
(cl-forms:set-field-value form 'ningle-tutorial-project/forms:parent (mito:object-id post))
(djula:render-template* "main/post.html" nil
:title "Post"
:post post
:comments (ningle-tutorial-project/models:comments post (gethash :user ningle:*session*))
:likes (ningle-tutorial-project/models:likes post)
:form form
:user (gethash :user ningle:*session*)))
(parse-error (err)
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error err))))
(defun post-content (params)
(let ((user (gethash :user ningle:*session*))
(form (cl-forms:find-form 'post)))
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (content) form
(mito:create-dao 'ningle-tutorial-project/models:post :content content :user user :parent nil)
(ingle:redirect "/")))))
(simple-error (err)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error err)))))
(defun post-comment (params)
(let ((user (gethash :user ningle:*session*))
(form (cl-forms:find-form 'comment)))
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (content parent) form
(mito:create-dao 'ningle-tutorial-project/models:post :content content :user user :parent (parse-integer parent))
(ingle:redirect "/")))))
(simple-error (err)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error err)))))
(defun logged-in-profile (params)
(let ((user (gethash :user ningle:*session*)))
(djula:render-template* "main/profile.html" nil :title "Profile" :user user)))
(defun unauthorized-profile (params)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error "Unauthorized"))
(defun people (params)
(let ((users (mito:retrieve-dao 'ningle-auth/models:user)))
(djula:render-template* "main/people.html" nil :title "People" :users users :user (cu-sith:logged-in-p))))
(defun person (params)
(let* ((username-or-email (ingle:get-param :person params))
(person (first (mito:select-dao
'ningle-auth/models:user
(where (:or (:= :username username-or-email)
(:= :email username-or-email)))))))
(djula:render-template* "main/person.html" nil :title "Person" :person person :user (cu-sith:logged-in-p))))
{% extends "base.html" %}
{% block content %}
<div class="container">
<!-- Post form -->
<div class="row mb-4">
<div class="col">
{% if form %}
{% form form %}
{% endif %}
</div>
</div>
<!-- Posts Section -->
{% include "partials/pagination.html" with url="/" title="Posts" %}
<div class="row">
<div class="col-12">
{% for post in posts %}
<div class="card post mb-3" data-href="/post/{{ post.id }}">
<div class="card-body">
<h5 class="card-title mb-2">{{ post.content }}</h5>
<p class="card-subtitle text-muted mb-0">@{{ post.username }}</p>
</div>
<div class="card-footer d-flex justify-content-between align-items-center">
<button type="button"
class="btn btn-sm btn-outline-primary like-button"
data-post-id="{{ post.id }}"
data-logged-in="{% if user.username != "" %}true{% else %}false{% endif %}"
data-liked="{% if post.liked-by-user == 1 %}1{% else %}0{% endif %}"
aria-label="Like post {{ post.id }}">
{% if post.liked-by-user == 1 %}
<i class="bi bi-hand-thumbs-up-fill text-primary" aria-hidden="true"></i>
{% else %}
<i class="bi bi-hand-thumbs-up text-muted" aria-hidden="true"></i>
{% endif %}
<span class="ms-1 like-count">{{ post.like-count }}</span>
</button>
<small class="text-muted">Posted on: {{ post.created-at }}</small>
</div>
</div>
{% endfor %}
{% if not posts %}
<div class="text-center">
<p class="text-muted">No posts to display.</p>
</div>
{% endif %}
</div>
</div>
{% include "partials/pagination.html" with url="/" title="Posts" %}
</div>
{% endblock %}
{% block js %}
document.querySelectorAll(".like-button").forEach(btn => {
btn.addEventListener("click", function (e) {
e.stopPropagation();
e.preventDefault();
// Check login
if (btn.dataset.loggedIn !== "true") {
alert("You must be logged in to like posts.");
return;
}
const postId = btn.dataset.postId;
const countSpan = btn.querySelector(".like-count");
const icon = btn.querySelector("i");
const liked = Number(btn.dataset.liked) === 1;
const previous = parseInt(countSpan.textContent, 10) || 0;
const url = `/post/${postId}/likes`;
// Optimistic UI toggle
countSpan.textContent = liked ? previous - 1 : previous + 1;
btn.dataset.liked = liked ? "false" : "true";
// Toggle icon classes optimistically
if (liked) {
// Currently liked, so unlike it
icon.className = "bi bi-hand-thumbs-up text-muted";
} else {
// Currently not liked, so like it
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
}
const csrfTokenMeta = document.querySelector('meta[name="csrf-token"]');
const headers = { "Content-Type": "application/json" };
if (csrfTokenMeta) headers["X-CSRF-Token"] = csrfTokenMeta.getAttribute("content");
fetch(url, {
method: "POST",
headers: headers,
body: JSON.stringify({ toggle: true })
})
.then(resp => {
if (!resp.ok) {
// Revert optimistic changes on error
countSpan.textContent = previous;
btn.dataset.liked = liked ? 1 : 0;
if (liked) {
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
} else {
icon.className = "bi bi-hand-thumbs-up text-muted";
}
throw new Error("Network response was not ok");
}
return resp.json();
})
.then(data => {
if (data && typeof data.likes !== "undefined") {
countSpan.textContent = data.likes;
btn.dataset.liked = data.liked ? "true" : "false";
// Update icon based on server response
if (data.liked) {
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
} else {
icon.className = "bi bi-hand-thumbs-up text-muted";
}
}
})
.catch(err => {
console.error("Like failed:", err);
// Revert optimistic changes on error
countSpan.textContent = previous;
btn.dataset.liked = liked ? 1 : 0;
if (liked) {
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
} else {
icon.className = "bi bi-hand-thumbs-up text-muted";
}
});
});
});
document.querySelectorAll(".card.post").forEach(card => {
card.addEventListener("click", function () {
const href = card.dataset.href;
if (href) {
window.location.href = href;
}
});
});
{% endblock %}
{% if page-count > 1 %}
<div class="table-pagination">
<div class="pagination-summary">
Showing {{ start-index }}-{{ end-index }} of {{ count }}
</div>
<nav aria-label="{{ title }} pagination">
<ul class="pagination">
<li class="page-item{% if not prev-page %} disabled{% endif %}">
{% if prev-page %}
<a class="page-link" href="{{ url }}?page={{ prev-page }}&limit={{ limit }}">Prev</a>
{% else %}
<span class="page-link">Prev</span>
{% endif %}
</li>
<li class="page-item{% if page == 1 %} active{% endif %}">
{% if page == 1 %}
<span class="page-link">1</span>
{% else %}
<a class="page-link" href="{{ url }}?page=1&limit={{ limit }}">1</a>
{% endif %}
</li>
{% if show-start-gap %}
<li class="page-item disabled"><span class="page-link">...</span></li>
{% endif %}
{% for p in pages %}
{% if p != 1 and p != page-count %}
<li class="page-item{% if p == page %} active{% endif %}">
{% if p == page %}
<span class="page-link">{{ p }}</span>
{% else %}
<a class="page-link" href="{{ url }}?page={{ p }}&limit={{ limit }}">{{ p }}</a>
{% endif %}
</li>
{% endif %}
{% endfor %}
{% if show-end-gap %}
<li class="page-item disabled"><span class="page-link">...</span></li>
{% endif %}
<li class="page-item{% if page == page-count %} active{% endif %}">
{% if page == page-count %}
<span class="page-link">{{ page-count }}</span>
{% else %}
<a class="page-link" href="{{ url }}?page={{ page-count }}&limit={{ limit }}">{{ page-count }}</a>
{% endif %}
</li>
<li class="page-item{% if not next-page %} disabled{% endif %}">
{% if next-page %}
<a class="page-link" href="{{ url }}?page={{ next-page }}&limit={{ limit }}">Next</a>
{% else %}
<span class="page-link">Next</span>
{% endif %}
</li>
</ul>
</nav>
</div>
{% endif %}
Phew, that was a long one, and honestly it kinda got into the weeds a bit, thank you for persisting with it and following it to the end. It took quite a while to study and get right. As you no doubt felt while writing it, there was a LOT of calculations and data being passed into the template, and it would be awful to have to repeat that everywhere you wanted to perform pagination, but don’t worry in part 2, this is what we want to try and solve. A more generalised pagination system that doesn’t require quite so much logic in the controllers.
If you found this lesson helpful, consider experimenting with different page sizes or adding pagination to the comments on individual posts. The patterns we’ve established here are reusable throughout your application.
If you found bugs or issues, please do let me know, I correct things when told and I try to fix things as quickly as possible.
| Level | Learning Outcome |
|---|---|
| Understand | Understand how SQL LIMIT and OFFSET work together to enable pagination, and how query parameters like ?page=2&limit=50 map to database queries through SXQL’s (sxql:limit n) and (sxql:offset n) forms. |
| Apply | Apply CLOS method combination (:around methods with call-next-method) to implement parameter validation and error recovery, ensuring offset never exceeds total count and calculating corrected page numbers when needed. |
| Analyse | Analyse the mathematical relationships in pagination (page-to-offset conversion, range calculations, gap detection) and trace how values flow through the :around method, primary methods, controller calculations, and template rendering. |
| Create | Create a complete pagination system by combining :around methods, SQL queries with LIMIT/OFFSET, controller calculations (page/offset conversions, range calculations), and reusable template partials that handle edge cases like invalid page numbers and single-page results. |
| Symbol | Type | Why it appears in this lesson | CLHS |
|---|---|---|---|
defpackage |
Macro | Define project packages like ningle-tutorial-project/models, /forms, /controllers. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defpac.htm |
in-package |
Macro | Enter each package before defining models, controllers, and functions. | http://www.lispworks.com/documentation/HyperSpec/Body/m_in_pkg.htm |
defgeneric |
Macro | Define the generic posts function signature with keyword parameters offset, limit, and count. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defgen.htm |
defmethod |
Macro | Implement specialized posts methods for user and null types, and the :around method for validation. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defmet.htm |
call-next-method |
Function | Invoke the next most specific method from within the :around method after validating parameters. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_call_n.htm |
let |
Special Operator | Bind local variables in the :around method (count, offset, limit) and controller (user, page, limit). |
http://www.lispworks.com/documentation/HyperSpec/Body/s_let_l.htm |
let* |
Special Operator | Sequentially bind pagination calculations (page, page-count, prev-page, etc.) where each depends on previous values. |
http://www.lispworks.com/documentation/HyperSpec/Body/s_let_l.htm |
if |
Special Operator | Check conditions like whether offset exceeds count, or whether count is greater than zero. | http://www.lispworks.com/documentation/HyperSpec/Body/s_if.htm |
when |
Macro | Calculate prev-page and next-page only when the condition is true, returning nil otherwise. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_when_.htm |
or |
Macro | Provide fallback values when parsing page and limit parameters, defaulting to 1 and 50 respectively. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_or.htm |
and |
Macro | Check multiple conditions in the :around method (count > 0 AND offset >= count) before recalculating. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_and.htm |
multiple-value-bind |
Macro | Capture the three return values from posts (posts, count, offset) and from sxql:yield (sql, params). |
http://www.lispworks.com/documentation/HyperSpec/Body/m_multip.htm |
values |
Function | Return multiple values from posts methods (results, count, offset) to the caller. |
http://www.lispworks.com/documentation/HyperSpec/Body/a_values.htm |
loop |
Macro | Generate the list of page numbers from range-start to range-end for template rendering. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_loop.htm |
parse-integer |
Function | Convert string query parameters ("1", "50") to integers, with :junk-allowed t for safe parsing. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_parse_.htm |
floor |
Function | Round down the result of offset / limit to calculate the current page number. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_floorc.htm |
ceiling |
Function | Round up the result of count / limit to calculate the total number of pages. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_floorc.htm |
max |
Function | Ensure offset and limit never go below their minimum valid values (0 and 1), and calculate range-start. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_max_m.htm |
min |
Function | Ensure range-end doesn’t exceed page-count and calculate end-index correctly. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_max_m.htm |
1+ / 1- |
Function | Increment/decrement page numbers for navigation (next/previous page, page number conversions). | [http://www.lispworks.com/documentation/HyperSpec/Body/f_1pl_1.htm](http://www.lispworks.com/documentation/HyperSpec/Body/f_1pl_1.htm) |
length |
Function | Get the count of posts returned to calculate end-index accurately. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_length.htm |
Hello and welcome back, I hope you are well! In this tutorial we will be exploring how to work with comments, I originally didn’t think I would add too many Twitter like features, but I realised that having a self-referential model would actually be a useful lesson. In addition to demonstrating how to achieve this, we can look at how to complete a migration successfully.
This will involve us adjusting our models, adding a form (and respective validator), improving and expanding our controllers, adding the appropriate controller to our app and tweak our templates to accomodate the changes.
Note: There is also an improvement to be made in our models code, mito provides a convenience method to get the id, created-at, and updated-at slots. We will integrate it as we alter our models.
When it comes to changes to the post model it is very important that the :col-type is set to (or :post :null) and that :initform nil is also set. This is because when you run the migrations, existing rows will not have data for the parent column and so in the process of migration we have to provide a default. It should be possible to use (or :post :integer) and set :initform 0 if you so wished, but I chose to use :null and nil as my migration pattern.
This also ensures that new posts default to having no parent, which is the right design choice here.
(defpackage ningle-tutorial-project/models
(:use :cl :mito :sxql)
(:import-from :ningle-auth/models #:user)
(:export #:post
#:id
#:content
+ #:comments
#:likes
#:user
#:liked-post-p
- #:logged-in-posts
- #:not-logged-in-posts
+ #:posts
+ #:parent
#:toggle-like))
(in-package ningle-tutorial-project/models)
(deftable post ()
((user :col-type ningle-auth/models:user :initarg :user :accessor user)
+ (parent :col-type (or :post :null) :initarg :parent :reader parent :initform nil)
(content :col-type (:varchar 140) :initarg :content :accessor content)))
Comments are really a specialist type of post that happens to have a non-nil parent value, we will take what we previously learned from working with post objects and extend it. In reality the only real difference is (sxql:where (:= parent :?)), perhaps I shall see if this could support conditionals inside it, but that’s another experiment for another day.
I want to briefly remind you of what the :? does, as security is important!
The :? is a placeholder, it is a way to ensure that values are not placed in the SQL without being escaped, this prevents SQL Injection attacks, the retrieve-by-sql takes a key argument :binds which takes a list of values that will be interpolated into the right parts of the SQL query with the correct quoting.
We used this previously, but I want to remind you to not just inject values into a SQL query without quoting them.
(defmethod likes ((post post))
(mito:count-dao 'likes :post post))
+(defgeneric comments (post user)
+ (:documentation "Gets the comments for a logged in user"))
+
+(defmethod comments ((post post) (user user))
+ (mito:retrieve-by-sql
+ (sxql:yield
+ (sxql:select
+ (:post.*
+ (:as :user.username :username)
+ (:as (:count :likes.id) :like_count)
+ (:as (:count :user_likes.id) :liked_by_user))
+ (sxql:from :post)
+ (sxql:where (:= :parent :?))
+ (sxql:left-join :user :on (:= :post.user_id :user.id))
+ (sxql:left-join :likes :on (:= :post.id :likes.post_id))
+ (sxql:left-join (:as :likes :user_likes)
+ :on (:and (:= :post.id :user_likes.post_id)
+ (:= :user_likes.user_id :?)))
+ (sxql:group-by :post.id)
+ (sxql:order-by (:desc :post.created_at))
+ (sxql:limit 50)))
+ :binds (list (mito:object-id post) (mito:object-id user))))
+
+(defmethod comments ((post post) (user null))
+ (mito:retrieve-by-sql
+ (sxql:yield
+ (sxql:select
+ (:post.*
+ (:as :user.username :username)
+ (:as (:count :likes.id) :like_count))
+ (sxql:from :post)
+ (sxql:where (:= :parent :?))
+ (sxql:left-join :user :on (:= :post.user_id :user.id))
+ (sxql:left-join :likes :on (:= :post.id :likes.post_id))
+ (sxql:group-by :post.id)
+ (sxql:order-by (:desc :post.created_at))
+ (sxql:limit 50)))
+ :binds (list (mito:object-id post))))
I had not originally planned on this, but as I was writing the comments code it became clear that I was creating lots of duplication, and maybe I still am, but I hit upon a way to simplify the model interface, at least. Ideally it makes no difference if a user is logged in or not at the point the route is hit, the api should be to give the user object (whatever that might be, because it may be nil) and let a specialised method figure out what to do there. So in addition to adding comments (which is what prompted this change) we will also slightly refactor the posts logged-in-posts and not-logged-in-posts into a single, unified posts method cos it’s silly of me to have split them like that.
(defmethod liked-post-p ((ningle-auth/models:user user) (post post))
(mito:find-dao 'likes :user user :post post))
-(defgeneric logged-in-posts (user)
- (:documentation "Gets the posts for a logged in user"))
+(defgeneric posts (user)
+ (:documentation "Gets the posts"))
+
-(defmethod logged-in-posts ((user user))
- (let ((uuid (slot-value user 'mito.dao.mixin::id)))
+(defmethod posts ((user user))
+ (mito:retrieve-by-sql
+ (sxql:yield
+ (sxql:select
+ (:post.*
+ (:as :user.username :username)
+ (:as (:count :likes.id) :like_count)
+ (:as (:count :user_likes.id) :liked_by_user))
+ (sxql:from :post)
+ (sxql:left-join :user :on (:= :post.user_id :user.id))
+ (sxql:left-join :likes :on (:= :post.id :likes.post_id))
+ (sxql:left-join (:as :likes :user_likes)
+ :on (:and (:= :post.id :user_likes.post_id)
+ (:= :user_likes.user_id :?)))
+ (sxql:group-by :post.id)
+ (sxql:order-by (:desc :post.created_at))
+ (sxql:limit 50)))
+ :binds (list (mito:object-id user))))
+
-(defun not-logged-in-posts ()
+(defmethod posts ((user null))
+ (mito:retrieve-by-sql
+ (sxql:yield
+ (sxql:select
+ (:post.*
+ (:as :user.username :username)
+ (:as (:count :likes.id) :like_count))
+ (sxql:from :post)
+ (sxql:left-join :user :on (:= :post.user_id :user.id))
+ (sxql:left-join :likes :on (:= :post.id :likes.post_id))
+ (sxql:group-by :post.id)
+ (sxql:order-by (:desc :post.created_at))
+ (sxql:limit 50)))))
There is also another small fix in this code, turns out there’s a set of convenience methods that mito provides:
Previously we used mito.dao.mixin::id (and could have done the same for create-at, and updated-at), in combination with slot-value, which means (slot-value user 'mito.dao.mixin::id') simply becomes (mito:object-id user), which is much nicer!
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
(defpackage ningle-tutorial-project/models
(:use :cl :mito :sxql)
(:import-from :ningle-auth/models #:user)
(:export #:post
#:id
#:content
#:comments
#:likes
#:user
#:liked-post-p
#:posts
#:parent
#:toggle-like))
(in-package ningle-tutorial-project/models)
(deftable post ()
((user :col-type ningle-auth/models:user :initarg :user :accessor user)
(parent :col-type (or :post :null) :initarg :parent :reader parent :initform nil)
(content :col-type (:varchar 140) :initarg :content :accessor content)))
(deftable likes ()
((user :col-type ningle-auth/models:user :initarg :user :reader user)
(post :col-type post :initarg :post :reader post))
(:unique-keys (user post)))
(defgeneric likes (post)
(:documentation "Returns the number of likes a post has"))
(defmethod likes ((post post))
(mito:count-dao 'likes :post post))
(defgeneric comments (post user)
(:documentation "Gets the comments for a logged in user"))
(defmethod comments ((post post) (user user))
(mito:retrieve-by-sql
(sxql:yield
(sxql:select
(:post.*
(:as :user.username :username)
(:as (:count :likes.id) :like_count)
(:as (:count :user_likes.id) :liked_by_user))
(sxql:from :post)
(sxql:where (:= :parent :?))
(sxql:left-join :user :on (:= :post.user_id :user.id))
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:left-join (:as :likes :user_likes)
:on (:and (:= :post.id :user_likes.post_id)
(:= :user_likes.user_id :?)))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))
:binds (list (mito:object-id post) (mito:object-id user))))
(defmethod comments ((post post) (user null))
(mito:retrieve-by-sql
(sxql:yield
(sxql:select
(:post.*
(:as :user.username :username)
(:as (:count :likes.id) :like_count))
(sxql:from :post)
(sxql:where (:= :parent :?))
(sxql:left-join :user :on (:= :post.user_id :user.id))
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))
:binds (list (mito:object-id post))))
(defgeneric toggle-like (user post)
(:documentation "Toggles the like of a user to a given post"))
(defmethod toggle-like ((ningle-auth/models:user user) (post post))
(let ((liked-post (liked-post-p user post)))
(if liked-post
(mito:delete-dao liked-post)
(mito:create-dao 'likes :post post :user user))
(not liked-post)))
(defgeneric liked-post-p (user post)
(:documentation "Returns true if a user likes a given post"))
(defmethod liked-post-p ((ningle-auth/models:user user) (post post))
(mito:find-dao 'likes :user user :post post))
(defgeneric posts (user)
(:documentation "Gets the posts"))
(defmethod posts ((user user))
(mito:retrieve-by-sql
(sxql:yield
(sxql:select
(:post.*
(:as :user.username :username)
(:as (:count :likes.id) :like_count)
(:as (:count :user_likes.id) :liked_by_user))
(sxql:from :post)
(sxql:left-join :user :on (:= :post.user_id :user.id))
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:left-join (:as :likes :user_likes)
:on (:and (:= :post.id :user_likes.post_id)
(:= :user_likes.user_id :?)))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))
:binds (list (mito:object-id user))))
(defmethod posts ((user null))
(mito:retrieve-by-sql
(sxql:yield
(sxql:select
(:post.*
(:as :user.username :username)
(:as (:count :likes.id) :like_count))
(sxql:from :post)
(sxql:left-join :user :on (:= :post.user_id :user.id))
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))))
All we have to do here is define our form and validators and ensure they are exported, not really a lot of work!
(defpackage ningle-tutorial-project/forms
(:use :cl :cl-forms)
(:export #:post
#:content
- #:submit))
+ #:submit
+ #:comment
+ #:parent))
(in-package ningle-tutorial-project/forms)
(defparameter *post-validator* (list (clavier:not-blank)
(clavier:is-a-string)
(clavier:len :max 140)))
+(defparameter *post-parent-validator* (list (clavier:not-blank)
+ (clavier:fn (lambda (x) (> (parse-integer x) 0)) "Checks positive integer")))
(defform post (:id "post" :csrf-protection t :csrf-field-name "csrftoken" :action "/post")
((content :string :value "" :constraints *post-validator*)
(submit :submit :label "Post")))
+(defform comment (:id "post" :csrf-protection t :csrf-field-name "csrftoken" :action "/post/comment")
+ ((content :string :value "" :constraints *post-validator*)
+ (parent :hidden :value 0 :constraints *post-parent-validator*)
+ (submit :submit :label "Post")))
In our *post-parent-validator* we validate that the content of the parent field is not blank (as it is a comment and needs a reference to a parent) and we used a custom validator using clavier:fn and passing a lambda to verify the item is a positive integer.
We then create our comment form, which is very similar to our existing post form, with the difference of pointing to a different http endpoint /post/comment rather than just /post, and we have a hidden parent slot, which we set to 0 by default, so by default the form will be invalid, but that’s ok, because we can’t possibly know what the parent id would be until the form is rendered and we can set the parent id value at the point we render the form, so it really is nothing to worry about.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
(defpackage ningle-tutorial-project/forms
(:use :cl :cl-forms)
(:export #:post
#:content
#:submit
#:comment
#:parent))
(in-package ningle-tutorial-project/forms)
(defparameter *post-validator* (list (clavier:not-blank)
(clavier:is-a-string)
(clavier:len :max 140)))
(defparameter *post-parent-validator* (list (clavier:not-blank)
(clavier:fn (lambda (x) (> (parse-integer x) 0)) "Checks positive integer")))
(defform post (:id "post" :csrf-protection t :csrf-field-name "csrftoken" :action "/post")
((content :string :value "" :constraints *post-validator*)
(submit :submit :label "Post")))
(defform comment (:id "post" :csrf-protection t :csrf-field-name "csrftoken" :action "/post/comment")
((content :string :value "" :constraints *post-validator*)
(parent :hidden :value 0 :constraints *post-parent-validator*)
(submit :submit :label "Post")))
Having simplified the models, we can also simplify the controllers!
Let’s start by setting up our package information:
(defpackage ningle-tutorial-project/controllers
- (:use :cl :sxql :ningle-tutorial-project/forms)
+ (:use :cl :sxql)
+ (:import-from :ningle-tutorial-project/forms
+ #:post
+ #:content
+ #:parent
+ #:comment)
- (:export #:logged-in-index
- #:index
+ (:export #:index
#:post-likes
#:single-post
#:post-content
+ #:post-comment
#:logged-in-profile
#:unauthorized-profile
#:people
#:person))
(in-package ningle-tutorial-project/controllers)
The index and logged-in-index can now be consolidated:
-(defun logged-in-index (params)
+(defun index (params)
(let* ((user (gethash :user ningle:*session*))
- (form (cl-forms:find-form 'post))
- (posts (ningle-tutorial-project/models:logged-in-posts user)))
- (djula:render-template* "main/index.html" nil :title "Home" :user user :posts posts :form form)))
-
-
-(defun index (params))
-(let ((posts (ningle-tutorial-project/models:not-logged-in-posts)))
- (djula:render-template* "main/index.html" nil :title "Home" :user (gethash :user ningle:*session*) :posts posts)))
+ (posts (ningle-tutorial-project/models:posts user))
+ (djula:render-template* "main/index.html" nil :title "Home" :user user :posts posts :form (if user (cl-forms:find-form 'post) nil))))
Our post-likes controller comes next:
(defun post-likes (params)
(let* ((user (gethash :user ningle:*session*))
(post (mito:find-dao 'ningle-tutorial-project/models:post :id (parse-integer (ingle:get-param :id params))))
(res (make-hash-table :test 'equal)))
- (setf (gethash :post res) (parse-integer (ingle:get-param :id params)) )
- (setf (gethash :likes res) (ningle-tutorial-project/models:likes post))
- (setf (gethash :liked res) (ningle-tutorial-project/models:toggle-like user post))
+ ;; Bail out if post does not exist
+ (unless post
+ (setf (gethash "error" res) "post not found")
+ (setf (getf (lack.response:response-headers ningle:*response*) :content-type) "application/json")
+ (setf (lack.response:response-status ningle:*response*) 404)
+ (return-from post-likes (com.inuoe.jzon.stringify res)))
+
+ (setf (gethash "post" res) (mito:object-id post))
+ (setf (gethash "liked" res) (ningle-tutorial-project/models:toggle-like user post))
+ (setf (gethash "likes" res) (ningle-tutorial-project/models:likes post))
+ (setf (getf (lack.response:response-headers ningle:*response*) :content-type) "application/json")
+ (setf (lack.response:response-status ningle:*response*) 201)
+ (com.inuoe.jzon:stringify res)))
Here we begin by first checking that the post exists, if for some reason someone sent a request to our server without a valid post an error might be thrown and no response would be sent at all, which is not good, so we use unless as our “if not” check to return the standard http code for not found, the good old 404!
If however there is no error (a post matching the id exists) we can continue, we build up the hash-table, including the “post”, “liked”, and “likes” properties of a post. Remember these are not direct properties of a post model, but calculated based on information in other tables, especially the toggle-like (actually it’s very important to ensure you call toggle-like first, as it changes the db state that calling likes will depend on), as it returns the toggled status, that is, if a user clicks it once it will like the post, but if they click it again it will “unlike” the post.
Now, with our single post, we have implemented a lot more information, comments, likes, our new comment form, etc so we have to really build up a more comprehensive single-post controller.
(defun single-post (params)
(handler-case
- (let ((post (mito:find-dao 'ningle-tutorial-project/models:post :id (parse-integer (ingle:get-param :id params)))))
- (djula:render-template* "main/post.html" nil :title "Post" :post post))
+
+ (let* ((post-id (parse-integer (ingle:get-param :id params)))
+ (post (mito:find-dao 'ningle-tutorial-project/models:post :id post-id))
+ (comments (ningle-tutorial-project/models:comments post (gethash :user ningle:*session*)))
+ (likes (ningle-tutorial-project/models:likes post))
+ (form (cl-forms:find-form 'comment))
+ (user (gethash :user ningle:*session*)))
+ (cl-forms:set-field-value form 'ningle-tutorial-project/forms:parent post-id)
+ (djula:render-template* "main/post.html" nil
+ :title "Post"
+ :post post
+ :comments comments
+ :likes likes
+ :form form
+ :user user))
(parse-error (err)
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error err))))
Where previously we just rendered the template, we now do a lot more! We can get the likes, comments etc which is a massive step up in functionality.
The next function to look at is post-content, thankfully there isn’t too much to change here, all we need to do is ensure we pass through the parent (which will be nil).
(when valid
(cl-forms:with-form-field-values (content) form
- (mito:create-dao 'ningle-tutorial-project/models:post :content content :user user)
+ (mito:create-dao 'ningle-tutorial-project/models:post :content content :user user :parent nil)
(ingle:redirect "/")))))
Now, finally in our controllers we add the post-comment controller.
+(defun post-comment (params)
+ (let ((user (gethash :user ningle:*session*))
+ (form (cl-forms:find-form 'comment)))
+ (handler-case
+ (progn
+ (cl-forms:handle-request form) ; Can throw an error if CSRF fails
+
+ (multiple-value-bind (valid errors)
+ (cl-forms:validate-form form)
+
+ (when errors
+ (format t "Errors: ~A~%" errors))
+
+ (when valid
+ (cl-forms:with-form-field-values (content parent) form
+ (mito:create-dao 'ningle-tutorial-project/models:post :content content :user user :parent (parse-integer parent))
+ (ingle:redirect "/")))))
+
+ (simple-error (err)
+ (setf (lack.response:response-status ningle:*response*) 403)
+ (djula:render-template* "error.html" nil :title "Error" :error err)))))
We have seen this pattern before, but with some minor differences in which form to load (comment instead of post), and setting the parent from the value injected into the form at the point the form is rendered.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
(defpackage ningle-tutorial-project/controllers
(:use :cl :sxql)
(:import-from :ningle-tutorial-project/forms
#:post
#:content
#:parent
#:comment)
(:export #:index
#:post-likes
#:single-post
#:post-content
#:post-comment
#:logged-in-profile
#:unauthorized-profile
#:people
#:person))
(in-package ningle-tutorial-project/controllers)
(defun index (params)
(let* ((user (gethash :user ningle:*session*))
(posts (ningle-tutorial-project/models:posts user)))
(djula:render-template* "main/index.html" nil :title "Home" :user user :posts posts :form (if user (cl-forms:find-form 'post) nil))))
(defun post-likes (params)
(let* ((user (gethash :user ningle:*session*))
(post (mito:find-dao 'ningle-tutorial-project/models:post :id (parse-integer (ingle:get-param :id params))))
(res (make-hash-table :test 'equal)))
;; Bail out if post does not exist
(unless post
(setf (getf (lack.response:response-headers ningle:*response*) :content-type) "application/json")
(setf (gethash "error" res) "post not found")
(setf (lack.response:response-status ningle:*response*) 404)
(return-from post-likes (com.inuoe.jzon.stringify res)))
;; success, continue
(setf (gethash "post" res) (mito:object-id post))
(setf (gethash "liked" res) (ningle-tutorial-project/models:toggle-like user post))
(setf (gethash "likes" res) (ningle-tutorial-project/models:likes post))
(setf (getf (lack.response:response-headers ningle:*response*) :content-type) "application/json")
(setf (lack.response:response-status ningle:*response*) 201)
(com.inuoe.jzon:stringify res)))
(defun single-post (params)
(handler-case
(let ((post (mito:find-dao 'ningle-tutorial-project/models:post :id (parse-integer (ingle:get-param :id params))))
(form (cl-forms:find-form 'comment)))
(cl-forms:set-field-value form 'ningle-tutorial-project/forms:parent (mito:object-id post))
(djula:render-template* "main/post.html" nil
:title "Post"
:post post
:comments (ningle-tutorial-project/models:comments post (gethash :user ningle:*session*))
:likes (ningle-tutorial-project/models:likes post)
:form form
:user (gethash :user ningle:*session*)))
(parse-error (err)
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error err))))
(defun post-content (params)
(let ((user (gethash :user ningle:*session*))
(form (cl-forms:find-form 'post)))
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (content) form
(mito:create-dao 'ningle-tutorial-project/models:post :content content :user user :parent nil)
(ingle:redirect "/")))))
(simple-error (err)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error err)))))
(defun post-comment (params)
(let ((user (gethash :user ningle:*session*))
(form (cl-forms:find-form 'comment)))
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (content parent) form
(mito:create-dao 'ningle-tutorial-project/models:post :content content :user user :parent (parse-integer parent))
(ingle:redirect "/")))))
(simple-error (err)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error err)))))
(defun logged-in-profile (params)
(let ((user (gethash :user ningle:*session*)))
(djula:render-template* "main/profile.html" nil :title "Profile" :user user)))
(defun unauthorized-profile (params)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error "Unauthorized"))
(defun people (params)
(let ((users (mito:retrieve-dao 'ningle-auth/models:user)))
(djula:render-template* "main/people.html" nil :title "People" :users users :user (cu-sith:logged-in-p))))
(defun person (params)
(let* ((username-or-email (ingle:get-param :person params))
(person (first (mito:select-dao
'ningle-auth/models:user
(where (:or (:= :username username-or-email)
(:= :email username-or-email)))))))
(djula:render-template* "main/person.html" nil :title "Person" :person person :user (cu-sith:logged-in-p))))
The change to our main.lisp file is a single line that connects our controller to the urls we have declared we are using.
(setf (ningle:route *app* "/post" :method :POST :logged-in-p t) #'post-content)
+(setf (ningle:route *app* "/post/comment" :method :POST :logged-in-p t) #'post-comment)
(setf (ningle:route *app* "/profile" :logged-in-p t) #'logged-in-profile)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
(defpackage ningle-tutorial-project
(:use :cl :ningle-tutorial-project/controllers)
(:export #:start
#:stop))
(in-package ningle-tutorial-project)
(defvar *app* (make-instance 'ningle:app))
;; requirements
(setf (ningle:requirement *app* :logged-in-p)
(lambda (value)
(and (cu-sith:logged-in-p) value)))
;; routes
(setf (ningle:route *app* "/") #'index)
(setf (ningle:route *app* "/post/:id/likes" :method :POST :logged-in-p t) #'post-likes)
(setf (ningle:route *app* "/post/:id") #'single-post)
(setf (ningle:route *app* "/post" :method :POST :logged-in-p t) #'post-content)
(setf (ningle:route *app* "/post/comment" :method :POST :logged-in-p t) #'post-comment)
(setf (ningle:route *app* "/profile" :logged-in-p t) #'logged-in-profile)
(setf (ningle:route *app* "/profile") #'unauthorized-profile)
(setf (ningle:route *app* "/people") #'people)
(setf (ningle:route *app* "/people/:person") #'person)
(defmethod ningle:not-found ((app ningle:<app>))
(declare (ignore app))
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error "Not Found"))
(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
(djula:set-static-url "/public/")
(clack:clackup
(lack.builder:builder (envy-ningle:build-middleware :ningle-tutorial-project/config *app*))
:server server
:address address
:port port))
(defun stop (instance)
(clack:stop instance))
There are some small changes needed in the index.html file, they’re largely just optimisations. The first is changing a boolean around likes to integer, this gets into the weeds of JavaScript types, and ensuring things were of the Number type in JS just made things easier. Some of the previous code even treated booleans as strings, which was pretty bad, I don’t write JS in any real capacity, so I often make mistakes with it, because it so very often appears to work instead of just throwing an error.
~ Lines 28 - 30
data-logged-in="true"
- data-liked="false"
+ data-liked="0"
aria-label="Like post ">
~ Lines 68 - 70
const icon = btn.querySelector("i");
- const liked = btn.dataset.liked === "true";
+ const liked = Number(btn.dataset.liked) === 1;
const previous = parseInt(countSpan.textContent, 10) || 0;
~ Lines 96 - 100
if (!resp.ok) {
// Revert optimistic changes on error
countSpan.textContent = previous;
countSpan.textContent = previous;
- btn.dataset.liked = liked ? "true" : "false";
+ btn.dataset.liked = liked ? 1 : 0;
if (liked) {
~ Lines 123 - 129
console.error("Like failed:", err);
// Revert optimistic changes on error
countSpan.textContent = previous;
- btn.dataset.liked = liked ? "true" : "false";
+ btn.dataset.liked = liked ? 1 : 0;
if (liked) {
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
} else {
The changes to this file as so substantial that the file might as well be brand new, so in the interests of clarity, I will simply show the file in full.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<div class="card post mb-3" data-href="/post/{{ post.id }}">
<div class="card-body">
<h5 class="card-title mb-2">{{ post.content }}</h5>
<p class="card-subtitle text-muted mb-0">@{{ post.user.username }}</p>
</div>
<div class="card-footer d-flex justify-content-between align-items-center">
<button type="button"
class="btn btn-sm btn-outline-primary like-button"
data-post-id="{{ post.id }}"
data-logged-in="{% if user.username != "" %}true{% else %}false{% endif %}"
data-liked="{% if post.liked-by-user == 1 %}1{% else %}0{% endif %}"
aria-label="Like post {{ post.id }}">
{% if post.liked-by-user == 1 %}
<i class="bi bi-hand-thumbs-up-fill text-primary" aria-hidden="true"></i>
{% else %}
<i class="bi bi-hand-thumbs-up text-muted" aria-hidden="true"></i>
{% endif %}
<span class="ms-1 like-count">{{ likes }}</span>
</button>
<small class="text-muted">Posted on: {{ post.created-at }}</small>
</div>
</div>
</div>
</div>
<!-- Post form -->
{% if user %}
<div class="row mb-4">
<div class="col">
{% if form %}
{% form form %}
{% endif %}
</div>
</div>
{% endif %}
{% if comments %}
<div class="row mb-4">
<div class="col-12">
<h2>Comments</h2>
</div>
</div>
{% endif %}
{% for comment in comments %}
<div class="row mb-4">
<div class="col-12">
<div class="card post mb-3" data-href="/post/{{ comment.id }}">
<div class="card-body">
<h5 class="card-title mb-2">{{ comment.content }}</h5>
<p class="card-subtitle text-muted mb-0">@{{ comment.username }}</p>
</div>
<div class="card-footer d-flex justify-content-between align-items-center">
<button type="button"
class="btn btn-sm btn-outline-primary like-button"
data-post-id="{{ comment.id }}"
data-logged-in="{% if user.username != "" %}true{% else %}false{% endif %}"
data-liked="{% if comment.liked-by-user == 1 %}1{% else %}0{% endif %}"
aria-label="Like post {{ comment.id }}">
{% if comment.liked-by-user == 1 %}
<i class="bi bi-hand-thumbs-up-fill text-primary" aria-hidden="true"></i>
{% else %}
<i class="bi bi-hand-thumbs-up text-muted" aria-hidden="true"></i>
{% endif %}
<span class="ms-1 like-count">{{ comment.like-count }}</span>
</button>
<small class="text-muted">Posted on: {{ comment.created-at }}</small>
</div>
</div>
</div>
</div>
{% endfor %}
</div>
{% endblock %}
{% block js %}
document.querySelectorAll(".like-button").forEach(btn => {
btn.addEventListener("click", function (e) {
e.stopPropagation();
e.preventDefault();
// Check login
if (btn.dataset.loggedIn !== "true") {
alert("You must be logged in to like posts.");
return;
}
const postId = btn.dataset.postId;
const countSpan = btn.querySelector(".like-count");
const icon = btn.querySelector("i");
const liked = Number(btn.dataset.liked) === 1;
const previous = parseInt(countSpan.textContent, 10) || 0;
const url = `/post/${postId}/likes`;
// Optimistic UI toggle
countSpan.textContent = liked ? previous - 1 : previous + 1;
btn.dataset.liked = liked ? 0 : 1;
// Toggle icon classes optimistically
if (liked) {
// Currently liked, so unlike it
icon.className = "bi bi-hand-thumbs-up text-muted";
} else {
// Currently not liked, so like it
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
}
const csrfTokenMeta = document.querySelector('meta[name="csrf-token"]');
const headers = { "Content-Type": "application/json" };
if (csrfTokenMeta) headers["X-CSRF-Token"] = csrfTokenMeta.getAttribute("content");
fetch(url, {
method: "POST",
headers: headers,
body: JSON.stringify({ toggle: true })
})
.then(resp => {
if (!resp.ok) {
// Revert optimistic changes on error
countSpan.textContent = previous;
btn.dataset.liked = liked ? 1 : 0;
icon.className = liked ? "bi bi-hand-thumbs-up-fill text-primary" : "bi bi-hand-thumbs-up text-muted";
throw new Error("Network response was not ok");
}
return resp.json();
})
.then(data => {
if (data && typeof data.likes !== "undefined") {
countSpan.textContent = data.likes;
btn.dataset.liked = data.liked ? 1 : 0;
icon.className = data.liked ? "bi bi-hand-thumbs-up-fill text-primary" : "bi bi-hand-thumbs-up text-muted";
}
})
.catch(err => {
console.error("Like failed:", err);
// Revert optimistic changes on error
countSpan.textContent = previous;
btn.dataset.liked = liked ? 1 : 0;
icon.className = liked ? "bi bi-hand-thumbs-up-fill text-primary" : "bi bi-hand-thumbs-up text-muted";
});
});
});
document.querySelectorAll(".card.post").forEach(card => {
card.addEventListener("click", function () {
const href = card.dataset.href;
if (href) {
window.location.href = href;
}
});
});
{% endblock %}
| Level | Learning Outcome |
|---|---|
| Understand | Understand how to model a self-referential post table in Mito (using a nullable parent column) and why (or :post :null)/:initform nil are important for safe migrations and representing “top-level” posts versus comments. |
| Apply | Apply Mito, SXQL, and cl-forms to implement a comment system end-to-end: defining comments/posts generics, adding validators (including a custom clavier:fn), wiring controllers and routes, and rendering comments and like-buttons in templates. |
| Analyse | Analyse and reduce duplication in the models/controllers layer by consolidating separate code paths (logged-in vs anonymous) into generic functions specialised on user/null, and by examining how SQL joins and binds shape the returned data. |
| Evaluate | Evaluate different design and safety choices in the implementation (nullable vs sentinel parents, optimistic UI vs server truth, HTTP status codes, SQL placeholders, CSRF and login checks) and judge which approaches are more robust and maintainable. |
| Symbol | Type | Why it appears in this lesson | CLHS |
|---|---|---|---|
defpackage |
Macro | Define project packages like ningle-tutorial-project/models, /forms, /controllers, and the main system package. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defpac.htm |
in-package |
Macro | Enter each package before defining tables, forms, controllers, and the main app functions. | http://www.lispworks.com/documentation/HyperSpec/Body/m_in_pkg.htm |
defvar |
Special Operator | Define *app* as a global Ningle application object. |
http://www.lispworks.com/documentation/HyperSpec/Body/s_defvar.htm |
defparameter |
Special Operator | Define validator configuration variables like *post-validator* and *post-parent-validator*. |
http://www.lispworks.com/documentation/HyperSpec/Body/s_defpar.htm |
defgeneric |
Macro | Declare generic functions such as likes, comments, toggle-like, liked-post-p, and posts. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defgen.htm |
defmethod |
Macro | Specialise behaviour for likes, comments, toggle-like, liked-post-p, posts, and ningle:not-found. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defmet.htm |
defun |
Macro | Define controller functions like index, post-likes, single-post, post-content, post-comment, people, person, start, etc. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defun.htm |
make-instance |
Generic Function | Create the Ningle app object: (make-instance 'ningle:app). |
http://www.lispworks.com/documentation/HyperSpec/Body/f_mk_ins.htm |
let / let* |
Special Operator | Introduce local bindings like user, posts, post, comments, likes, form, and res in controllers. |
http://www.lispworks.com/documentation/HyperSpec/Body/s_let_l.htm |
lambda |
Special Operator | Used for the :logged-in-p requirement: (lambda (value) (and (cu-sith:logged-in-p) value)). |
http://www.lispworks.com/documentation/HyperSpec/Body/s_fn_lam.htm |
setf |
Macro | Set routes, response headers/status codes, and update hash-table entries in the JSON response. | http://www.lispworks.com/documentation/HyperSpec/Body/m_setf.htm |
gethash |
Function | Access session values (e.g. the :user from ningle:*session*) and JSON keys in result hash-tables. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_gethas.htm |
make-hash-table |
Function | Build the hash-table used as the JSON response body in post-likes. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_mk_has.htm |
equal |
Function | Used as the :test function for the JSON response hash-table. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_equal.htm |
list |
Function | Build the :binds list for mito:retrieve-by-sql and other list values. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_list.htm |
first |
Accessor | Take the first result from mito:select-dao in the person controller. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_firstc.htm |
slot-value |
Function | Discussed when explaining the old pattern (slot-value user '…:id) that was replaced by mito:object-id. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_slot__.htm |
parse-integer |
Function | Convert route params and hidden form parent values into integers (post-id, parent, etc.). |
http://www.lispworks.com/documentation/HyperSpec/Body/f_parse_.htm |
format |
Function | Print validation error information in the controllers ((format t "Errors: ~A~%" errors)). |
http://www.lispworks.com/documentation/HyperSpec/Body/f_format.htm |
handler-case |
Macro | Handle parse-error for invalid ids and simple-error for CSRF failures, mapping them to 404 / 403 responses. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_hand_1.htm |
parse-error |
Condition Type | Signalled when parsing fails (e.g. malformed :id route parameters), caught in single-post. |
http://www.lispworks.com/documentation/HyperSpec/Body/e_parse_.htm |
simple-error |
Condition Type | Used to represent CSRF and similar failures caught in post-content and post-comment. |
http://www.lispworks.com/documentation/HyperSpec/Body/e_smp_er.htm |
multiple-value-bind |
Macro | Bind the (valid errors) results from cl-forms:validate-form. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_mpv_bn.htm |
progn |
Special Operator | Group side-effecting calls (handle request, validate, then create/redirect) under a single handler in handler-case. |
http://www.lispworks.com/documentation/HyperSpec/Body/s_progn.htm |
when |
Macro | Conditionally log validation errors and perform DAO creation only when the form is valid. | http://www.lispworks.com/documentation/HyperSpec/Body/m_when_.htm |
unless |
Macro | Early-exit error path in post-likes when the post cannot be found ((unless post … (return-from …))). |
http://www.lispworks.com/documentation/HyperSpec/Body/m_when_.htm |
return-from |
Special Operator | Non-locally return from post-likes after sending a 404 JSON response. |
http://www.lispworks.com/documentation/HyperSpec/Body/s_ret_fr.htm |
declare |
Special Operator | Used with (declare (ignore app)) in the ningle:not-found method to silence unused-argument warnings. |
http://www.lispworks.com/documentation/HyperSpec/Body/s_declar.htm |
and / or |
Macro | Logical composition in the login requirement and in the where clause for username/email matching. |
http://www.lispworks.com/documentation/HyperSpec/Body/a_and.htm |
Hello, and welcome back! We have done some pretty hefy work lately, so as we are drawing towards the end of the year we will be taking it a bit easier, we will be looking, at better organising and structuring our project. There is also a small bug we shall fix, which is in fact where we will start!
An oversight on my part last month was that a change stopped the username from appearing on posts. The solution is quite simple, little more than another join on our query.
In our logged-in-posts and not-logged-in-posts controllers, we need to make a small change, they’re basically the same two line change in both.
I will be testing out the ability to simulate the output of git diff here, so if you have feedback on this change, let me know!
(defmethod logged-in-posts ((user user))
(let ((uid (slot-value user 'mito.dao.mixin::id)))
(mito:retrieve-by-sql
(sxql:yield
(sxql:select
(:post.*
+ (:as :user.username :username) ;; Add this line
(:as (:count :likes.id) :like_count)
(:as (:count :user_likes.id) :liked_by_user))
(sxql:from :post)
+ (sxql:left-join :user :on (:= :post.user_id :user.id)) ;; Add this line
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:left-join (:as :likes :user_likes)
:on (:and (:= :post.id :user_likes.post_id)
(:= :user_likes.user_id :?)))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))
:binds (list uid))))
(defun not-logged-in-posts ()
(mito:retrieve-by-sql
(sxql:yield
(sxql:select
(:post.*
+ (:as :user.username :username) ;; Add this line
(:as (:count :likes.id) :like_count))
(sxql:from :post)
+ (sxql:left-join :user :on (:= :post.user_id :user.id)) ;; Add this line
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))))
This should now allow the usernames to come through. The reason for this is that although the “user” column would come back, it only contains a number, since it is a foreign key, so to get the rest of the actual information we must perform an sql join, so we can “join” information from different tables together.
As a result of this change though, we do need to change two template.
- <p class="card-subtitle text-muted mb-0">@{{ post.user.username }}</p>
+ <p class="card-subtitle text-muted mb-0">@{{ post.username }}</p>
- <h2>{{ post.user.username }}
+ <h2>{{ post.username }}
That should be everything we need, so onto cleaning up our project!
The clean up process is rather simple, but I find it helps. Our main.lisp file has gotten quite large and busy and it contains conceptually two things, our routing, and our controllers and while it’s certainly possible to have both in the same file, it can perhaps make the routing difficult to see, so we will be creating a new controllers.lisp file and putting our functions in there, and simply attaching the function name to the route.
We will be taking each of the functions from our main.lisp and declaring them as real functions here, of course remembering to export them from this package so that they can be accessed externally.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
(defpackage ningle-tutorial-project/controllers
(:use :cl :sxql :ningle-tutorial-project/forms)
(:export #:logged-in-index
#:index
#:post-likes
#:single-post
#:post-content
#:logged-in-profile
#:unauthorized-profile
#:people
#:person))
(in-package ningle-tutorial-project/controllers)
(defun logged-in-index (params)
(let* ((user (gethash :user ningle:*session*))
(form (cl-forms:find-form 'post))
(posts (ningle-tutorial-project/models:logged-in-posts user)))
(djula:render-template* "main/index.html" nil :title "Home" :user user :posts posts :form form)))
(defun index (params)
(let ((posts (ningle-tutorial-project/models:not-logged-in-posts)))
(djula:render-template* "main/index.html" nil :title "Home" :user (gethash :user ningle:*session*) :posts posts)))
(defun post-likes (params)
(let* ((user (gethash :user ningle:*session*))
(post (mito:find-dao 'ningle-tutorial-project/models:post :id (parse-integer (ingle:get-param :id params))))
(res (make-hash-table :test 'equal)))
(setf (gethash :post res) (ingle:get-param :id params))
(setf (gethash :likes res) (ningle-tutorial-project/models:likes post))
(setf (gethash :liked res) (ningle-tutorial-project/models:toggle-like user post))
(com.inuoe.jzon:stringify res)))
(defun single-post (params)
(handler-case
(let ((post (mito:find-dao 'ningle-tutorial-project/models:post :id (parse-integer (ingle:get-param :id params)))))
(djula:render-template* "main/post.html" nil :title "Post" :post post))
(parse-error (err)
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error err))))
(defun post-content (params)
(let ((user (gethash :user ningle:*session*))
(form (cl-forms:find-form 'post)))
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (content) form
(mito:create-dao 'ningle-tutorial-project/models:post :content content :user user)
(ingle:redirect "/")))))
(simple-error (err)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error err)))))
(defun logged-in-profile (params)
(let ((user (gethash :user ningle:*session*)))
(djula:render-template* "main/profile.html" nil :title "Profile" :user user)))
(defun unauthorized-profile (params)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error "Unauthorized"))
(defun people (params)
(let ((users (mito:retrieve-dao 'ningle-auth/models:user)))
(djula:render-template* "main/people.html" nil :title "People" :users users :user (cu-sith:logged-in-p))))
(defun person (params)
(let* ((username-or-email (ingle:get-param :person params))
(person (first (mito:select-dao
'ningle-auth/models:user
(where (:or (:= :username username-or-email)
(:= :email username-or-email)))))))
(djula:render-template* "main/person.html" nil :title "Person" :person person :user (cu-sith:logged-in-p))))
With the exception of the defpackage and in-package, the only thing that changes here is that we are giving these functions a name, the params is unchanged from when there were in main.lisp.
This allows main.lisp to be flattened down.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
(defpackage ningle-tutorial-project
(:use :cl :ningle-tutorial-project/controllers)
(:export #:start
#:stop))
(in-package ningle-tutorial-project)
(defvar *app* (make-instance 'ningle:app))
;; requirements
(setf (ningle:requirement *app* :logged-in-p)
(lambda (value)
(and (cu-sith:logged-in-p) value)))
;; routes
(setf (ningle:route *app* "/" :logged-in-p t) #'logged-in-index)
(setf (ningle:route *app* "/") #'index)
(setf (ningle:route *app* "/post/:id/likes" :method :POST :logged-in-p t) #'post-likes)
(setf (ningle:route *app* "/post/:id") #'single-post)
(setf (ningle:route *app* "/post" :method :POST :logged-in-p t) #'post-content)
(setf (ningle:route *app* "/profile" :logged-in-p t) #'logged-in-profile)
(setf (ningle:route *app* "/profile") #'unauthorized-profile)
(setf (ningle:route *app* "/people") #'people)
(setf (ningle:route *app* "/people/:person") #'person)
(defmethod ningle:not-found ((app ningle:<app>))
(declare (ignore app))
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error "Not Found"))
(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
(djula:set-static-url "/public/")
(clack:clackup
(lack.builder:builder (envy-ningle:build-middleware :ningle-tutorial-project/config *app*))
:server server
:address address
:port port))
(defun stop (instance)
(clack:stop instance))
I hope you agree that seeing main.lisp like this helps us focus principally on the routing without worrying about the exact implementation.
As always, since we have added a new file to our project we must ensure it gets included and compiled into our project.asd file.
:components ((:module "src"
:components
((:file "contrib")
(:file "middleware")
(:file "config")
(:file "models")
(:file "forms")
(:file "migrations")
+ (:file "controllers")
(:file "main"))))
I appreciate that this is a very short lesson this time, but after the last few lessons (and next times lesson) I think we might both appreciate a small break. It is also important to look at refactoring projects and structuring them correctly before they get too unwieldily. There isn’t a lot of information out there about style guides or best practice so it was best to introduce some in our own project while we had a chance.
Next time we will be looking at adding comments to our system, I had thought perhaps the application was good enough as an example, but there’s still some areas we might want to look at, such as self referential models, which is where comments come in, cos a comment is technically a post after all!
As always, I hope you found this helpful, and thanks for reading.
| Level | Learning Outcome |
|---|---|
| Understand | Explain how separating routing and controller logic improves readability and maintainability. Describe how defpackage and symbol exports control what functions are visible across modules. Summarize why refactoring helps prevent future complexity in growing projects. |
| Apply | Move controller functions from main.lisp into a new package file, update main.lisp to call them via route bindings, and modify the .asd file to include the new component. Implement a small bug fix involving SQL joins and template references. |
| Analyse | Compare a monolithic main.lisp file with a modular project layout in terms of structure and debugging clarity. Identify how exported symbols, package imports, and route bindings interact across files. Evaluate the trade-offs of consolidating or splitting functions by purpose. |
| Evaluate | Assess the maintainability and clarity of the refactored code. Recommend naming or packaging conventions that could further streamline the project. |
| Symbol | Type | Why it appears in this lesson | CLHS |
|---|---|---|---|
defpackage |
Macro | Define ningle-tutorial-project/controllers and ningle-tutorial-project packages with :export. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defpac.htm |
in-package |
Macro | Enter the package before definitions. | http://www.lispworks.com/documentation/HyperSpec/Body/m_in_pkg.htm |
defvar |
Special Operator | Define *app* as a global. |
http://www.lispworks.com/documentation/HyperSpec/Body/s_defvar.htm |
defun |
Macro | Define controller functions like index, post-content, etc. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defun.htm |
defmethod |
Macro | Specialize ningle:not-found and logged-in-posts. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_defmet.htm |
make-instance |
Generic Function | Create the Ningle app object: (make-instance 'ningle:app). |
http://www.lispworks.com/documentation/HyperSpec/Body/f_mk_ins.htm |
let / let* |
Special Operator | Local bindings for user, form, posts, etc. |
http://www.lispworks.com/documentation/HyperSpec/Body/s_let_l.htm |
lambda |
Special Operator | Inline route requirement: (lambda (value) …). |
http://www.lispworks.com/documentation/HyperSpec/Body/s_fn_lam.htm |
setf |
Macro | Assign route table entries and response status; generalized places. | http://www.lispworks.com/documentation/HyperSpec/Body/m_setf.htm |
gethash |
Function | Pull :user from ningle:*session*. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_gethas.htm |
make-hash-table |
Function | Build JSON-ish response map in post-likes. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_mk_has.htm |
equal |
Function | Hash table :test 'equal. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_equal.htm |
list |
Function | Build :binds list for SQL and other lists. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_list.htm |
first |
Accessor | Take first result from select-dao. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_firstc.htm |
slot-value |
Function | Access user id ((slot-value user '…:id) in the bug-fix snippet). |
http://www.lispworks.com/documentation/HyperSpec/Body/f_slot__.htm |
parse-integer |
Function | Convert :id param to integer. |
http://www.lispworks.com/documentation/HyperSpec/Body/f_parse_.htm |
format |
Function | Debug-print validation errors. | http://www.lispworks.com/documentation/HyperSpec/Body/f_format.htm |
handler-case |
Macro | Trap parse-error/simple-error for 404/403 pages. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_hand_1.htm |
parse-error |
Condition Type | Caught when parsing route params fails. | http://www.lispworks.com/documentation/HyperSpec/Body/e_parse_.htm |
simple-error |
Condition Type | Used for CSRF or general failures. | http://www.lispworks.com/documentation/HyperSpec/Body/e_smp_er.htm |
multiple-value-bind |
Macro | Unpack (valid errors) from validate-form. |
http://www.lispworks.com/documentation/HyperSpec/Body/m_mpv_bn.htm |
progn |
Special Operator | Group side effects before error handling. | http://www.lispworks.com/documentation/HyperSpec/Body/s_progn.htm |
when |
Macro | Conditional steps after validation (when errors / when valid). |
http://www.lispworks.com/documentation/HyperSpec/Body/m_when_.htm |
declare |
Special Operator | (declare (ignore app)) inside not-found. |
http://www.lispworks.com/documentation/HyperSpec/Body/s_declar.htm |
and / or |
Macro | Logical composition in route requirements and user lookup. | http://www.lispworks.com/documentation/HyperSpec/Body/a_and.htm |
Welcome back! I hope you are well, this tutorial will be have us writing code to integrate the concept of “posts” into our tutorial app, up until now we had a list of posts displayed as an example of how the page might look, well, this changes now. In the course of this tutorial we will be adding new models and forms (like we did in Part 9 (Authentication System)), we will be exploring a new concept in Ningle that allows us to define and use our own requirements, we will also be using some advanced SXQL to perform somewhat more complicated collection of data than we have previously used, and finally, we can add an honest to goodness json library for returning some responses as something other than html.
With any luck that all sounds exciting! We can broadly split our work this month into three sections, which should make the task easier.
Here we will be defining our new models, but unlike before, not every model will be getting a form, some models will be used behind the scenes and users wont directly interact with. This is one of those areas where data has to be very carefully thought of, the example here is likes, in social media platforms, each post has some sort of interaction (likes, reactions, thumbsup, etc), and it looks like this is a property of a post, and indeed it might make sense to assume that a post “has” likes, but this isn’t actually true, what we will have is a likes model that relates to both a post and a user. The user is just presented with visual information that makes it look like likes are something a post has.
Our models file will include more than just model definitions, we have some methods and functions we need to write to access or alter our data, we will have two models our posts and likes, we will use likes to link a post to a user (from our ningle-auth package).
Let’s start by defining our package and models, we will look at the other methods and functions we are exporting a little further down.
(defpackage ningle-tutorial-project/models
(:use :cl :mito :sxql)
(:import-from :ningle-auth/models #:user)
(:export #:post
#:id
#:content
#:likes
#:user
#:liked-post-p
#:logged-in-posts
#:not-logged-in-posts
#:toggle-like))
(in-package ningle-tutorial-project/models)
(deftable post ()
((user :col-type ningle-auth/models:user :initarg :user :accessor user)
(content :col-type (:varchar 140) :initarg :content :accessor content)))
(deftable likes ()
((user :col-type ningle-auth/models:user :initarg :user :reader user)
(post :col-type post :initarg :post :reader post))
(:unique-keys (user post)))Our post has a user and some content, we don’t have comments or reposts or anything (this is a tutorial after all!), what we want to ensure with the likes model though, is that there’s a unique constraint between user and post, this ensures that a user can like a specific post only once. Otherwise our like count would be unreliable.
In our exports list you will see we export the id, user, content, likes, post etc, but there’s more!
Recall that Common Lisp is a lisp-2 and as such we can have function/method names as the same as objects, and because of this, we will defined some methods with the name “likes” which are different from our class called “likes”.
(defgeneric likes (post)
(:documentation "Returns the number of likes a post has"))
(defmethod likes ((post post))
(mito:count-dao 'likes :post post))Here we define a method that will accept a post and return the total number of likes it has, which will give us our likes count when we render the main page.
The next method we are going to write is a way to toggle the user like of a post, if they don’t like it, clicking it will like the post, if they do already like the post, clicking the like button will undo the like.
(defmethod toggle-like ((ningle-auth/models:user user) (post post))
(let ((liked-post (liked-post-p user post)))
(if liked-post
(mito:delete-dao liked-post)
(mito:create-dao 'likes :post post :user user))
(not liked-post)))
(defgeneric liked-post-p (user post)
(:documentation "Returns true if a user likes a given post"))
(defmethod liked-post-p ((ningle-auth/models:user user) (post post))
(mito:find-dao 'likes :user user :post post))The toggle-like tries to be as simple as possible, by calling the liked-post-p method to query if a user likes a post, and if the post is liked, the record of the like is deleted, if not it is created. The final thing the function does is return the not of liked-post-p, so if the post was liked at first, it will return nil, if the post wasn’t liked, it’ll return t. This will become important later, but if your function can be written in a way that can return helpful information, I suggest doing so, you may not always, or ever use the data it returns, but it’s there if you need to, it forms a usable interface.
Now to SQL!
If you are unfamiliar with SQL this part might look complicated, but in terms of SQL, it isn’t, SQL is a language used for a very specific purpose; querying and manipulating data! If you have not used SQL before/much, I highly encourage you to do so, it’s nearly 50 years old, it’s a very well tested and proven technology. It’s not going anywhere (despite what you may read online NoSQL isn’t going to replace it), and will be great for your career.
Mito is a pretty thin wrapper around SQL, unlike something like Django, Rails, or Larvel (comprehensive web frameworks), Mito doesn’t have a complex DSL for abstracting the SQL details away, instead it has the user use an SQL generator SXQL, so, for things beyond the simplest of things, we’re gonna have to get into SQL, which is fine.
We have two things we want to do:
Let’s start with the first case, a user has loaded the website, but they are not logged in. The best place to start is with the SQL query we want to run:
SELECT post.*, COUNT(likes.id) AS like_count
FROM post
LEFT JOIN likes ON (post.id = likes.post_id)
GROUP BY post.id
ORDER BY post.created_at DESC
LIMIT 50;This will give us a structure like this:
| id | user_id | content | created_at | updated_at | like_count |
|---|---|---|---|---|---|
| 1 | 4 | “hi” | 2025-09-13 19:43:16.718416Z | 2025-09-13 19:43:16.718416Z | 5 |
This query works by using joins, we want to get each post record and its like count, so we must join post and likes on the intersection of post.id and likes.post.id. This will allow us to iterate over the combined results and use them in our templates later.
We also use the GROUP BY clause to ensure that there is only one result per post, and that each like for a given post is summed together, so we have one post with many likes, rather than many copies of the same post each with one like.
We use the retrieve-by-sql function from mito which allows us to run SQL explicitly, but as previously mentioned we will use SXQL to more easily generate the SQL we might want within Common Lisp.
We will also use the yield function (from SXQL) to actually convert the Common Lisp representation into a string SQL can use, within that we will begin with select (also from SXQL).
(defun not-logged-in-posts ()
(mito:retrieve-by-sql
(sxql:yield
(sxql:select
(:post.* (:as (:count :likes.id) :like_count))
(sxql:from :post)
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))))You should be able to see that our original SQL is represented quite similarly in the SXQL, here’s a table to clearly show the minor differences.
| SQL | SXQL |
|---|---|
SELECT post.*, COUNT(likes.id) AS like_count
FROM post
LEFT JOIN likes ON (post.id = likes.post_id)
GROUP BY post.id
ORDER BY post.created_at DESC
LIMIT 50;
|
(sxql:select (:post.* (:as (:count :likes.id) :like_count))
(sxql:from :post)
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50))
|
The next query we need to construct is that of the logged in user, which includes a column denoting likes for any specific post, this will be our second function logged-in-posts. As before, let’s start with what the SQL will be:
SELECT post.*, COUNT(likes.id) AS like_count, COUNT(user_likes.id) AS liked_by_user
FROM post
LEFT JOIN likes ON (post.id = likes.post_id)
LEFT JOIN likes AS user_likes ON ((post.id = user_likes.post_id) AND (user_likes.user_id = ?))
GROUP BY post.id
ORDER BY post.created_at DESC
LIMIT 50;Please note that we have a ? where the user id would go, we do not wish to be subject to SQL injection attacks, so mito allows us to bind values, but we will keep the ? as it’s what we will use in the SXQL too.
Which will generate the following table structure.
| id | user_id | content | created_at | updated_at | like_count | liked_by_user |
|---|---|---|---|---|---|---|
| 1 | 4 | “hi” | 2025-09-13 19:43:16.718416Z | 2025-09-13 19:43:16.718416Z | 5 | 1 |
The extra column is only a small change on the first query, by adding a new call to COUNT in the SELECT line, we prepare the column, and we get the data from the second LEFT JOIN which will join (using a new alias; user_likes) where the post id is the same as the user likes post id and where the user likes user id is the same as the logged in user, this will either return a record or null. When we call count on the record returned, it becomes 1 or 0, effectively a boolean check.
We can see the differences between the SQL and the SXQL here.
SQL
SELECT post.*, COUNT(likes.id) AS like_count, COUNT(user_likes.id) AS liked_by_user
FROM post
LEFT JOIN likes ON (post.id = likes.post_id)
LEFT JOIN likes AS user_likes ON ((post.id = user_likes.post_id) AND (user_likes.user_id = ?))
GROUP BY post.id
ORDER BY post.created_at DESC
LIMIT 50;SXQL
(sxql:select (:post.* (:as (:count :likes.id) :like_count) (:as (:count :user_likes.id) :liked_by_user))
(sxql:from :post)
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:left-join (:as :likes :user_likes) :on (:and (:= :post.id :user_likes.post_id) (:= :user_likes.user_id :?)))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))So this SXQL will be used in our function like so:
(defmethod logged-in-posts ((user user))
(let ((uid (slot-value user 'mito.dao.mixin::id)))
(mito:retrieve-by-sql
(sxql:yield
(sxql:select
(:post.* (:as (:count :likes.id) :like_count) (:as (:count :user_likes.id) :liked_by_user))
(sxql:from :post)
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:left-join (:as :likes :user_likes)
:on (:and (:= :post.id :user_likes.post_id)
(:= :user_likes.user_id :?)))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))
:binds (list uid))))As mentioned before, you can see the :binds which will insert the user id into the SXQL query for safety.
So with these two complex functions in place now, we have everything we need, for clarity the complete listing of the models.lisp file is as follows:
(defpackage ningle-tutorial-project/models
(:use :cl :mito :sxql)
(:import-from :ningle-auth/models #:user)
(:export #:post
#:id
#:content
#:likes
#:user
#:liked-post-p
#:logged-in-posts
#:not-logged-in-posts
#:toggle-like))
(in-package ningle-tutorial-project/models)
(deftable post ()
((user :col-type ningle-auth/models:user :initarg :user :accessor user)
(content :col-type (:varchar 140) :initarg :content :accessor content)))
(deftable likes ()
((user :col-type ningle-auth/models:user :initarg :user :reader user)
(post :col-type post :initarg :post :reader post))
(:unique-keys (user post)))
(defgeneric likes (post)
(:documentation "Returns the number of likes a post has"))
(defmethod likes ((post post))
(mito:count-dao 'likes :post post))
(defgeneric toggle-like (user post)
(:documentation "Toggles the like of a user to a given post"))
(defmethod toggle-like ((ningle-auth/models:user user) (post post))
(let ((liked-post (liked-post-p user post)))
(if liked-post
(mito:delete-dao liked-post)
(mito:create-dao 'likes :post post :user user))
(not liked-post)))
(defgeneric liked-post-p (user post)
(:documentation "Returns true if a user likes a given post"))
(defmethod liked-post-p ((ningle-auth/models:user user) (post post))
(mito:find-dao 'likes :user user :post post))
(defgeneric logged-in-posts (user)
(:documentation "Gets the posts for a logged in user"))
(defmethod logged-in-posts ((user user))
(let ((uid (slot-value user 'mito.dao.mixin::id)))
(mito:retrieve-by-sql
(sxql:yield
(sxql:select
(:post.*
(:as (:count :likes.id) :like_count)
(:as (:count :user_likes.id) :liked_by_user))
(sxql:from :post)
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:left-join (:as :likes :user_likes)
:on (:and (:= :post.id :user_likes.post_id)
(:= :user_likes.user_id :?)))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))
:binds (list uid))))
(defun not-logged-in-posts ()
(mito:retrieve-by-sql
(sxql:yield
(sxql:select
(:post.* (:as (:count :likes.id) :like_count))
(sxql:from :post)
(sxql:left-join :likes :on (:= :post.id :likes.post_id))
(sxql:group-by :post.id)
(sxql:order-by (:desc :post.created_at))
(sxql:limit 50)))))Our forms are much simpler, we only have one form, the post. While we do have the likes model, our users will not be directly using that, and thus we don’t need to render a form for this.
(defpackage ningle-tutorial-project/forms
(:use :cl :cl-forms)
(:export #:post
#:content
#:submit))
(in-package ningle-tutorial-project/forms)
(defparameter *post-validator* (list (clavier:not-blank)
(clavier:is-a-string)
(clavier:len :max 140)))
(defform post (:id "post" :csrf-protection t :csrf-field-name "csrftoken" :action "/post")
((content :string :value "" :constraints *post-validator*)
(submit :submit :label "Post")))Like we used in a previous tutorial, we use the clavier validation library to ensure that our users post things that fit within the constraints of our system, we also want to make sure we are using CSRF tokens for security.
We will style this form using CSS later.
Now, our main project now contains its own migrations, we perhaps should have written the code to perform migrations in another file and reserved this for specific migrations, but we can work with things the way they are.
We are going to start by adding a function to the top of our migrations.lisp file.
(defun migrate ()
"Explicitly apply migrations when called."
(format t "Applying migrations...~%")
(mito:ensure-table-exists 'ningle-tutorial-project/models:post)
(mito:ensure-table-exists 'ningle-tutorial-project/models:likes)
(mito:migrate-table 'ningle-tutorial-project/models:post)
(mito:migrate-table 'ningle-tutorial-project/models:likes)
(format t "Migrations complete.~%"))These will be the project specific migrations, however we still need a way to trigger them, and since we wrote a way to apply specific apps only, we need a way to exclude these if we do not wish to run these migrations.
The next thing we need to do is to extend the migrate-apps function we previously wrote. We will add a parameter to the function:
(defun migrate-apps (&optional (apps nil) &key skip-root)
And within the macro call:
(with-db-connection
...)
We add:
(unless skip-root
(format t "Running root project migrations...~%")
(migrate))
There is also a small correction we need to make, this line.
(error "Migrate function not found in package ~A." migrations-pkg-name)
Needs to be corrected to:
(error (format nil "Migrate function not found in package ~A." migrations-pkg-name))
Full listing:
(defpackage ningle-tutorial-project/migrations
(:use :cl :ningle-tutorial-project/contrib)
(:export #:migrate-apps))
(in-package :ningle-tutorial-project/migrations)
(defun migrate ()
"Explicitly apply migrations when called."
(format t "Applying migrations...~%")
(mito:ensure-table-exists 'ningle-tutorial-project/models:post)
(mito:ensure-table-exists 'ningle-tutorial-project/models:likes)
(mito:migrate-table 'ningle-tutorial-project/models:post)
(mito:migrate-table 'ningle-tutorial-project/models:likes)
(format t "Migrations complete.~%"))
(defun migrate-apps (&optional (apps nil) &key skip-root)
"Run migrate function for each app in APPS list. If APPS is nil, migrate all apps listed in *config* :installed-apps."
(let ((apps (or apps (getf (envy:config :ningle-tutorial-project/config) :installed-apps))))
(unless apps
(error "No apps specified and no :installed-apps found in config."))
(with-db-connection
(unless skip-root
(format t "Running root project migrations...~%")
(migrate))
(dolist (app apps)
(let* ((migrations-pkg-name (string-upcase (format nil "~A/MIGRATIONS" (string-upcase (symbol-name app)))))
(migrations-pkg (find-package migrations-pkg-name)))
(unless migrations-pkg
(error "Migrations package ~A not found." migrations-pkg-name))
;; Set app-specific config before calling migrate
(let ((migrate-fn (find-symbol "MIGRATE" migrations-pkg))) ;; Name known to project
(unless (and migrate-fn (fboundp migrate-fn))
(error (format nil "Migrate function not found in package ~A." migrations-pkg-name)))
(funcall migrate-fn)))))))With these files added, we need to remember to add them to our project.asd file.
:components ((:module "src"
:components
((:file "contrib")
(:file "middleware")
(:file "config")
(:file "models") ; add this line
(:file "forms") ; add this line
(:file "migrations")
(:file "main"))))We will now look at the controller logic to handle posting, well, posts. We will introduce a feature of Ningle we have not yet looked into that can help us create smaller, more specialised, logical units of work, requirements. Ningle has the ability to define conditions that can be passed as keyword arguments to a controller, if the condition is true, the controller is triggered. In our controllers previously we have had if checks for if a user is logged in, or if a request is a GET or a POST, these requirements allow us to write smaller functions to help us focus on one specific type of request (even if on the same route). I find this helps me, personally, if I can reduce the number of things I have to be remembering when I am working on a function.
Before we do, however, we will allow our main code to use the forms we defined in the previous section.
(defpackage ningle-tutorial-project
(:use :cl :sxql :ningle-tutorial-project/forms) ; Add the :ningle-tutorial-project/forms bit!
(:export #:start
#:stop))
(in-package ningle-tutorial-project)Now with that in place we can begin in earnest! We already use these requirements already with our :method '(:GET :POST) that we used previously, but we can define our own! We will define a requirement that there is a logged in user. In our src/main.lisp file, before the routes we previously defined, we will add this:
(setf (ningle:requirement *app* :logged-in-p)
(lambda (value)
(and (cu-sith:logged-in-p) value)))Since this will be used as a keyword argument, the lambda function will always define a parameter, this will be the value found to the key word argument later when this is used in a route definition. We will use this requirement in a few places here, starting with our “/” route.
Previously we just had a dummy response that returned what we thought the posts might look like, but now we have the capability to store and retrieve posts from a database we can change this now.
We have different database queries too, a query to run when a user is not logged in, and a query to run when they are, this this helps split our controllers into a logged in view, and a not logged in view.
A quick word on controller definitions, if you have multiple controllers, you must define the most specific ones first! So we will start by defining a view that matches on “/” and when logged-in-p is t, because if we try to match on “/” first, then it matches every controller for that route, ignoring any other specific requirements of it, so we must define our logged in view first!
(setf (ningle:route *app* "/" :logged-in-p t)
(lambda (params)
(let* ((user (gethash :user ningle:*session*))
(form (cl-forms:find-form 'post))
(posts (ningle-tutorial-project/models:logged-in-posts user)))
(djula:render-template* "main/index.html" nil :title "Home" :user user :posts posts :form form))))In this controller we ensure that there is a user that is logged in using :logged-in-p t, and another change this controller handles if a user is logged in, is permitting them to post! So this controller grabs the logged in user, the form for posting content and the first 50 posts (which is what logged-in-posts does) and renders them in the template.
Then we can define a more general “/” controller after it.
(setf (ningle:route *app* "/")
(lambda (params)
(let ((posts (ningle-tutorial-project/models:not-logged-in-posts)))
(djula:render-template* "main/index.html" nil :title "Home" :user (gethash :user ningle:*session*) :posts posts))))This is simpler, by not needing a user or post form, we can forgo these and simply get a list of posts with not-logged-in-posts. Although, now I think about it, I could have written a helper method that takes a user object and runs these functions depending on if the user is nil or not, you live and learn!
Please note that these two controllers will replace the previous “/” controller we had.
With these in place we need a controller to toggle the liked status of a post.
(setf (ningle:route *app* "/post/:id/likes" :method :POST :logged-in-p t)
(lambda (params)
(let* ((user (gethash :user ningle:*session*))
(post (mito:find-dao 'ningle-tutorial-project/models:post :id (parse-integer (ingle:get-param :id params))))
(res (make-hash-table :test 'equal)))
(setf (gethash :post res) (ingle:get-param :id params))
(setf (gethash :likes res) (ningle-tutorial-project/models:likes post))
(setf (gethash :liked res) (ningle-tutorial-project/models:toggle-like user post))
(com.inuoe.jzon:stringify res))))Here, this controller is permitted to POST only and requires that a user is logged in, we obviously don’t want users that aren’t logged in to be able to like posts. So we grab the user, the post that is to be liked and we create a hash-table for creating our response because here, we actually use the jzon package to return a valid json response. This controller sets the :post, :likes, and :liked fields and stringifies the hash-table so it can be read as json. We need to grab the post id from the url, but we have seen this before.
Our next controller simply directs the user to a specific post.
(setf (ningle:route *app* "/post/:id")
(lambda (params)
(handler-case
(let ((post (mito:find-dao 'ningle-tutorial-project/models:post :id (parse-integer (ingle:get-param :id params)))))
(djula:render-template* "main/post.html" nil :title "Post" :post post))
(parse-error (err)
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error err)))))We set up a handler-case to attempt to load a specific post and render the template, if that fails, we set a 404 response code and render the error page.
Moving on now to actually posting some content! Once again this controller should only be permitted to serve POST requests and require that a user is logged in. As we have seen previously in this series we need to grab the user object and the form that was submitted. From there we do the error handling handler-case by handling the loading of the form, we handle the values of valid, or errors and enter the content of a post into the database if there’s no errors, if there are, a 403 is set and the error is rendered.
(setf (ningle:route *app* "/post" :method :POST :logged-in-p t)
(lambda (params)
(let ((user (gethash :user ningle:*session*))
(form (cl-forms:find-form 'post)))
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (content) form
(mito:create-dao 'ningle-tutorial-project/models:post :content content :user user)
(ingle:redirect "/")))))
(simple-error (err)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error err))))))Finally we now look to replace the “/profile” controllers, we have already explored the new concepts but this serves as a simple, clear example, and it helps we need to work on this further anyway!
(setf (ningle:route *app* "/profile" :logged-in-p t)
(lambda (params)
(let ((user (gethash :user ningle:*session*)))
(djula:render-template* "main/profile.html" nil :title "Profile" :user user))))
(setf (ningle:route *app* "/profile")
(lambda (params)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error "Unauthorized")))Full listing:
(defpackage ningle-tutorial-project
(:use :cl :sxql :ningle-tutorial-project/forms)
(:export #:start
#:stop))
(in-package ningle-tutorial-project)
(defvar *app* (make-instance 'ningle:app))
;; requirements
(setf (ningle:requirement *app* :logged-in-p)
(lambda (value)
(and (cu-sith:logged-in-p) value)))
;; routes
(setf (ningle:route *app* "/" :logged-in-p t)
(lambda (params)
(let* ((user (gethash :user ningle:*session*))
(form (cl-forms:find-form 'post))
(posts (ningle-tutorial-project/models:logged-in-posts user)))
(djula:render-template* "main/index.html" nil :title "Home" :user user :posts posts :form form))))
(setf (ningle:route *app* "/")
(lambda (params)
(let ((posts (ningle-tutorial-project/models:not-logged-in-posts)))
(djula:render-template* "main/index.html" nil :title "Home" :user (gethash :user ningle:*session*) :posts posts))))
(setf (ningle:route *app* "/post/:id/likes" :method :POST :logged-in-p t)
(lambda (params)
(let* ((user (gethash :user ningle:*session*))
(post (mito:find-dao 'ningle-tutorial-project/models:post :id (parse-integer (ingle:get-param :id params))))
(res (make-hash-table :test 'equal)))
(setf (gethash :post res) (ingle:get-param :id params))
(setf (gethash :likes res) (ningle-tutorial-project/models:likes post))
(setf (gethash :liked res) (ningle-tutorial-project/models:toggle-like user post))
(com.inuoe.jzon:stringify res))))
(setf (ningle:route *app* "/post/:id")
(lambda (params)
(handler-case
(let ((post (mito:find-dao 'ningle-tutorial-project/models:post :id (parse-integer (ingle:get-param :id params)))))
(djula:render-template* "main/post.html" nil :title "Post" :post post))
(parse-error (err)
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error err)))))
(setf (ningle:route *app* "/post" :method :POST :logged-in-p t)
(lambda (params)
(let ((user (gethash :user ningle:*session*))
(form (cl-forms:find-form 'post)))
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (content) form
(mito:create-dao 'ningle-tutorial-project/models:post :content content :user user)
(ingle:redirect "/")))))
(simple-error (err)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error err))))))
(setf (ningle:route *app* "/profile" :logged-in-p t)
(lambda (params)
(let ((user (gethash :user ningle:*session*)))
(djula:render-template* "main/profile.html" nil :title "Profile" :user user))))
(setf (ningle:route *app* "/profile")
(lambda (params)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error "Unauthorized")))
(setf (ningle:route *app* "/people")
(lambda (params)
(let ((users (mito:retrieve-dao 'ningle-auth/models:user)))
(djula:render-template* "main/people.html" nil :title "People" :users users :user (cu-sith:logged-in-p)))))
(setf (ningle:route *app* "/people/:person")
(lambda (params)
(let* ((username-or-email (ingle:get-param :person params))
(person (first (mito:select-dao
'ningle-auth/models:user
(where (:or (:= :username username-or-email)
(:= :email username-or-email)))))))
(djula:render-template* "main/person.html" nil :title "Person" :person person :user (cu-sith:logged-in-p)))))
(defmethod ningle:not-found ((app ningle:<app>))
(declare (ignore app))
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error "Not Found"))
(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
(djula:set-static-url "/public/")
(clack:clackup
(lack.builder:builder (envy-ningle:build-middleware :ningle-tutorial-project/config *app*))
:server server
:address address
:port port))
(defun stop (instance)
(clack:stop instance))There’s one final thing to add before we look at the aesthetic changes we will be applying, we need to ensure we add the jzon package to our project dependencies.
:depends-on (:cl-dotenv
:clack
:djula
:cl-forms
:cl-forms.djula
:cl-forms.ningle
:envy
:envy-ningle
:ingle
:com.inuoe.jzon ; <- Add this line
:mito
:mito-auth
:ningle
:ningle-auth)We make some changes to our html, sadly the biggest part of it is JavaScript, but nevermind!
In our base template we only make a couple of changes, in our <head></head> section, prior to loading our own css, we must include the bootstrap icons package.
<link href="https://cdn.jsdelivr.net/npm/[email protected]/dist/css/bootstrap.min.css" rel="stylesheet">
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/[email protected]/font/bootstrap-icons.css"> <! -- add this line! -->
<link rel="stylesheet" href="{% static "css/main.css" %}"/>Next, right at the bottom, we include a way to add JS to templates, if we need to.
<script src="https://cdn.jsdelivr.net/npm/[email protected]/dist/js/bootstrap.bundle.min.js"></script>
<script>
{% block js %}
{% endblock %}
</script>Full listing:
<!doctype html>
<html lang="en">
<head>
{% if title %}
<title>{{ title }} - Y</title>
{% else %}
<title>Welcome to Y</title>
{% endif %}
<link href="https://cdn.jsdelivr.net/npm/[email protected]/dist/css/bootstrap.min.css" rel="stylesheet">
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/[email protected]/font/bootstrap-icons.css">
<link rel="stylesheet" href="{% static "css/main.css" %}"/>
</head>
<body>
<nav class="navbar navbar-expand-lg navbar-dark bg-dark">
<div class="container-fluid">
<a class="navbar-brand" href="/">
<img src="{% static "images/logo.jpg" %}" alt="Logo" class="d-inline-block align-text-top logo">
Y
</a>
<button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#navbarSupportedContent" aria-controls="navbarSupportedContent" aria-expanded="false" aria-label="Toggle navigation">
<span class="navbar-toggler-icon"></span>
</button>
<div class="collapse navbar-collapse" id="navbarSupportedContent">
<ul class="navbar-nav me-auto">
<li class="nav-item {% ifequal title "Home" %}disabled{% endifequal %}">
<a class="nav-link" href="/">Home</a>
</li>
<li class="nav-item {% ifequal title "People" %}disabled{% endifequal %}">
<a class="nav-link" href="/people">People</a>
</li>
</ul>
<div class="d-flex ms-auto">
{% if user %}
<a href="/profile" class="btn btn-primary">{{ user.username }}</a>
|
<a href="/auth/logout" class="btn btn-secondary">Logout</a>
{% else %}
<a href="/auth/register" class="btn btn-primary">Register</a>
|
<a href="/auth/login" class="btn btn-success">Login</a>
{% endif %}
</div>
</div>
</div>
</nav>
<div class="container mt-4">
{% block content %}
{% endblock %}
</div>
<script src="https://cdn.jsdelivr.net/npm/[email protected]/dist/js/bootstrap.bundle.min.js"></script>
<script>
{% block js %}
{% endblock %}
</script>
</body>
</html>Our index page will need to include some JavaScript, this will be with the intention of sending a request to the controller to increment/decrement the like count of a post. Again since this tutorial is about Common Lisp, I won’t really be explaining the JS.
In the first part of the container div, we will add our form to post content:
{% block content %}
<div class="container">
<!-- Post form -->
<div class="row mb-4">
<div class="col">
{% if form %}
{% form form %}
{% endif %}
</div>
</div>
...This displays the full form, including labels we don’t necessarily need, so we hide this using the css that was written, but this will only show when a user is logged in and will post content for the logged in user.
Next we will be changing the structure of the contents of our posts for loop, nothing major, but since we have better CSS we might want to ensure our HTML matches it.
{% for post in posts %}
<div class="card post mb-3" data-href="/post/{{ post.id }}">
<div class="card-body">
<h5 class="card-title mb-2">{{ post.content }}</h5>
<p class="card-subtitle text-muted mb-0">@{{ post.user.username }}</p>
</div>
<div class="card-footer d-flex justify-content-between align-items-center">
<button type="button"
class="btn btn-sm btn-outline-primary like-button"
data-post-id="{{ post.id }}"
data-logged-in="{% if user.username != "" %}true{% else %}false{% endif %}"
data-liked="{% if post.liked-by-user == 1 %}true{% else %}false{% endif %}"
aria-label="Like post {{ post.id }}">
{% if post.liked-by-user == 1 %}
<i class="bi bi-hand-thumbs-up-fill text-primary" aria-hidden="true"></i>
{% else %}
<i class="bi bi-hand-thumbs-up text-muted" aria-hidden="true"></i>
{% endif %}
<span class="ms-1 like-count">{{ post.like-count }}</span>
</button>
<small class="text-muted">Posted on: {{ post.created-at }}</small>
</div>
</div>
{% endfor %}Then in the case where we do not have any posts!
{% if not posts %}
<div class="text-center">
<p class="text-muted">No posts to display.</p>
</div>
{% endif %}Finally the dreaded JS!
{% block js %}
document.querySelectorAll(".like-button").forEach(btn => {
btn.addEventListener("click", function (e) {
e.stopPropagation();
e.preventDefault();
// Check login
if (btn.dataset.loggedIn !== "true") {
alert("You must be logged in to like posts.");
return;
}
const postId = btn.dataset.postId;
const countSpan = btn.querySelector(".like-count");
const icon = btn.querySelector("i");
const liked = btn.dataset.liked === "true";
const previous = parseInt(countSpan.textContent, 10) || 0;
const url = `/post/${postId}/likes`;
// Optimistic UI toggle
countSpan.textContent = liked ? previous - 1 : previous + 1;
btn.dataset.liked = liked ? "false" : "true";
// Toggle icon classes optimistically
if (liked) {
// Currently liked, so unlike it
icon.className = "bi bi-hand-thumbs-up text-muted";
} else {
// Currently not liked, so like it
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
}
const csrfTokenMeta = document.querySelector('meta[name="csrf-token"]');
const headers = { "Content-Type": "application/json" };
if (csrfTokenMeta) headers["X-CSRF-Token"] = csrfTokenMeta.getAttribute("content");
fetch(url, {
method: "POST",
headers: headers,
body: JSON.stringify({ toggle: true })
})
.then(resp => {
if (!resp.ok) {
// Revert optimistic changes on error
countSpan.textContent = previous;
btn.dataset.liked = liked ? "true" : "false";
if (liked) {
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
} else {
icon.className = "bi bi-hand-thumbs-up text-muted";
}
throw new Error("Network response was not ok");
}
return resp.json();
})
.then(data => {
if (data && typeof data.likes !== "undefined") {
countSpan.textContent = data.likes;
btn.dataset.liked = data.liked ? "true" : "false";
// Update icon based on server response
if (data.liked) {
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
} else {
icon.className = "bi bi-hand-thumbs-up text-muted";
}
}
})
.catch(err => {
console.error("Like failed:", err);
// Revert optimistic changes on error
countSpan.textContent = previous;
btn.dataset.liked = liked ? "true" : "false";
if (liked) {
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
} else {
icon.className = "bi bi-hand-thumbs-up text-muted";
}
});
});
});
document.querySelectorAll(".card.post").forEach(card => {
card.addEventListener("click", function () {
const href = card.dataset.href;
if (href) {
window.location.href = href;
}
});
});
{% endblock %}Full listing:
{% extends "base.html" %}
{% block content %}
<div class="container">
<!-- Post form -->
<div class="row mb-4">
<div class="col">
{% if form %}
{% form form %}
{% endif %}
</div>
</div>
<!-- Posts Section -->
<div class="row">
<div class="col-12">
{% for post in posts %}
<div class="card post mb-3" data-href="/post/{{ post.id }}">
<div class="card-body">
<h5 class="card-title mb-2">{{ post.content }}</h5>
<p class="card-subtitle text-muted mb-0">@{{ post.user.username }}</p>
</div>
<div class="card-footer d-flex justify-content-between align-items-center">
<button type="button"
class="btn btn-sm btn-outline-primary like-button"
data-post-id="{{ post.id }}"
data-logged-in="{% if user.username != "" %}{% endraw %true{% endraw %true{% raw %}{% else %}false{% endif %}"
data-liked="{% if post.liked-by-user == 1 %}true{% else %}false{% endif %}"
aria-label="Like post {{ post.id }}">
{% if post.liked-by-user == 1 %}
<i class="bi bi-hand-thumbs-up-fill text-primary" aria-hidden="true"></i>
{% else %}
<i class="bi bi-hand-thumbs-up text-muted" aria-hidden="true"></i>
{% endif %}
<span class="ms-1 like-count">{{ post.like-count }}</span>
</button>
<small class="text-muted">Posted on: {{ post.created-at }}{% raw %}</small>
</div>
</div>
{% raw %}{% endfor %}
{% if not posts %}
<div class="text-center">
<p class="text-muted">No posts to display.</p>
</div>
{% endif %}
</div>
</div>
</div>
{% endblock %}
{% block js %}
document.querySelectorAll(".like-button").forEach(btn => {
btn.addEventListener("click", function (e) {
e.stopPropagation();
e.preventDefault();
// Check login
if (btn.dataset.loggedIn !== "true") {
alert("You must be logged in to like posts.");
return;
}
const postId = btn.dataset.postId;
const countSpan = btn.querySelector(".like-count");
const icon = btn.querySelector("i");
const liked = btn.dataset.liked === "true";
const previous = parseInt(countSpan.textContent, 10) || 0;
const url = `/post/${postId}/likes`;
// Optimistic UI toggle
countSpan.textContent = liked ? previous - 1 : previous + 1;
btn.dataset.liked = liked ? "false" : "true";
// Toggle icon classes optimistically
if (liked) {
// Currently liked, so unlike it
icon.className = "bi bi-hand-thumbs-up text-muted";
} else {
// Currently not liked, so like it
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
}
const csrfTokenMeta = document.querySelector('meta[name="csrf-token"]');
const headers = { "Content-Type": "application/json" };
if (csrfTokenMeta) headers["X-CSRF-Token"] = csrfTokenMeta.getAttribute("content");
fetch(url, {
method: "POST",
headers: headers,
body: JSON.stringify({ toggle: true })
})
.then(resp => {
if (!resp.ok) {
// Revert optimistic changes on error
countSpan.textContent = previous;
btn.dataset.liked = liked ? "true" : "false";
if (liked) {
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
} else {
icon.className = "bi bi-hand-thumbs-up text-muted";
}
throw new Error("Network response was not ok");
}
return resp.json();
})
.then(data => {
if (data && typeof data.likes !== "undefined") {
countSpan.textContent = data.likes;
btn.dataset.liked = data.liked ? "true" : "false";
// Update icon based on server response
if (data.liked) {
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
} else {
icon.className = "bi bi-hand-thumbs-up text-muted";
}
}
})
.catch(err => {
console.error("Like failed:", err);
// Revert optimistic changes on error
countSpan.textContent = previous;
btn.dataset.liked = liked ? "true" : "false";
if (liked) {
icon.className = "bi bi-hand-thumbs-up-fill text-primary";
} else {
icon.className = "bi bi-hand-thumbs-up text-muted";
}
});
});
});
document.querySelectorAll(".card.post").forEach(card => {
card.addEventListener("click", function () {
const href = card.dataset.href;
if (href) {
window.location.href = href;
}
});
});
{% endblock %}We will add a new post template, this isn’t actually for creating a post, as we saw above we integrated that form into the index page, but rather this is the template for showing an individual post. In the future we might introduce comments etc and this would make it easier to see all of that content in one page.
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<h2>{{ post.user.username }}</h2>
<p>{{ post.content }}</p>
</div>
</div>
</div>
{% endblock %}I made a number of css changes (with the help of AI, cos I hate writing CSS!), and I wanted to include them here, but since the objective of this tutorial is Lisp not the nuances of selectors, I will just include the full listing without comments.
.logo {
height: 30px;
width: 30px;
}
.error-404 {
height: 75vh;
}
form#signup input {
display: block; /* Ensure inputs take up the full width */
width: 100% !important; /* Override any conflicting styles */
max-width: 100%; /* Ensure no unnecessary constraints */
box-sizing: border-box;
}
form#signup input[type="email"],
form#signup input[type="text"],
form#signup input[type="password"] {
@extend .form-control; /* Apply Bootstrap's .form-control */
display: block; /* Ensure they are block-level elements */
width: 100%; /* Make the input full width */
margin-bottom: 1rem; /* Spacing */
}
form#signup select {
@extend .form-select;
width: 100%;
}
form#signup input[type="submit"] {
@extend .btn;
@extend .btn-primary;
width: 100%;
}
form#signup div {
@extend .mb-3;
}
form#signup label {
@extend .form-label;
font-weight: bold;
margin-bottom: 0.5rem;
}
form#login input {
display: block; /* Ensure inputs take up the full width */
width: 100% !important; /* Override any conflicting styles */
max-width: 100%; /* Ensure no unnecessary constraints */
box-sizing: border-box;
}
form#login input[type="text"],
form#login input[type="password"] {
@extend .form-control; /* Apply Bootstrap's .form-control */
display: block; /* Ensure they are block-level elements */
width: 100%; /* Make the input full width */
margin-bottom: 1rem; /* Spacing */
}
form#login input[type="submit"] {
@extend .btn;
@extend .btn-primary;
width: 100%;
}
form#login div {
@extend .mb-3;
}
form#post div {
@extend .mb-3;
}
form#post {
display: flex !important;
align-items: center !important;
gap: 0.5rem;
width: 100% !important;
}
/* Make the input wrapper expand */
form#post > div:first-of-type {
flex: 1 1 auto !important;
min-width: 0; /* allow shrinking */
}
form#post label {
display: none !important;
}
form#post input[type="text"] {
flex: 1 1 0% !important;
width: 100% !important;
min-width: 0 !important;
/* Bootstrap .form-control styles */
display: block;
padding: 0.375rem 0.75rem;
font-size: 1rem;
font-weight: 400;
line-height: 1.5;
color: #212529;
background-color: #fff;
background-clip: padding-box;
border: 1px solid #ced4da;
border-radius: 0.375rem;
transition: border-color .15s ease-in-out, box-shadow .15s ease-in-out;
}
form#post input[type="submit"] {
flex: 0 0 auto !important;
/* Bootstrap .btn + .btn-primary styles */
display: inline-block;
font-weight: 400;
color: #fff;
text-align: center;
vertical-align: middle;
user-select: none;
background-color: #0d6efd;
border: 1px solid #0d6efd;
padding: 0.375rem 0.75rem;
font-size: 1rem;
line-height: 1.5;
border-radius: 0.375rem;
transition: color .15s ease-in-out, background-color .15s ease-in-out,
border-color .15s ease-in-out, box-shadow .15s ease-in-out;
cursor: pointer;
}
form#post input[type="submit"]:hover {
background-color: #0b5ed7;
border-color: #0a58ca;
}
/* Post container styling */
.post {
display: block; /* Makes the whole card clickable */
text-decoration: none; /* Remove underline from link */
color: inherit; /* Use normal text color */
background: #fff; /* White card background */
border: 1px solid #dee2e6; /* Subtle border */
border-radius: 0.5rem; /* Rounded corners */
padding: 1rem; /* Inner spacing */
margin-bottom: 1rem; /* Space between posts */
transition: box-shadow 0.2s ease, transform 0.1s ease;
cursor: pointer;
}
/* Hover/active effect */
.post:hover {
box-shadow: 0 4px 12px rgba(0,0,0,0.08);
transform: translateY(-2px);
text-decoration: none; /* still no underline on hover */
}
/* Post title/content */
.post-title {
font-weight: 600;
font-size: 1.1rem;
margin-bottom: 0.25rem;
color: #0d6efd; /* bootstrap primary link color */
}
/* Post meta info */
.post-meta {
font-size: 0.875rem;
color: #6c757d; /* muted gray */
margin-top: 0.5rem;
}Phew! That was another big one, but the good news is that most of the key pieces of building an application with Ningle and Mito are in place, next month we will look at tidying up our project. We are far from done with this tutorial series though, as we will still need to look at hosting our applications, testing, and developing good practices.
Thank you for following this tutorial series, I hope you are finding it as interesting/helpful to read as I am finding it interesting/helpful to write.
| Level | Learning Outcome |
|---|---|
| Remember | Define the purpose of post and likes models in Ningle. Recall the role of SXQL in generating SQL queries. |
| Understand | Explain how toggle-like manages user interactions with posts. Describe how requirements (e.g., :logged-in-p) simplify route definitions. Interpret SQL queries that use JOIN and GROUP BY to aggregate like counts. Summarize how SXQL represents SQL constructs such as LEFT JOIN, COUNT, and AS. Explain why COUNT(user_likes.id) can be used to represent a boolean “liked by user” column. |
| Apply | Use cl-forms to create a validated post submission form with CSRF protection. Implement not-logged-in-posts and logged-in-posts to retrieve posts with like counts. |
| Analyse | Compare the differences between raw SQL and SXQL representations for joins and counts. Distinguish between logged-in and non-logged-in query results. |
Welcome back to this tutorial series, in this chapter we are going to write a small app for sending email and connect it up to the authentication system we wrote last time, as part of that we will need to expand the settings we have in our main project. We will also look at different ways in which you can send email, from outputting the console (as a dummy test), smtp (simple mail transfer protocol), and the sendgrid service.
There isn’t too much to change in this package, the most we will be doing is creating a series of settings objects to test the different email options. Of course, we will be introducing new settings and relying on the envy-ningle package to load them for us. We will also create some templates in our auth application, but we will override them in our application using the templates override mechanism we developed previously.
There will be a number of required settings and some settings that will only be used in certain circumstances, we have seen before in Part 7 (Envy Configuation Switching) how to use these settings objects.
Let’s start with the common, shared settings, we have our :common settings object:
(defconfig :common
`(:application-root ,(asdf:component-pathname (asdf:find-system :ningle-tutorial-project))
:installed-apps (:ningle-auth)
:auth-mount-path ,*auth-mount-path*
:login-redirect "/"
:project-name "NTP" ; 1: add this
:token-expiration 3600 ; 2: add this
:email-admins ("[email protected]"))) ; 3: add thisOur first setting is simply creating a name for our project that we can use in email titles etc.
The second setting is to add is related to the tokens we created, we might want to lower this during testing, and restore it when we go into production, it makes sense to centralise it! I should have considered this last time, but the chapter was so big, I had to make cuts somewhere!
The third setting is related to mailing project admins, in the event there’s an error we can mail someone (or in this case a list of people), it’s something we will explore, but not necessarily use, because this is, after all, a tutorial project and not a full blown commercial application.
We have four settings objects we need to create to test everything we need, we will continue using sqlite for our config, but we will explore the following email setups:
Since we are going to write lots of new settings, each of which is going to duplicate the middleware, we are going to explore how to modularize settings (at least a little)!
We will start by defining a new settings block, but it will only contain our middleware settings, we will, for good measure also look into extracting out the database settings, if, for whatever reason, we need to change them in future.
(defconfig |database-settings|
`((:mito (:sqlite3 :database-name ,(uiop:getenv "SQLITE_DB_NAME")))))
(defconfig |middleware|
`(:middleware ((:session)
ningle-tutorial-project/middleware:refresh-roles
,@|database-settings|
(:mount ,*auth-mount-path* ,ningle-auth:*app*)
(:static :root ,(asdf:system-relative-pathname :ningle-tutorial-project "src/static/") :path "/public/"))))We can see here that a small, database specific settings block exists that defines our database connection settings, when then include it inside a middleware settings block which we will now use in our dummy email settings block:
Prior to writing our settings, we will follow good security practices and NOT store details in our repository, so we will need to edit our .env file.
I obviously didn’t include the actual values here, but simply wanted to include the settings names, for clarity.
EMAIL_DEFAULT_FROM=xxx
SMTP_GMAIL_HOST=xxx
SMTP_GMAIL_ACCOUNT_NAME=xxx
SMTP_GMAIL_PASSWORD=xxx
SMTP_ETHEREAL_HOST=xxx
SMTP_ETHEREAL_ACCOUNT_NAME=xxx
SMTP_ETHEREAL_PASSWORD=xxx
SENDGRID_API_KEY=xxxSome settings only apply to certain configurations, and some settings require some setup, for example if you want to use ethereal, you will need to set up an account and grab the user, account, and password, if you want to use sendgrid, you will need to get an api key etc.
These tasks I leave up to you, but I will mention them as each settings require them, just remember to come back and add in the settings you need.
(defconfig |dummy-email|
`(:debug T
,@|sqlite-middleware|
:email-backend :dummy ; 1
:email-default-from ,(uiop:getenv "EMAIL_DEFAULT_FROM"))) ; 2This helps us really focus on what we are adding in, it’s worth noting that these settings don’t configure anything yet, but they will when we write the email package, but for now we are:
Since this requires the EMAIL_DEFAULT_FROM setting, please ensure you have an actual value stored.
Our next three configs follow a similar pattern.
Ethereal is a free fake smtp service, it’s a great way to check smtp settings are correct prior to potentially spamming an email account with testing emails. We will use this as a test, while I have an example for smtp settings for gmail, this is not a comprehensive guide to every email provider, so etheral should help you test things, if I have not covered your specific email provider, or… Like me, your account was too locked down to use as an email.
Ethereal has a help page where you can find the host settings etc. The SMTP_ETHERAL_ACCOUNT_NAME gets used for the :email-default-from and :email-reply-to as well as part of the :email-auth settings, there will also be an account password when you set an account up, which will be stored as SMTP_ETHEREAL_PASSWORD and used in the :email-auth too.
(defconfig |ethereal-smtp|
`(:debug T
,@|middleware|
:email-backend :smtp
:email-smtp-host ,(uiop:getenv "SMTP_ETHEREAL_HOST")
:email-default-from ,(uiop:getenv "SMTP_ETHEREAL_ACCOUNT_NAME")
:email-reply-to ,(uiop:getenv "SMTP_ETHEREAL_ACCOUNT_NAME")
:email-port 587
:email-auth (,(uiop:getenv "SMTP_ETHEREAL_ACCOUNT_NAME") ,(uiop:getenv "SMTP_ETHEREAL_PASSWORD"))
:email-ssl :starttls))Remember: Add the following to your .env file!
SMTP_ETHEREAL_ACCOUNT_NAMESMTP_ETHEREAL_PASSWORDWhen we come to test this, we can use their web interface to check if email would have been sent.
Setting up GMail for smtp can be a little tricky, certain security settings have to be enabled (and certain ones NOT), at a minimum you must have mfa set up on the account, and Google no longer allows username and passwords as authentication, you must set up an “app password” for your application and use that for the authentication.
No big deal really, but it’s some gotchas that you’ll want to be aware of if you are using GMail as your email provider, again this isn’t a tutorial on how to configure GMail for SMTP, this is how to make Common Lisp use it once it is configured.
(defconfig |gmail-smtp|
`(:debug T
,@|middleware|
:email-backend :smtp
:email-smtp-host ,(uiop:getenv "SMTP_GMAIL_HOST")
:email-default-from ,(uiop:getenv "SMTP_GMAIL_ACCOUNT_NAME")
:email-reply-to ,(uiop:getenv "SMTP_GMAIL_ACCOUNT_NAME")
:email-port 587
:email-auth (,(uiop:getenv "SMTP_GMAIL_ACCOUNT_NAME") ,(uiop:getenv "SMTP_GMAIL_PASSWORD"))
:email-ssl :starttls))Remember: Add in the following values in your .env file!
SMTP_GMAIL_HOSTSMTP_GMAIL_ACCOUNT_NAMESMTP_GMAIL_PASSWORDSendgrid is a popular way to send mass emails, to get set up you will need an account with an api-key. Once you have those, the settings are as follows.
(defconfig |sendgrid|
`(:debug T
,@|middleware|
:email-backend :sendgrid
:email-reply-to ,(uiop:getenv "EMAIL_DEFAULT_FROM")
:sendgrid-api-key ,(uiop:getenv "SENDGRID_API_KEY")))Remember: Add the following to your .env file!
EMAIL_DEFAULT_FROMSENDGRID_API_KEYNow that we have your config in place, we can look at building an email package, don’t worry though it’s less than 50 lines, so nothing too crazy, we just create a package because Ningle is a micro framework and so we create small packages to work with it. Perhaps in a later version of this series we build a tighter coupled framework, but not right now.
Using my project builder create a new project like so:
(nmunro-project:make-project #p"~/quicklisp/local-projects/ningle-email")
In the project asd file we need to depend on three packages:
And with that, we can edit ningle-email/src/main.lisp and write two simple mail functions send-mail and mail-admins.
(defpackage ningle-email
(:use :cl)
(:export #:mail-admins
#:send-mail))
(in-package ningle-email)
(defun mail-admins (subject message)
"Sends an email to the admins"
(let ((project-name (envy-ningle:get-config :project-name))
(admins (envy-ningle:get-config :email-admins)))
(send-mail (format nil "[~A]: ~A" project-name subject) message admins)))
(defun send-mail (subject content to &key (from (envy-ningle:get-config :email-default-from)))
"Sends arbitrary email"
(let ((email-backend (envy-ningle:get-config :email-backend)))
(case email-backend
(:dummy
(progn
(format t "from: ~A~%" from)
(format t "to: ~A~%" to)
(format t "subject: ~A~%" subject)
(format t "content: ~A~%" content)))
(:smtp
(cl-smtp:send-email
(envy-ningle:get-config :email-smtp-host)
from
to
subject
message
:port (or (envy-ningle:get-config :email-port) 587)
:ssl (or (envy-ningle:get-config :email-ssl) :starttls)
:authentication (envy-ningle:get-config :email-auth)))
(:sendgrid
(sendgrid:send-email
:to to
:from from
:subject subject
:content message
:api-key (envy-ningle:get-config :sendgrid-api-key)))
(otherwise
(error "Unknown email backend: ~A" email-backend)))))It may seem a little unusual to define the mail-admins before we have defined our send-mail and while in common lisp it’s possible to compile a function that calls a function that doesn’t yet exist, because it will be compiled immediately after.
Our new mail-admins function will be a simple wrapper around the send-mail function, so we will look at that first.
(defun mail-admins (subject message)
"Sends an email to the admins"
(let ((project-name (envy-ningle:get-config :project-name))
(admins (envy-ningle:get-config :email-admins)))
(send-mail (format nil "[~A]: ~A" project-name subject) message admins)))We don’t yet know the shape of our send-mail function, we only know that we will use it, and in fact, thinking about how we will get and pass information into it, will help us see how its interface might be. When we mail our admins, we already know who we are emailing (our admins) and we also know who the email will be from (our application) so in reality we need a subject and message as parameters.
Although we know who is being mailed by who, we might want to make clear what they are being emailed by, our admins probably get a lot of mail, so I have made a choice that the email title will be [NTP]: <project name> in this way it’s clear that the service has mailed them.
We create a let block that grabs the project name from the settings. We also get the list of project admins from the settings in this block too and we simply call send-mail with a subject (our format expression), a message and a list of recipients (our admins), and with that done, we now know our send-mail function has parameters for a subject, a message, and a list of recipients, we might want to change the default sender, so we can add a &key parameter for this, but we will default it to putting the email from the settings.
(defun send-mail (subject content to &key (from (envy-ningle:get-config :email-default-from)))
"Sends arbitrary email"
(let ((email-backend (envy-ningle:get-config :email-backend)))
(case email-backend
(:dummy
(progn
(format t "from: ~A~%" from)
(format t "to: ~A~%" to)
(format t "subject: ~A~%" subject)
(format t "content: ~A~%" content)))
(:smtp
(cl-smtp:send-email
(envy-ningle:get-config :email-smtp-host)
from
to
subject
message
:port (or (envy-ningle:get-config :email-port) 587)
:ssl (or (envy-ningle:get-config :email-ssl) :starttls)
:authentication (envy-ningle:get-config :email-auth)))
(:sendgrid
(sendgrid:send-email
:to to
:from from
:subject subject
:content message
:api-key (envy-ningle:get-config :sendgrid-api-key)))
(otherwise
(error "Unknown email backend: ~A" email-backend)))))As you can see, our parameters are quite simply what our mail-admins specified, the only tricky thing is the from parameter, which simply pulls a default value of :email-default-from from our settings, so in most cases the send-mail function will do exactly the right thing, but it’s possible to override the from, if needed.
The rest of this function is really quite simple, it’s just a case that checks the :email-backend setting we defined in our settings and dispatches to another package for the actual logic. The :dummy backend simply prints the email information to the terminal, the :smtp backend delegates to the cl-smtp package, the :sendgrid backend delegates to the :cl-sendgrid package and, finally, if the email backend wasn’t recognised and error is signalled.
That really is all we need to write for our email package, with it complete we can look at integrating it into our project as a whole and into the auth package we built last time.
Since we now created a package we will be relying on, the first thing we need to do is to ensure we include it in the dependencies of this project.
:depends-on (:cl-dotenv
:clack
:djula
:cl-forms
:cl-forms.djula
:cl-forms.ningle
:envy-ningle
:mito
:ningle
:local-time
:cu-sith
:ningle-email) ; add thisWe will make a slight change to the models, but this is only to support the expiration time that we defined in our settings. In our ningle-auth/src/models.lisp file we will make two changes.
(defmethod initialize-instance :after ((token token) &rest initargs &key &allow-other-keys)
(unless (slot-boundp token 'salt)
(setf (token-salt token) (ironclad:make-random-salt 16)))
(unless (slot-boundp token 'expires-at)
; change the below line from 3600 to the :token-expiration setting
(setf (token-expires-at token) (+ (get-universal-time) (envy-ningle:get-config :token-expiration))))) And here.
; Again change the token from 3600 to the value stored in the setting
(defmethod generate-token ((user user) purpose &key (expires-in (envy-ningle:get-config :token-expiration)))
(unless (member purpose +token-purposes+ :test #'string=)
(error "Invalid token purpose: ~A. Allowed: ~A" purpose +token-purposes+))
(let* ((salt (ironclad:make-random-salt 16))
(expires-at (truncate (+ (get-universal-time) expires-in)))
(base-string (format nil "~A~A~A" (username user) expires-at salt))
(hash (ironclad:byte-array-to-hex-string (ironclad:digest-sequence :sha256 (babel:string-to-octets base-string)))))
(create-dao 'token :user user :purpose purpose :token hash :salt salt :expires-at expires-at)))Now, since we deal a lot with token generations that are actually urls in our application, I decided we should simplify this a little by creating some utlity functions that generate these, as we do call them over and over again under different circumstances.
So, the first thing to add into our main.lisp are these utility functions:
(defun build-url-root (&key (path ""))
(format nil "~A://~A:~A~A"
(lack/request:request-uri-scheme ningle:*request*)
(lack/request:request-server-name ningle:*request*)
(lack/request:request-server-port ningle:*request*)
path))
(defun build-activation-link (user token)
(let ((host (build-url-root :path (envy-ningle:get-config :auth-mount-path))))
(format nil "~A/verify?user=~A&token=~A~%" host (ningle-auth/models:username user) (ningle-auth/models:token-value token))))
(defun build-reset-link (user token)
(let ((host (build-url-root :path (envy-ningle:get-config :auth-mount-path))))
(format nil "~A/reset/process?user=~A&token=~A~%" host (ningle-auth/models:username user) (ningle-auth/models:token-value token))))In other frameworks there would ideally be a way to build an absolute url from the request object, but ningle is pretty lightweight, so we will make do with these.
We start with the build-url-root, which will build a url from the request object, using the scheme, server name, port, and any path parts. At the moment I don’t do any checking for the port to be 80 or 443, maybe that’s something for later! The intention is this will build up the basic part of our url, and the two functions build-activation-link and build-reset-link will use it to, well, build the links.
Each function will return a string that represents the link it is concerned with building, it doesn’t do anything we weren’t doing before, but instead of building the link in each place it is used, we have one place where the links are built, so that if we need to change it, we easily can. Each function only needs to take a user, and a token, it it then looks up the username and token-value of the objects and we’re pretty much done!
We don’t have too much we need to change here, only three areas or so, let’s start in our /register controller.
We previously had just a username and token and we used format to display this in the terminal, however if we want to do things right and send emails, we need to make some adjustments.
(let* ((user (mito:create-dao 'ningle-auth/models:user :email email :username username :password password))
(token (ningle-auth/models:generate-token user ningle-auth/models:+email-verification+))
(link (build-activation-link user token))
(subject (format nil "Ningle Tutorial Project registration for ~A" user))
(template "ningle-auth/email/register.txt")
(content (djula:render-template* template nil :user user :link link)))
(ningle-email:send-mail subject content email)In addition to the user and token, we need to generate the link we will send using the build-activation-link function we just wrote above, also, since we know our email needs a subject, we create that now in our let* block. Next we will have our template, although we haven’t yet created these, we will next, and our email content will use djula and this template location to render the content and store it ready for us to user in our send-mail invocation. Since this is happening in our /register controller, we already have an email address to send to, so we don’t need to create a new variable for that, it is already in scope.
The next place to make a change is in our /reset controller, there are two areas here where we would change things, thankfully the changes are exactly the same.
((and user token)
(mito:delete-dao token)
(let* ((token (ningle-auth/models:generate-token user ningle-auth/models:+password-reset+))
(link (build-reset-link user token))
(subject (format nil "Ningle Tutorial Project password reset for ~A" user))
(template "ningle-auth/email/reset.txt")
(content (djula:render-template* template nil :user user :link link)))
(ningle-email:send-mail subject content email)
(ingle:redirect "/")))Here, in the case where we have a user and a token object, we perform basically the same set of steps we did before, getting the token, link, subject, template, and content and passing that on into the send-mail function. It’s worth noting that the template we are loading is different (although, again, we haven’t yet written the templates).
(user
(let* ((token (ningle-auth/models:generate-token user ningle-auth/models:+password-reset+))
(link (build-reset-link user token))
(subject (format nil "Ningle Tutorial Project password reset for ~A" user))
(template "ningle-auth/email/reset.txt")
(content (djula:render-template* template nil :user user :link link)))
(ningle-email:send-mail subject content email)
(ingle:redirect "/")))This code is identical as the above, we can probably consolidate these down in a refactor later, but we will keep focused on getting our email working first.
The final place to change things is in the /verify controller.
((and token (ningle-auth/models:is-expired-p token))
(mito:delete-dao token)
(let* ((new-token (ningle-auth/models:generate-token user ningle-auth/models:+email-verification+))
(link (build-activation-link user new-token))
(subject (format nil "Ningle Tutorial Project registration for ~A" user))
(template "ningle-auth/email/register.txt")
(content (djula:render-template* template nil :user user :link link)))
(ningle-email:send-mail subject content (ningle-auth/models:email user))
(djula:render-template* "ningle-auth/verify.html" nil :title "Verify" :token-reissued t)))In this case however a new token is being issued, as it has expired at this point in the application lifecycle and needs to be reissued. There’s nothing really new here we haven’t seen before in our previous examples.
The only other thing I have changed is to remove the format line from inside the (not token) and t branches of the cond here, as they’re no longer needed.
And with those changes, we can move onto our templates!
Since we will be sending email, and our controllers specify that we will be rendering templates we need to set these up, as discussed in Part 9 (Authentication System) we looked into how templates override each other, so we need to ensure our email templates are in the correct place to that our main application can override them, if needed.
Remember: These template must be placed in ningle-auth/src/templates/ningle-auth/email as it’s this directory structure that allows us to override in broader projects!
Our base.html is going to be really very simple, it provides a content block that other templates can inject content into, but it also serves another purpose, a file we can override in another project and add headers/footers etc without having to override every template.
This is why its content is so small, we’d almost never directly use this, but because it’s a base template that others extend, we can use it!
{% block content %}{% endblock %}Our register template will extend the base and provide the information a user will need to continue setting up their account. The template is simple enough (why complicate it?), but you must pay attention to the safe filter that is being used to correctly encode the url.
{% extends "ningle-auth/email/base.txt" %}
{% block content %}
Hello, {{ user.username }}!
Thanks for registering, for security reasons you must verify your account by clicking on this link:
{{ link|safe }}
This link will expire in 1 hour.
If this was not you, you can ignore this email, as an account will not be activated without clicking on the above link.
{% endblock %}The reset template is very similar to the register template, just with some slightly different wording, but just mind and use the safe template filter as before!
{% extends "ningle-auth/email/base.txt" %}
{% block content %}
Hello, {{ user.username }}!
We have received a password change request for your account, to do so, click this url:
{{ link|safe }}
This link will expire in 1 hour.
If this was not you, you can ignore this email, as your password will not be changed without clicking on the above link.
{% endblock %}Now that we have our controllers wired up to send emails that are rendered from templates, we are ready to finally connect everything up!
As we mentioned in the previous section, our ningle-auth email base template can be overridde, and in fact that’s exactly what we are going to do. We need to create the following file in our ningle-tutorial-project project: src/templates/ningle-auth/email/base.txt and we are going to add a footer!
{% block content %}{% endblock %}
Ningle Tutorial ProjectIt’s not a lot of code, and to be fair, that was the point, we can quickly and easily override the ningle-auth base template and add in a footer (or a header, or both, if you like), into the email base template and everything just works as we need it to.
Mercifully this tutorial is a lot shorter than the last time, and good news! This means we now have everything we need to begin working on a microblog! Authentication and email are very important, but they highlight a trade off in micro frameworks and macro frameworks, in micro frameworks we have to do a lot of the work either connecting up third party packages, or writing our own, but we are done now, and we can focus on what we set out to do.
We will begin next time by looking at users, and how to display information about their followers etc.
Thank you for following this tutorial series, I hope you are finding it as interesting/helpful to read as I am finding it interesting/helpful to write.
| Level | Learning Outcome |
|---|---|
| Remember | Identify the configuration options required for setting up different email backends (dummy, smtp, sendgrid) in a Ningle application. Recall the purpose of the .env file and its role in storing sensitive credentials. |
| Understand | Explain the difference between dummy, SMTP, and SendGrid email backends and when each might be used. Describe how template overrides in ningle-auth allow flexibility for customizing email content. |
| Apply | Configure a Ningle project to use different email backends by modifying defconfig settings. Use Djula templates to generate dynamic email content (e.g., activation and reset links). |
| Analyze | Compare the advantages and trade-offs of using a microframework (Ningle) versus a macro framework for handling email workflows. Examine how token expiration settings affect authentication workflows and security. |
| Evaluate | Assess the security implications of storing and handling email credentials in .env files. Justify the choice of email backend for different project stages (development, testing, production). |
| Create | Design and implement a custom email notification (e.g., welcome email, alert system) using the ningle-email package. Extend the project by building reusable utility functions to streamline email workflows beyond registration and password resets. |
Welcome back to this tutorial series, in this chapter we are going to build an authentication system and I ain’t gonna lie to you, it’s something of a monster of a chapter, we will be extending our settings, writting middleware code and injecting settings into apps at the point they are mounted, so buckle up, it’ll be a wild ride.
NOTE:
I have published an updated envy-ningle. Please ensure you have updated to this version before continuing with this tutorial. The recommended version ofenvy-ninglefor this lesson isv0.0.2.
We will be developing an authentication app that:
This will render a form that uses csrf protection, when a user fills in the form if the username or email address they have entered is already in use by another user, an error will be signalled, if they have entered two different passwords into the password and password-verify another error will be signalled. Assuming no errors are signalled, a user and token object will be created, a unique url based on the username and token will be displayed to the terminal (later to be send via email), and the browser is redirected to another route. It is important to note that tokens will only be valid for one hour.
This is the second step in the user registration process, for the moment we will use the url printed in the terminal from the previous step (but remember this will be emailed to users later), when the url is requested, if there is a user that is already logged in, they will be redirected away from the url. If there is a matching token but it is expired, a new token will be issued (deleting the old one in the process), as before, a new url will be printed to the terminal. If there is no token, an error page will be displayed. Finally, if a token exists, it is valid, and there’s no logged in user, we can proceed with activating the user. This will delete the token, set up permissions for the user, activate and save the user and redirect the browser to the login route.
This will render a form to users to log in with as with our register form it will be protected with a csrf token, if a user is already logged in, it will redirect them away from this route, if there is a csrf token error this will be signalled, likewise errors will be signalled for users that don’t exist (or have not yet been activated via the verification process described above), or the password is invalid for the given user. If however there are no errors the user is logged in and redirected to a new url. As part of this, a route /profile will be set up that will only be accessible to users that are logged in.
Users forget their password, it happens, we need to facilitate a way to reset their password. This will be a two step process, as always we will have our form contain a csrf token, so it might be that this controller signals an error, but assuming this hasn’t happened. If there’s a user, and a token, but the token hasn’t expired, this suggests that a previous attempt was made, so an error should be sent back informing the user that they must either complete the reset, or wait for the token to expire.
If there is a user and a token that has expired, the old token will be deleted and a new one issued, the new url will then be displayed on the terminal (as always with these links they will be emailed in the future) and the browser will redirect.
If there is only a user and no token, this means that the reset process is being started for the first time and a token will be issued, the url printed to the terminal and the browser redirected.
Finally if there is no user found, an error will be displayed in the controller.
Once the request to reset the password has been processed, the password should be reset, this controller will render the password reset form, if the user is logged in the browser should be redirected away from this url.
If there is no reset token, or it has expired an error should be rendered in the browser.
If there is a valid reset token, the form can be rendered to accept a new password, upon form submisison, as with all forms a csrf token protects the form and this can be signalled, likewise if two different passwords are entered, this will signal an error.
When the user, token, and passwords match the new user password is set and the user object is saved, the token is deleted and the browser is redirected, however if, for some reason, the user isn’t valid, an error will be displayed in the browser.
This will clear the active user from the session and redirect to the login page.
Before we begin in earnest we should remove a route setup in the last chapter that ultimately doesn’t belong in authentication, it more accurately belongs in user management, which we will explore in a futute chapter.
Find the controller for deleting users and delete it:
(setf (ningle:route *app* "/delete")
(lambda (params)
(djula:render-template* "auth/delete.html" nil :title "Delete")))Also find and remove the following templates:
src/templates/ningle-auth/delete.htmlsrc/templates/ningle-auth/logout.htmlIt was anticipated that that these may have been needed, but in the process of developing the solution, they weren’t actually needed.
The easiest place to start is with our forms, our forms control what data we want to send back and forth and how to validate it, so these offer a good high level view at what we will be doing. We previously wrote a form in the ningle-tutorial-app for registering users, we will move that form from the tutorial app and into the authentication app (ningle-auth) we created last time and we will create a few other forms too. As before, we used the cl-forms package, and so these forms should be familiar from Part 4, but specifically we have the following four forms:
Our register form concerns itself with allowing users to sign up to our application, it has the following fields:
1
2
3
4
5
6
(cl-forms:defform register (:id "register" :csrf-protection t :csrf-field-name "csrftoken")
((email :email :value "" :constraints (list (clavier:valid-email)))
(username :string :value "" :constraints *username-validator*)
(password :password :value "" :constraints *password-validator*)
(password-verify :password :value "" :constraints *password-validator*)
(submit :submit :label "Register")))
The fields have constraints on them as one might expect, as we do want to validate our forms! When this form is rendered a GET request will display this form and a POST request will process the data the form submitted.
Our login form concerns itself with allowing registered users to log into our application, this is as simple as a username and a password, we do not necessarily need to validate these they will only be comparing objects in the database not creating new objects.
1
2
3
4
(cl-forms:defform login (:id "login" :csrf-protection t :csrf-field-name "csrftoken")
((username :string :value "")
(password :password :value "")
(submit :submit :value "Login")))
Our reset-password form concerns itself with allowing registered users to begin the process of securely changing their password if they cannot login. We do not want just anyone to be able to reset a users password, so we will need a form that will take an email address and send a link the user can follow to actually change the password.
1
2
3
(cl-forms:defform reset-password (:id "password-reset" :csrf-protection 5 :csrf-field-name "csrftoken")
((email :string :value "")
(submit :submit :value "Reset")))
Our new-password form concerns itself with completing the process of securely changing the password of registered users that have begun the process if they cannot login. It is assumed that this form is served by a url that the user has received via email and requires matching usernames and secure tokens that an attacker couldn’t guess, also these tokens expire within 1 hour and are deleted after a single use, so cannot be reused and its unlikely they could be cracked within the 1 hour window in which they are valid.
It is important to note that the email, and token fields will be of the type hidden, we don’t want the user to fill these in directly, but we certainly want to validate them along with all the other items in the form. When the form is initially rendered, these will need to be populated by us.
1
2
3
4
5
6
(cl-forms:defform new-password (:id "new-password" :csrf-protection 5 :csrf-field-name "csrftoken")
((email :hidden :value "" :constraints (list (clavier:valid-email)))
(token :hidden :value "" :constraints *token-validator*)
(password :password :value "" :constraints *password-validator*)
(password-verify :password :value "" :constraints *password-validator*)
(submit :submit :value "Reset")))
In the ningle-auth application create src/forms.lisp:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
(defpackage ningle-auth/forms
(:use :cl)
(:export #:register
#:login
#:reset-password
#:new-password
#:email
#:username
#:token
#:password
#:password-verify))
(in-package ningle-auth/forms)
(defparameter *username-validator* (list (clavier:not-blank)
(clavier:is-a-string)))
(defparameter *password-validator* (list (clavier:not-blank)
(clavier:is-a-string)
(clavier:len :min 8)))
(defparameter *token-validator* (list (clavier:not-blank)
(clavier:is-a-string)
(clavier:len :min 64 :max 64)))
(cl-forms:defform register (:id "register" :csrf-protection t :csrf-field-name "csrftoken")
((email :email :value "" :constraints (list (clavier:valid-email)))
(username :string :value "" :constraints *username-validator*)
(password :password :value "" :constraints *password-validator*)
(password-verify :password :value "" :constraints *password-validator*)
(submit :submit :label "Register")))
(cl-forms:defform login (:id "login" :csrf-protection t :csrf-field-name "csrftoken")
((username :string :value "")
(password :password :value "")
(submit :submit :value "Login")))
(cl-forms:defform reset-password (:id "password-reset" :csrf-protection 5 :csrf-field-name "csrftoken")
((email :string :value "")
(submit :submit :value "Reset")))
(cl-forms:defform new-password (:id "new-password" :csrf-protection 5 :csrf-field-name "csrftoken")
((email :hidden :value "" :constraints (list (clavier:valid-email)))
(token :hidden :value "" :constraints *token-validator*)
(password :password :value "" :constraints *password-validator*)
(password-verify :password :value "" :constraints *password-validator*)
(submit :submit :value "Reset")))
With our forms defined, we can go back and write our models, we will look at each model in isolation, any methods, and then see the complete listing, so we can then see what we need to export after having looked at the basic functionality.
Our user model will use the mito-auth mixin to provide an interface with which we can use hashed and salted passwords, we will have a text column (:varchar 255) for our email and username fields, and an integer field that will represent if the user is “active” or not (if they have completed the registration steps). Since we are using the mito-auth mixin we have a number of fields hidden here and the details aren’t too important except to know that there’s a password-hash that will contain the salted and hashed password, mito-auth does the heavy lifting for us here.
1
2
3
4
5
(deftable user (mito-auth:has-secure-password)
((email :col-type (:varchar 255) :initarg :email :accessor email)
(username :col-type (:varchar 255) :initarg :username :accessor username)
(active :col-type :integer :initform 0 :accessor active))
(:unique-keys email username))
From the last line, we can see that both email and username should be unique.
The role model is quite simple and concerns itself with, as its name might suggest, roles, these are simply names and descriptions. When we come to writing our migrations, we will create admin and user roles and their permissions.
1
2
3
4
(deftable role ()
((name :col-type (:varchar 255) :initarg :name :accessor name)
(description :col-type (:varchar 2048) :initarg :description :accessor description))
(:unique-keys name))
We make the name unique here as we really don’t want two roles with the same name.
In order to grant user roles, we need a permission model, this will link a user to a role. As we build the application having a permission table allows us to grant or revoke permissions easily.
1
2
3
4
(deftable permission ()
((user :col-type user :references (user id))
(role :col-type role :references (role id)))
(:unique-keys (user role)))
Where we previously defined unique fields, here we define a unique constraint where the same value can repeat in this table multiple times, and the same role can appear in this table multiple times, but the same role with the same user cannot appear more than once. In effect a user can only ever be assigned a given role once.
Our token model will concern itself with various tokens, in our authentication system there is only two an email-verification token and a password-reset token.
1
2
3
4
5
6
7
(deftable token ()
((user :col-type user :references (user id))
(purpose :col-type :string :initarg :purpose :accessor token-purpose)
(token :col-type (:varchar 64) :initarg :token :accessor token-value)
(salt :col-type :binary :accessor token-salt)
(expires-at :col-type :timestamp :accessor token-expires-at))
(:unique-keys (user-id purpose)))
As in our permission model, we have a constraint where a user can only ever have one type of token, there’s something to note, that while our field is called user and we can use that in code, the actual name in the database is user_id. Just like our user model, we will use salts and hashes to create unique and secure tokens.
While not all of our models require methods, some do, staring with our token model we have to check if a token has expired, so we will write a method that simply returns t or nil depending on if the token has indeed expired, or not.
The type of the expiration date may change depending on when it is serialized, so we use a typecase here to handle the different types it may be.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
(defgeneric is-expired-p (token)
(:documentation "Determines if a token has expired"))
(defmethod is-expired-p ((token token))
(let ((expiry (token-expires-at token)))
(typecase expiry
(local-time:timestamp
(> (get-universal-time) (local-time:timestamp-to-universal expiry)))
(integer
(> (get-universal-time) expiry))
(t
(error "Unknown type for token-expires-at: ~S" (type-of expiry))))))
Since we have specific token types, we want to ensure that invalid values cannot be passed into the objects, so here we write our own implementations of the initialize-instance method using :before and :after to ensure that if an invalid token type is passed in we signal an error, but also, if no salt or expires-at value was provided, a default is created, for security.
1
2
3
4
5
6
7
8
9
10
(defmethod initialize-instance :before ((token token) &rest initargs &key purpose &allow-other-keys)
(unless (member purpose +token-purposes+ :test #'string=)
(error "Invalid token purpose: ~A. Allowed: ~A" purpose +token-purposes+)))
(defmethod initialize-instance :after ((token token) &rest initargs &key &allow-other-keys)
(unless (slot-boundp token 'salt)
(setf (token-salt token) (ironclad:make-random-salt 16)))
(unless (slot-boundp token 'expires-at)
(setf (token-expires-at token) (+ (get-universal-time) 3600))))
Finally the methods for our user object, we will start by defining a method to activate our user object (which will be used when a user completes the account verification step), all this does is set the active slot on the user object to 1, please note that due to separation of concerns and the principle of the least surprise setting the active flat does not save the user object.
1
2
3
4
5
(defgeneric activate (user)
(:documentation "Set the active slot of a user to 1"))
(defmethod activate ((user user))
(setf (active user) 1))
As we have mentioned, we must create tokens, and tokens are linked to a user, so it makes sense to have a method that dispatches on a user model for creating a token, calling generate-token with a user and a valid token type will create and return the token.
1
2
3
4
5
6
7
8
9
10
11
12
(defgeneric generate-token (user purpose &key expires-in)
(:documentation "Generates a token for a user"))
(defmethod generate-token ((user user) purpose &key (expires-in 3600))
(unless (member purpose +token-purposes+ :test #'string=)
(error "Invalid token purpose: ~A. Allowed: ~A" purpose +token-purposes+))
(let* ((salt (ironclad:make-random-salt 16))
(expires-at (truncate (+ (get-universal-time) expires-in)))
(base-string (format nil "~A~A~A" (username user) expires-at salt))
(hash (ironclad:byte-array-to-hex-string (ironclad:digest-sequence :sha256 (babel:string-to-octets base-string)))))
(create-dao 'token :user user :purpose purpose :token hash :salt salt :expires-at expires-at)))
We have discussed the two token types, they’re simple strings, but we define them in our package and include them in a list so that if we add more it’s easy to check membership of +token-purposes+.
1
2
3
(defparameter +email-verification+ "email-verification")
(defparameter +password-reset+ "password-reset")
(defparameter +token-purposes+ (list +email-verification+ +password-reset+))
Unusually, we are looking at the package structure and exports now at the end, but we didn’t know what would be exported until we wrote it!
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
(defpackage ningle-auth/models
(:use :cl :mito)
(:import-from :mito-auth
:password-hash)
(:export #:user
#:id
#:created-at
#:updated-at
#:email
#:username
#:password-hash
#:role
#:permission
#:token
#:token-value
#:generate-token
#:is-expired-p
#:activate
#:+email-verification+
#:+password-reset+
#:+token-purposes+))
(in-package ningle-auth/models)
In the ningle-auth application create src/models.lisp:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
(defpackage ningle-auth/models
(:use :cl :mito)
(:import-from :mito-auth
:password-hash)
(:export #:user
#:id
#:created-at
#:updated-at
#:email
#:username
#:password-hash
#:role
#:permission
#:token
#:token-value
#:generate-token
#:is-expired-p
#:activate
#:+email-verification+
#:+password-reset+
#:+token-purposes+))
(in-package ningle-auth/models)
(defparameter +email-verification+ "email-verification")
(defparameter +password-reset+ "password-reset")
(defparameter +token-purposes+ (list +email-verification+ +password-reset+))
(deftable user (mito-auth:has-secure-password)
((email :col-type (:varchar 255) :initarg :email :accessor email)
(username :col-type (:varchar 255) :initarg :username :accessor username)
(active :col-type :integer :initform 0 :accessor active))
(:unique-keys email username))
(deftable role ()
((name :col-type (:varchar 255) :initarg :name :accessor name)
(description :col-type (:varchar 2048) :initarg :description :accessor description))
(:unique-keys name))
(deftable permission ()
((user :col-type user :references (user id))
(role :col-type role :references (role id)))
(:unique-keys (user role)))
(deftable token ()
((user :col-type user :references (user id))
(purpose :col-type :string :initarg :purpose :accessor token-purpose)
(token :col-type (:varchar 64) :initarg :token :accessor token-value)
(salt :col-type :binary :accessor token-salt)
(expires-at :col-type :timestamp :accessor token-expires-at))
(:unique-keys (user-id purpose)))
(defgeneric activate (user)
(:documentation "Set the active slot of a user to 1"))
(defmethod activate ((user user))
(setf (active user) 1))
(defgeneric is-expired-p (token)
(:documentation "Determines if a token has expired"))
(defmethod is-expired-p ((token token))
(let ((expiry (token-expires-at token)))
(typecase expiry
(local-time:timestamp
(> (get-universal-time) (local-time:timestamp-to-universal expiry)))
(integer
(> (get-universal-time) expiry))
(t
(error "Unknown type for token-expires-at: ~S" (type-of expiry))))))
(defmethod initialize-instance :before ((tok token) &rest initargs &key purpose &allow-other-keys)
(unless (member purpose +token-purposes+ :test #'string=)
(error "Invalid token purpose: ~A. Allowed: ~A" purpose +token-purposes+)))
(defmethod initialize-instance :after ((token token) &rest initargs &key &allow-other-keys)
(unless (slot-boundp token 'salt)
(setf (token-salt token) (ironclad:make-random-salt 16)))
(unless (slot-boundp token 'expires-at)
(setf (token-expires-at token) (+ (get-universal-time) 3600))))
(defgeneric generate-token (user purpose &key expires-in)
(:documentation "Generates a token for a user"))
(defmethod generate-token ((user user) purpose &key (expires-in 3600))
(unless (member purpose +token-purposes+ :test #'string=)
(error "Invalid token purpose: ~A. Allowed: ~A" purpose +token-purposes+))
(let* ((salt (ironclad:make-random-salt 16))
(expires-at (truncate (+ (get-universal-time) expires-in)))
(base-string (format nil "~A~A~A" (username user) expires-at salt))
(hash (ironclad:byte-array-to-hex-string (ironclad:digest-sequence :sha256 (babel:string-to-octets base-string)))))
(create-dao 'token :user user :purpose purpose :token hash :salt salt :expires-at expires-at)))
We know from a previous tutorial that when we are setting up and application of have changed the structures of the models we need to migrate them, we have seen that mito has the ensure-table-exists and migrate-table functions, so we must write a migration file.
As a reminder on how to create the tables for our four models.
1
2
3
4
(mito:ensure-table-exists 'ningle-auth/models:user)
(mito:ensure-table-exists 'ningle-auth/models:role)
(mito:ensure-table-exists 'ningle-auth/models:permission)
(mito:ensure-table-exists 'ningle-auth/models:token)
Migrating an existing table is similarly easy.
1
2
3
4
(mito:migrate-table 'ningle-auth/models:user)
(mito:migrate-table 'ningle-auth/models:role)
(mito:migrate-table 'ningle-auth/models:permission)
(mito:migrate-table 'ningle-auth/models:token)
If we have some objects we want to create as part of our migration, in our case creating “user” and “admin” roles, we might want to write something like the following:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
(defpackage ningle-auth/migrations
(:use :cl :mito)
(:export #:migrate))
(in-package :ningle-auth/migrations)
(defun migrate ()
"Explicitly apply migrations when called."
(format t "Applying migrations...~%")
(mito:ensure-table-exists 'ningle-auth/models:user)
(mito:ensure-table-exists 'ningle-auth/models:role)
(mito:ensure-table-exists 'ningle-auth/models:permission)
(mito:ensure-table-exists 'ningle-auth/models:token)
(mito:migrate-table 'ningle-auth/models:user)
(mito:migrate-table 'ningle-auth/models:role)
(mito:migrate-table 'ningle-auth/models:permission)
(mito:migrate-table 'ningle-auth/models:token)
(let ((admin-role (find-dao 'ningle-auth/models:role :name "admin")))
(unless admin-role
(create-dao 'ningle-auth/models:role :name "admin" :description "Admin")))
(let ((user-role (find-dao 'ningle-auth/models:role :name "user")))
(unless user-role
(create-dao 'ningle-auth/models:role :name "user" :description "User")))
(format t "Migrations complete.~%"))
You might notice at no point we establish a database connection to run this migration, don’t worry, we will come to that a little bit later, this migration function is assumed to be run inside a context where a database has already been established. This will come in handy if we had many applications that needed to be migrated, each migration wont be connecting and disconnecting, there’s one connection established, and all migrations run inside that connection.
Create src/migrations.lisp:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
(defpackage ningle-auth/migrations
(:use :cl :mito)
(:export #:migrate))
(in-package :ningle-auth/migrations)
(defun migrate ()
"Explicitly apply migrations when called."
(format t "Applying migrations...~%")
(mito:ensure-table-exists 'ningle-auth/models:user)
(mito:ensure-table-exists 'ningle-auth/models:role)
(mito:ensure-table-exists 'ningle-auth/models:permission)
(mito:ensure-table-exists 'ningle-auth/models:token)
(mito:migrate-table 'ningle-auth/models:user)
(mito:migrate-table 'ningle-auth/models:role)
(mito:migrate-table 'ningle-auth/models:permission)
(mito:migrate-table 'ningle-auth/models:token)
(create-dao 'ningle-auth/models:role :name "admin" :description "Admin")
(create-dao 'ningle-auth/models:role :name "user" :description "User")
(format t "Migrations complete.~%"))
The “main” event, so to speak! Most of our logic will go in here, remember however that our main project will set up the configuration and we will need a way to pass this down into applications it uses. There is a package I created for managing user objects in the http session called cu-sith, we will use that in our application here. We also use envy-ningle which adds some functions around envy to help build middleware etc.
So, before we work on the controllers, ensure you have downloaded cu-sith to your local package registry and once you have, add it to the dependencies in the application asd file, the full dependencies are shown here:
:depends-on (:cl-dotenv
:clack
:djula
:cl-forms
:cl-forms.djula
:cl-forms.ningle
:envy-ningle
:mito
:ningle
:local-time
:cu-sith)Once you have your dependencies in place, we can look at what we will initially change from last time. We have already spoken about removing the delete controller, which leaves us with six controllers to write.
We began our authentication application last time with this beginning:
(defpackage ningle-auth
(:use :cl)
(:export #:*app*
#:start
#:stop))
(in-package ningle-auth)
(defvar *app* (make-instance 'ningle:app))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-auth "src/templates/"))We will now begin adding some config, the application cu-sith that we added as a dependency is used to help manage the session, we need to provide it with a way to look up a user object and how to get a list of the permissions assigned to the user.
(cu-sith:setup
:user-p (lambda (username) (mito:find-dao 'ningle-auth/models:user :username username :active 1))
:user-roles (lambda (user) (mito:select-dao 'ningle-auth/models:permission (where (:= :user_id (mito:object-id user))))))We set up two lambda functions:
(lambda (username) (mito:find-dao 'ningle-auth/models:user :username username :active 1))This one will, given a username (a string) will use the mito orm to look up our user object, finding the object that matches the username and is also active (remember that the active column is used to determine if a user account is valid to use). Any time the application needs to find out if a user is logged in, this lambda function will be called.
(lambda (user) (mito:select-dao 'ningle-auth/models:permission (where (:= :user_id (mito:object-id user)))))This lambda function is used to get the permissions a logged in user has. We will want to check this regularly as a users permissions may change, and it would be poor security to continue to allow a user to perform an action they no longer had the permission for. It takes a user object, and then returns a list of permission object where the user id matches the user passed in. Cu-sith tries to be un-opinionated and doesn’t assume any structure about the way a user object or permissions are loaded, and in fact, because we define our own models here, cu-sith couldn’t possibly have known what our models are or how to use them, which is why we have to provide these functions.
cu-sith stores these lambda functions and runs them at key points in the application run time. Our authentication system can set these up and our project (ningle-tutorial-project) can make calls to cu-sith and everything will work together.
With this initial setup done, we can look at the individual controllers now!
While we looked at a version of the register controller previously, it has changed to a degree so we shall go through the process of writing this again.
As with any controller, we must bind it to our application, we know from our previous work that we bind a lambda, because we must also render a register form and submit data, the :methods that we ought to support are :GET and :POST:
(setf (ningle:route *app* "/register" :method '(:GET :POST))
(lambda (params)
...))Since we know we need to render both a :GET response and a :POST response, we can write a simple if expression, however, both branches will need to access the register form object, our :GET branch will simply render it, our :POST branch will read and validate data, we will look at the if branch first before looking at the else branch:
(let ((form (cl-forms:find-form 'register)))
(if (string= "GET" (lack.request:request-method ningle:*request*))
(djula:render-template* "ningle-auth/register.html" nil :title "Register" :form form)
...))We first load the form object, and if the http request type is :GET we use djula to render a register template passing in the blank form, however if the http request type is :POST we will want to do a lot more. We will start with a handler-case, run progn which could potentially throw some errors.
(handler-case
(progn
...)
(error (err)
(djula:render-template* "error.html" nil :title "Error" :error err))
(simple-error (csrf-error)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error csrf-error)))There could be a csrf-error in which case we want to set the http response code to 403 and render an error template, with some sort of error displayed, however there may be other types of error we don’t have specific error types for, such as the user entered two different passwords (thus they don’t match) or they tried to register an account with a username or email address that already exists. We will in fact those exact situations into the progn!
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (email username password password-verify) form
(when (mito:select-dao 'ningle-auth/models:user
(where (:or (:= :username username)
(:= :email email))))
(error "Either username or email is already registered"))
(when (string/= password password-verify)
(error "Passwords do not match"))
(let* ((user (mito:create-dao 'ningle-auth/models:user :email email :username username :password password))
(token (ningle-auth/models:generate-token user ningle-auth/models:+email-verification+)))
(format t "Reset url: ~A~A/verify?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:username user)
(ningle-auth/models:token-value token))
(ingle:redirect "/")))))We start by handling the request of the form, which can throw a csrf error (handled in the handler-case as described above), but assuming the form is able to pass the security checks we must then validate the form (with the validators we wrote on them). When there are errors we shall simply display them by using format to display them in the running terminal.
If however the form is valid, we can continue to process the form as the data is both secure and valid (although that doesn’t mean we’re ready to accept it yet!) we then want to grab the field values with (cl-forms:with-form-field-values ...) we will grab the email, username, password, and password-verify values from the form.
Using:
(when (mito:select-dao 'ningle-auth/models:user
(where (:or (:= :username username)
(:= :email email))))
(error "Either username or email is already registered"))```We check the username and email values to ensure no user object can be found with either of them, if a user can be found we signal an error.
Likewise with the following:
(when (string/= password password-verify)
(error "Passwords do not match"))If the password and password-verify do not match, we will signal an error again.
Finally, if none of our error conditions have triggered, we can begin to process the data. The following eight lines, do the heavy lifting for us.
1
2
3
4
5
6
7
8
(let* ((user (mito:create-dao 'ningle-auth/models:user :email email :username username :password password))
(token (ningle-auth/models:generate-token user ningle-auth/models:+email-verification+)))
(format t "Reset url: ~A~A/verify?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:username user)
(ningle-auth/models:token-value token))
(ingle:redirect "/"))
Using a let* binding we create a user object (notice that the active flag is NOT set, as we want users to complete a login flow), and a token object (of the type +email-verification+), once both of these objects are created we simply build up the url that a user needs to click to take them to form that will activate the user, while we are printing this out to the terminal right now, it is intended that these will be emailed out. Lines 3-7 build and print this url, and finally, once that is done, the controller redirects the browser to the “/” route.
(setf (ningle:route *app* "/register" :method '(:GET :POST))
(lambda (params)
(let ((form (cl-forms:find-form 'register)))
(if (string= "GET" (lack.request:request-method ningle:*request*))
(djula:render-template* "ningle-auth/register.html" nil :title "Register" :form form)
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (email username password password-verify) form
(when (mito:select-dao 'ningle-auth/models:user
(where (:or (:= :username username)
(:= :email email))))
(error "Either username or email is already registered"))
(when (string/= password password-verify)
(error "Passwords do not match"))
(let* ((user (mito:create-dao 'ningle-auth/models:user :email email :username username :password password))
(token (ningle-auth/models:generate-token user ningle-auth/models:+email-verification+)))
(format t "Reset url: ~A~A/verify?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:username user)
(ningle-auth/models:token-value token))
(ingle:redirect "/"))))))
(error (err)
(djula:render-template* "error.html" nil :title "Error" :error err))
(simple-error (csrf-error)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error csrf-error)))))))To verify our user after initial user registration we must activate the user securely, we start with the usual setup:
(setf (ningle:route *app* "/register" :method '(:GET :POST))
(lambda (params)
...))Since we are passing a user and token as Query parameters we will immediately extract these in a let* and since we have multiple conditions to check we will use a cond.
(let* ((user (mito:find-dao 'ningle-auth/models:user :username (cdr (assoc "user" params :test #'string=))))
(token (mito:find-dao 'ningle-auth/models:token :user user :purpose ningle-auth/models:+email-verification+ :token (cdr (assoc "token" params :test #'string=)))))
(cond
...)There are four conditions to manager inside this cond, the first is to check if the user is logged in, then redirect if they are.
((cu-sith:logged-in-p)
(ingle:redirect "/"))The second condition is when there is a token, but it has expired, we will delete the existing token and issue a new one, printing out the new url and rendering the verification template.
((and token (ningle-auth/models:is-expired-p token))
(mito:delete-dao token)
(let ((new-token (ningle-auth/models:generate-token user ningle-auth/models:+email-verification+)))
(format t "Token ~A expired, issuing new token: ~A~A/verify?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:token-value token)
(ningle-auth/models:username user)
(ningle-auth/models:token-value new-token)))
(djula:render-template* "ningle-auth/verify.html" nil :title "Verify" :token-reissued t))The third condition is when no token exists, an error message is rendered to the error template.
((not token)
(format t "Token ~A does not exist~%" (cdr (assoc "token" params :test #'string=)))
(djula:render-template* "error.html" nil :title "Error" :error "Token not valid"))Finally, we can activate the user by first deleting the verification token, creating the permissions to be associated with the user account, set the user as active and save them. The browser will then redirect to the "/login" route.
(t
(mito:delete-dao token)
(mito:create-dao 'ningle-auth/models:permission :user user :role (mito:find-dao 'ningle-auth/models:role :name "user"))
(ningle-auth/models:activate user)
(mito:save-dao user)
(format t "User ~A activated!~%" (ningle-auth/models:username user))
(ingle:redirect (concatenate 'string (envy-ningle:get-config :auth-mount-path) "/login")))(setf (ningle:route *app* "/verify")
(lambda (params)
(let* ((user (mito:find-dao 'ningle-auth/models:user :username (cdr (assoc "user" params :test #'string=))))
(token (mito:find-dao 'ningle-auth/models:token :user user :purpose ningle-auth/models:+email-verification+ :token (cdr (assoc "token" params :test #'string=)))))
(cond
((cu-sith:logged-in-p)
(ingle:redirect "/"))
((and token (ningle-auth/models:is-expired-p token))
(mito:delete-dao token)
(let ((new-token (ningle-auth/models:generate-token user ningle-auth/models:+email-verification+)))
(format t "Token ~A expired, issuing new token: ~A~A/verify?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:token-value token)
(ningle-auth/models:username user)
(ningle-auth/models:token-value new-token)))
(djula:render-template* "ningle-auth/verify.html" nil :title "Verify" :token-reissued t))
((not token)
(format t "Token ~A does not exist~%" (cdr (assoc "token" params :test #'string=)))
(djula:render-template* "error.html" nil :title "Error" :error "Token not valid"))
(t
(mito:delete-dao token)
(mito:create-dao 'ningle-auth/models:permission :user user :role (mito:find-dao 'ningle-auth/models:role :name "user"))
(ningle-auth/models:activate user)
(mito:save-dao user)
(format t "User ~A activated!~%" (ningle-auth/models:username user))
(ingle:redirect (concatenate 'string (envy-ningle:get-config :auth-mount-path) "/login")))))))As always, let’s prepare the controller!
(setf (ningle:route *app* "/login" :method '(:GET :POST))
(lambda (params)
...))Immediately inside it, we will use let to grab the login form, we will then use a cond to handle the three conditions we described above, we have seen above how to handle the redirect case, so we will just include it now.
(let ((form (cl-forms:find-form 'login)))
(cond
((cu-sith:logged-in-p)
(ingle:redirect "/"))
...))Now, to render the form for a user to fill in (the GET request), you will notice that we pass in a new parameter url, this is the url that will be used to allow a user to click a “forgotten password” link, but of course since this application can’t know anything about where it is mounted we both have to look up from the envy-ningle package what the mount path is (we will look at the settings towards the end of this chapter when we integrate the app into our project), and pass the the result of concatenate with the mount path and /reset, since we mount this on /auth the result should be /auth/reset.
((string= "GET" (lack.request:request-method ningle:*request*))
(djula:render-template* "ningle-auth/login.html" nil :form form :url (concatenate 'string (envy-ningle:get-config :auth-mount-path) "/reset")))Finally, when the form is submitted (the POST request). We will start by using a handler-case (as we have done before) and immediately open a progn and use the cl-forms:handle-request to handle our form. There’s three errors to handle, two come from the cu-sith package, the invalid-user and invalid-password errors, the third is a standard csrf error that we have used before.
(t
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
...)
(cu-sith:invalid-user (err)
(djula:render-template* "error.html" nil :title "Error" :error (format nil "~A, have you verified the account?" (cu-sith:msg err))))
(cu-sith:invalid-password (err)
(djula:render-template* "error.html" nil :title "Error" :error (cu-sith:msg err)))
(simple-error (csrf-error)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error csrf-error))))We can see that if the invalid-user error is signalled, it might be that there is no such user, or that the user is not yet active, either way, the user isn’t permitted to log in, and is invalid, in which case rendering the error template with a relevent message is the most helpful thing to do.
The invalid-password is pretty obvious, the user exists but the password is incorrect, we handle it by rendering the error template.
Finally, as before, if the csrf error is triggered, we use the same handling logic we wrote previously in other controllers.
The rest of the login logic is quite short, within the handler-case and under the call to cl-forms:handle-request we can add the following:
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (username password) form
(cu-sith:login :user username :password password)
(ingle:redirect (envy-ningle:get-config :login-redirect)))))We bind the valid and errors using the multiple-value-bind (as we have done before), if there are errors print them to the terminal, and if the form is valid we use cl-forms:with-form-field-values (again, similarly to before), capturing the username and password, we use the cu-sith:login function with the username and password, the login function can signal the invalid-user or invalid-password that we wrote handlers for above. So either a user will be logged in and saved to the session and the browser will be redirected to a url looked up from settings (we will look at that later), or an error will be signalled which we handle.
(setf (ningle:route *app* "/login" :method '(:GET :POST))
(lambda (params)
(let ((form (cl-forms:find-form 'login)))
(cond
((cu-sith:logged-in-p)
(ingle:redirect "/"))
((string= "GET" (lack.request:request-method ningle:*request*))
(djula:render-template* "ningle-auth/login.html" nil :form form :url (concatenate 'string (envy-ningle:get-config :auth-mount-path) "/reset")))
(t
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (username password) form
(cu-sith:login :user username :password password)
(ingle:redirect (envy-ningle:get-config :login-redirect))))))
(cu-sith:invalid-user (err)
(djula:render-template* "error.html" nil :title "Error" :error (format nil "~A, have you verified the account?" (cu-sith:msg err))))
(cu-sith:invalid-password (err)
(djula:render-template* "error.html" nil :title "Error" :error (cu-sith:msg err)))
(simple-error (csrf-error)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error csrf-error))))))))You may be pleased to know that the logout controller is much, much simpler, all we need to is use cu-sith to log a user out.
(setf (ningle:route *app* "/logout" :method '(:GET :POST))
(lambda (params)
(cu-sith:logout)
(ingle:redirect (envy-ningle:get-config :login-redirect))))cu-sith:logout doesn’t signal any errors, all it does is remove a user and their permissions from the active session. Our controller then just redirects the browser.
The password reset process is a fair amount of code, however we have seen a decent amount of it already, certainly concerning the route, the lambda, grabbing a form and setting up a cond and handling redirecting the user if they are already logged in. So we will skip over aspects we have already seen before and setup the controller ready to add in the real logic. Lines 5-6 show the redirect, lines 8-9 show the rendering of the template with the form, and of course we have a handler-case in the cond where our logic goes.
Line 24 is where we will pick up the new material.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
(setf (ningle:route *app* "/reset" :method '(:GET :POST))
(lambda (params)
(let ((form (cl-forms:find-form 'reset-password)))
(cond
((cu-sith:logged-in-p)
(ingle:redirect "/"))
((string= "GET" (lack.request:request-method ningle:*request*))
(djula:render-template* "ningle-auth/reset.html" nil :title "Reset GET" :form form))
(t
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (email) form
...))))
(simple-error (csrf-error)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error csrf-error))))))))
We will start with a let* binding a user and token object, there may not always be a token, but there may be, within the let* we set up a cond with the four conditions we need to be aware of.
Our first check will check if there’s a user, a token, and the token has not expired, and if this condition is met, a warning about an active password reset in progress message is rendered in the error template.
(let* ((user (mito:find-dao 'ningle-auth/models:user :email email))
(token (mito:find-dao 'ningle-auth/models:token :user user :purpose ningle-auth/models:+password-reset+)))
(cond
((and user token (not (ningle-auth/models:is-expired-p token)))
(djula:render-template* "error.html" nil :title "Error" :error "There is already a password reset in progress, either continue or wait a while before retrying"))
...))The next check is if there’s a user and a token (implied to have expired since the check above checked the token wasn’t expired), if so, the token will be deleted, a new one created and a new url printed to the terminal, then the browser will be redirected. This follows a similar pattern for validating our user, which is fortunate, as much of this will be familiar.
((and user token)
(mito:delete-dao token)
(let ((token (ningle-auth/models:generate-token user ningle-auth/models:+password-reset+)))
(format t "Reset url: ~A~A/reset/process?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:username user)
(ningle-auth/models:token-value token)))
(ingle:redirect "/"))If there is only a user object (that is to say, no active token), the logic is similar to the check above, with the exception that there’s no token to delete.
(user
(let ((token (ningle-auth/models:generate-token user ningle-auth/models:+password-reset+)))
(format t "Reset url: ~A~A/reset/process?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:username user)
(ningle-auth/models:token-value token)))
(ingle:redirect "/"))Finally, if no user could be found, we should display an error:
(t
(djula:render-template* "error.html" nil :title "Error" :error "No user found"))(setf (ningle:route *app* "/reset" :method '(:GET :POST))
(lambda (params)
(let ((form (cl-forms:find-form 'reset-password)))
(cond
((cu-sith:logged-in-p)
(ingle:redirect "/"))
((string= "GET" (lack.request:request-method ningle:*request*))
(djula:render-template* "ningle-auth/reset.html" nil :title "Reset GET" :form form))
(t
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (email) form
(let* ((user (mito:find-dao 'ningle-auth/models:user :email email))
(token (mito:find-dao 'ningle-auth/models:token :user user :purpose ningle-auth/models:+password-reset+)))
(cond
((and user token (not (ningle-auth/models:is-expired-p token)))
(djula:render-template* "error.html" nil :title "Error" :error "There is already a password reset in progress, either continue or wait a while before retrying"))
((and user token)
(mito:delete-dao token)
(let ((token (ningle-auth/models:generate-token user ningle-auth/models:+password-reset+)))
(format t "Reset url: ~A~A/reset/process?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:username user)
(ningle-auth/models:token-value token)))
(ingle:redirect "/"))
(user
(let ((token (ningle-auth/models:generate-token user ningle-auth/models:+password-reset+)))
(format t "Reset url: ~A~A/reset/process?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:username user)
(ningle-auth/models:token-value token)))
(ingle:redirect "/"))
(t
(djula:render-template* "error.html" nil :title "Error" :error "No user found"))))))))
(simple-error (csrf-error)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error csrf-error))))))))Now that a reset url is generated, we need a controller to handle the actual changing of the password, as before we set a route and a handler, but what we will immediately do is grab the form, the user, and the token, with that done we will use a cond to handle the different cases we need to handle. We have seen before that the first condition is to redirect away if there is a logged in user, so it’s included immediately below.
(setf (ningle:route *app* "/reset/process" :method '(:GET :POST))
(lambda (params)
(let* ((form (cl-forms:find-form 'new-password))
(user (mito:find-dao 'ningle-auth/models:user :username (cdr (assoc "user" params :test #'string=))))
(token (mito:find-dao 'ningle-auth/models:token :user user :purpose ningle-auth/models:+password-reset+ :token (cdr (assoc "token" params :test #'string=)))))
(cond
((cu-sith:logged-in-p)
(ingle:redirect "/"))
...))))The next condition is if the token is invalid, where invalid is defined as not existing, or having expired. In this instance, the error template will be rendered by djula informing the user that the token is invalid.
((and (string= "GET" (lack.request:request-method ningle:*request*)) (or (not token) (ningle-auth/models:is-expired-p token)))
(djula:render-template* "error.html" nil :title "Error" :error "Invalid reset token, please try again"))Now our third condition concerns itself with rendering the form ready for a user to fill in, as discussed in the forms section, the email and token fields need to be populated so that they’re included in the complete POST request body, we then render the form.
((and (string= "GET" (lack.request:request-method ningle:*request*)) token)
(cl-forms:set-field-value form 'ningle-auth/forms:email (ningle-auth/models:email user))
(cl-forms:set-field-value form 'ningle-auth/forms:token (ningle-auth/models:token-value token))
(djula:render-template* "ningle-auth/reset.html" nil :title "Create a new password" :form form))The final condition is processing the form and is our fall through case or t (as we have seen many times before already). The pattern which has emerged is to have a handler-case with a progn inside it and handle, certainly the csrf token error (if it occurs) and any other errors, in this case we will only need to check that passwords do not match. Again, there’s some boiler plate code we are using, such as cl-forms:handle-request and binding valid and errors and checking for each. Inside our (when valid ...) is where the main logic goes.
(t
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
...)))
(error (err)
(djula:render-template* "error.html" nil :title "Error" :error err))
(simple-error (csrf-error)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error csrf-error))))As with in previous form logic, we need to get the field values from cl-forms, and if the two passwords do not match, an error will be signalled, which we handle in the code above.
(cl-forms:with-form-field-values (email token password password-verify) form
(when (string/= password password-verify)
(error "Passwords do not match"))
...)If no error is signalled then, we can assume that we are able to go ahead and update the user object. We start by opening a let* block to capture the user and token. If the user exists we will process the update, and if there is no user render a template to inform the browser that there is no such user.
(let* ((user (mito:find-dao 'ningle-auth/models:user :email email))
(token (mito:find-dao 'ningle-auth/models:token :user user :token token :purpose ningle-auth/models:+password-reset+)))
(if user
(progn
(setf (mito-auth:password user) password)
(mito:save-dao user)
(mito:delete-dao token)
(ingle:redirect (concatenate 'string (envy-ningle:get-config :auth-mount-path) "/login")))
(djula:render-template* "error.html" nil :title "Error" :error "No user found")))In the logic for updating the user, the password is set, the user is saved, the token is deleted and the browser is redirected to the login route.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
(defpackage ningle-auth
(:use :cl :sxql :ningle-auth/forms)
(:export #:*app*
#:start
#:stop))
(in-package ningle-auth)
(defvar *app* (make-instance 'ningle:app))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-auth "src/templates/"))
(cu-sith:setup
:user-p (lambda (username) (mito:find-dao 'ningle-auth/models:user :username username :active 1))
:user-roles (lambda (user) (mito:select-dao 'ningle-auth/models:permission (where (:= :user_id (mito:object-id user))))))
(setf (ningle:route *app* "/register" :method '(:GET :POST))
(lambda (params)
(let ((form (cl-forms:find-form 'register)))
(if (string= "GET" (lack.request:request-method ningle:*request*))
(djula:render-template* "ningle-auth/register.html" nil :title "Register" :form form)
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (email username password password-verify) form
(when (mito:select-dao 'ningle-auth/models:user
(where (:or (:= :username username)
(:= :email email))))
(error "Either username or email is already registered"))
(when (string/= password password-verify)
(error "Passwords do not match"))
(let* ((user (mito:create-dao 'ningle-auth/models:user :email email :username username :password password))
(token (ningle-auth/models:generate-token user ningle-auth/models:+email-verification+)))
(format t "Reset url: ~A~A/verify?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:username user)
(ningle-auth/models:token-value token))
(ingle:redirect "/"))))))
(error (err)
(djula:render-template* "error.html" nil :title "Error" :error err))
(simple-error (csrf-error)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error csrf-error)))))))
;; Must be logged out
(setf (ningle:route *app* "/login" :method '(:GET :POST))
(lambda (params)
(let ((form (cl-forms:find-form 'login)))
(cond
((cu-sith:logged-in-p)
(ingle:redirect "/"))
((string= "GET" (lack.request:request-method ningle:*request*))
(djula:render-template* "ningle-auth/login.html" nil :form form :url (concatenate 'string (envy-ningle:get-config :auth-mount-path) "/reset")))
(t
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (username password) form
(cu-sith:login :user username :password password)
(ingle:redirect (envy-ningle:get-config :login-redirect))))))
(cu-sith:invalid-user (err)
(djula:render-template* "error.html" nil :title "Error" :error (format nil "~A, have you verified the account?" (cu-sith:msg err))))
(cu-sith:invalid-password (err)
(djula:render-template* "error.html" nil :title "Error" :error (cu-sith:msg err)))
(simple-error (csrf-error)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error csrf-error))))))))
;; Must be logged in
(setf (ningle:route *app* "/logout" :method '(:GET :POST))
(lambda (params)
(cu-sith:logout)
(ingle:redirect (envy-ningle:get-config :login-redirect))))
;; Must be logged out
(setf (ningle:route *app* "/reset" :method '(:GET :POST))
(lambda (params)
(let ((form (cl-forms:find-form 'reset-password)))
(cond
((cu-sith:logged-in-p)
(ingle:redirect "/"))
((string= "GET" (lack.request:request-method ningle:*request*))
(djula:render-template* "ningle-auth/reset.html" nil :title "Reset GET" :form form))
(t
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (email) form
(let* ((user (mito:find-dao 'ningle-auth/models:user :email email))
(token (mito:find-dao 'ningle-auth/models:token :user user :purpose ningle-auth/models:+password-reset+)))
(cond
((and user token (not (ningle-auth/models:is-expired-p token)))
(djula:render-template* "error.html" nil :title "Error" :error "There is already a password reset in progress, either continue or wait a while before retrying"))
((and user token)
(mito:delete-dao token)
(let ((token (ningle-auth/models:generate-token user ningle-auth/models:+password-reset+)))
(format t "Reset url: ~A~A/reset/process?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:username user)
(ningle-auth/models:token-value token)))
(ingle:redirect "/"))
(user
(let ((token (ningle-auth/models:generate-token user ningle-auth/models:+password-reset+)))
(format t "Reset url: ~A~A/reset/process?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:username user)
(ningle-auth/models:token-value token)))
(ingle:redirect "/"))
(t
(djula:render-template* "error.html" nil :title "Error" :error "No user found"))))))))
(simple-error (csrf-error)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error csrf-error))))))))
(setf (ningle:route *app* "/reset/process" :method '(:GET :POST))
(lambda (params)
(let* ((form (cl-forms:find-form 'new-password))
(user (mito:find-dao 'ningle-auth/models:user :username (cdr (assoc "user" params :test #'string=))))
(token (mito:find-dao 'ningle-auth/models:token :user user :purpose ningle-auth/models:+password-reset+ :token (cdr (assoc "token" params :test #'string=)))))
(cond
((cu-sith:logged-in-p)
(ingle:redirect "/"))
((and (string= "GET" (lack.request:request-method ningle:*request*)) (or (not token) (ningle-auth/models:is-expired-p token)))
(djula:render-template* "error.html" nil :title "Error" :error "Invalid reset token, please try again"))
((and (string= "GET" (lack.request:request-method ningle:*request*)) token)
(cl-forms:set-field-value form 'ningle-auth/forms:email (ningle-auth/models:email user))
(cl-forms:set-field-value form 'ningle-auth/forms:token (ningle-auth/models:token-value token))
(djula:render-template* "ningle-auth/reset.html" nil :title "Create a new password" :form form))
(t
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (email token password password-verify) form
(when (string/= password password-verify)
(error "Passwords do not match"))
(let* ((user (mito:find-dao 'ningle-auth/models:user :email email))
(token (mito:find-dao 'ningle-auth/models:token :user user :token token :purpose ningle-auth/models:+password-reset+)))
(if user
(progn
(setf (mito-auth:password user) password)
(mito:save-dao user)
(mito:delete-dao token)
(ingle:redirect (concatenate 'string (envy-ningle:get-config :auth-mount-path) "/login")))
(djula:render-template* "error.html" nil :title "Error" :error "No user found")))))))
(error (err)
(djula:render-template* "error.html" nil :title "Error" :error err))
(simple-error (csrf-error)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error csrf-error))))))))
;; Must not be fully set up
(setf (ningle:route *app* "/verify")
(lambda (params)
(let* ((user (mito:find-dao 'ningle-auth/models:user :username (cdr (assoc "user" params :test #'string=))))
(token (mito:find-dao 'ningle-auth/models:token :user user :purpose ningle-auth/models:+email-verification+ :token (cdr (assoc "token" params :test #'string=)))))
(cond
((cu-sith:logged-in-p)
(ingle:redirect "/"))
((and token (ningle-auth/models:is-expired-p token))
(mito:delete-dao token)
(let ((new-token (ningle-auth/models:generate-token user ningle-auth/models:+email-verification+)))
(format t "Token ~A expired, issuing new token: ~A~A/verify?user=~A&token=~A~%"
(format nil "http://~A:~A" (lack/request:request-server-name ningle:*request*) (lack/request:request-server-port ningle:*request*))
(envy-ningle:get-config :auth-mount-path)
(ningle-auth/models:token-value token)
(ningle-auth/models:username user)
(ningle-auth/models:token-value new-token)))
(djula:render-template* "ningle-auth/verify.html" nil :title "Verify" :token-reissued t))
((not token)
(format t "Token ~A does not exist~%" (cdr (assoc "token" params :test #'string=)))
(djula:render-template* "error.html" nil :title "Error" :error "Token not valid"))
(t
(mito:delete-dao token)
(mito:create-dao 'ningle-auth/models:permission :user user :role (mito:find-dao 'ningle-auth/models:role :name "user"))
(ningle-auth/models:activate user)
(mito:save-dao user)
(format t "User ~A activated!~%" (ningle-auth/models:username user))
(ingle:redirect (concatenate 'string (envy-ningle:get-config :auth-mount-path) "/login")))))))
(defmethod ningle:not-found ((app ningle:<app>))
(declare (ignore app))
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error "Not Found"))
(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-auth "src/templates/"))
(djula:set-static-url "/public/")
(clack:clackup
(lack.builder:builder (envy-ningle:build-middleware :ningle-auth/config *app*))
:server server
:address address
:port port))
(defun stop (instance)
(clack:stop instance))
Our templates haven’t changed dramatically since last time, but there’s some small changes.
All we do here is render the form that is passed in from our controller.
1
2
3
4
5
6
7
8
9
10
11
12
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<h1>Register for an account</h1>
{% form form %}
</div>
</div>
</div>
{% endblock %}
In our verify template we pass in (from our controller) if the token had expired, we use the token-reissued variable that may be passed in to inform the user to expect a new email.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<h1>Your account is almost ready!</h1>
{% if token-reissued %}
<p>This token has expired and a new one has been issued and sent to the email address used when registering.</p>
{% else %}
<p>Please follow the instructions send to the email used when registering to verify your account!</p>
{% endif %}
</div>
</div>
</div>
{% endblock %}
In our login template we render our login form, but we also display the url passed in, that allows a user to click to the “forgot password” link.
1
2
3
4
5
6
7
8
9
10
11
12
13
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<h1>Login</h1>
{% form form %}
<h4><a href="{{ url }}">Forgotten Password?</a></h4>
</div>
</div>
</div>
{% endblock %}
Our reset template simply renders the form passed into it.
1
2
3
4
5
6
7
8
9
10
11
12
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<h1>Reset Password</h1>
{% form form %}
</div>
</div>
</div>
{% endblock %}
The following files can be deleted as they have been moved into the authentication app:
src/forms.lispsrc/models.lispsrc/templates/main/login.htmlsrc/templates/main/logout.htmlsrc/templates/main/register.htmlDue to removing some old files we will need to update the project asd file, it should be stressed that we will also be adding new files too, so you will see some files we haven’t written (yet) in this updated :components section.
1
2
3
4
5
6
:components
((:file "contrib")
(:file "middleware")
(:file "config")
(:file "migrations")
(:file "main"))
While we are still building up our ideal project structure, we have some code that depends on ningle-auth (which we have just written) and may end up somewhere else in the project, ningle-auth may become baked into our project structure going forward, at the moment it’s hard to know how best to manage the following code, so I have contrib-uted some helper code. If a better place for it is found, or we decide to formally bundle things together, we can move it, but for now we will just keep the code here.
In this package we will define a create-super-user function (which depends on the ningle-auth models) and a macro (with-db-connection) to enable code to run that needs to be run in the context of a database connection. We will use the with-db-connection macro in other parts of this project.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
(defpackage ningle-tutorial-project/contrib
(:use :cl :mito)
(:export #:create-super-user
#:with-db-connection))
(in-package :ningle-tutorial-project/contrib)
(defmacro with-db-connection (&body body)
`(multiple-value-bind (backend args) (envy-ningle:extract-middleware-config :ningle-tutorial-project/config :mito)
(unless backend
(error "No MITO backend found for config ~A" cfg))
(unwind-protect
(progn
(apply #'mito:connect-toplevel backend args)
,@body
(mito:disconnect-toplevel)))))
(defun create-super-user (&key username email password)
(with-db-connection
(let ((user (create-dao 'ningle-auth/models:user :username username :email email :password password :active 1)))
(create-dao 'ningle-auth/models:permission :user user :role (find-dao 'ningle-auth/models:role :name "admin"))
user)))
Now, this middleware isn’t, strictly speaking, required, but it will demonstrate another piece of managing security. It’s a little bit more complicated than is ideal, but oh well! We have learned, from previous chapters that middleware runs on each request, cu-sith stores the user and roles in the active session, however if the permissions change, we need to update the session. This piece of middleware does this.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(defpackage :ningle-tutorial-project/middleware
(:use :cl :sxql :ningle-tutorial-project/contrib)
(:export #:refresh-roles))
(in-package :ningle-tutorial-project/middleware)
(defun refresh-roles (app)
(lambda (env)
(with-db-connection
(handler-case
(let ((session (getf env :lack.session)))
(when (and session (hash-table-p session) (> (hash-table-count session) 0))
(let ((user (gethash :user session)))
(when (typep user 'ningle-auth/models:user)
(format t "[refreshing-roles]~%")
(let ((roles (mito:select-dao 'ningle-auth/models:permission (where (:= :user user)))))
(setf (gethash :roles session) roles)
(format t "[refreshed-roles for ~A] result: ~A~%" user roles))))))
(error (e)
(format *error-output* "Error refreshing roles: ~A~%" e))))
(funcall app env)))
We learned from part 3 that middleware is a function that accepts an application object (which is a function itself!) and returns a function that accepts an environment. There’s a nuance, however, middleware has to run in a specific order, for example, this middleware depends on using the session object, so the :session middleware must run first, else this will fail because there’s no session set up for us to use!
We use the with-db-connection macro to ensure we have a database connection, and set up a handler-case, we handle this by capturing any error and displaying to the error-output stream a message, however inside the code to be handled we use a let to get the session object, but, just because we have a session object (a hash-table) it doesn’t mean it has any data in it, so we check that the session object is a hash-table and it has at least one key/value pair in it. If there is, we grab the user object from the session (of course there may not be a user!) and check it is of the type of our model, assuming we have a valid user object we then grab the roles the user can perform and set them into the :roles section of the session object.
As mentioned above this will run on each request, so if the user permissions changed, the session will be updated as the user navigates the web application. Of course it would be more performant to use a cache, or redis or something, but for this demonstration, this is a decent enough example of how to get this working.
We have a small amount of tinkering to do to our settings, including setting up the middleware order as described above. Most of our changes are concerned with mounting our authentication app, however, because it has migrations, we have added some settings for use in the next section (migrations).
The tricky thing is, we want to mount our authentication application on a route, but we also want the authentication application to know where it is mounted (so that its internal links and routing are correct), as a result we want to set a parameter that defines the mount point and is both set explicitly as a named setting and used in the :mount middleware section.
Thus the *auth-mount-path* is used to define this mount path, and in the :common settings block it is set as the named :auth-mount-path and later in the |sqlite| section in the :mount line.
Additionally, you can see on line #19, we add in the refresh-roles middleware we defined in the previous section, do remember that order matters and it must be between the :session middleware and the :mito middleware else it wont work!
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
(defpackage ningle-tutorial-project/config
(:use :cl :envy))
(in-package ningle-tutorial-project/config)
(dotenv:load-env (asdf:system-relative-pathname :ningle-tutorial-project ".env"))
(setf (config-env-var) "APP_ENV")
(defparameter *auth-mount-path* "/auth") ;; add this
(defconfig :common
`(:application-root ,(asdf:component-pathname (asdf:find-system :ningle-tutorial-project))
:installed-apps (:ningle-auth) ;; add this
:auth-mount-path ,*auth-mount-path* ;; add this
:login-redirect "/")) ;; add this
(defconfig |sqlite|
`(:debug T
:middleware ((:session)
ningle-tutorial-project/middleware:refresh-roles ;; add this
(:mito (:sqlite3 :database-name ,(uiop:getenv "SQLITE_DB_NAME")))
(:mount ,*auth-mount-path* ,ningle-auth:*app*) ;; add this
(:static :root ,(asdf:system-relative-pathname :ningle-tutorial-project "src/static/") :path "/public/"))))
(defconfig |mysql|
`(:middleware ((:session)
(:mito (:mysql
:database-name ,(uiop:native-namestring (uiop:parse-unix-namestring (uiop:getenv "MYSQL_DB_NAME")))
:username ,(uiop:getenv "MYSQL_USER")
:password ,(uiop:getenv "MYSQL_PASSWORD")
:host ,(uiop:getenv "MYSQL_ADDRESS")
:port ,(parse-integer (uiop:getenv "MYSQL_PORT"))))
(:static :root ,(asdf:system-relative-pathname :ningle-tutorial-project "src/static/") :path "/public/"))))
(defconfig |postgresql|
`(:middleware ((:session)
(:mito (:postgres
:database-name ,(uiop:native-namestring (uiop:parse-unix-namestring (uiop:getenv "POSTGRES_DB_NAME")))
:username ,(uiop:getenv "POSTGRES_USER")
:password ,(uiop:getenv "POSTGRES_PASSWORD")
:host ,(uiop:getenv "POSTGRES_ADDRESS")
:port ,(parse-integer (uiop:getenv "POSTGRES_PORT"))))
(:static :root ,(asdf:system-relative-pathname :ningle-tutorial-project "src/static/") :path "/public/"))))
Previously we wrote the migrations in such a way that they established their own database connection and ran their migrations, with two apps however, where one defines the settings, it becomes important to ensure that the other does not need to know. As a result we have redesigned the migrations, each application will define a migrate function, and our project will search through a list of known installed apps to find their migrate function, and it will then run these function inside the with-db-connection. We spoke about this briefly when we rewrote the ningle-auth migrations file, and here we are now!
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(defpackage ningle-tutorial-project/migrations
(:use :cl :ningle-tutorial-project/contrib)
(:export #:migrate-apps))
(in-package :ningle-tutorial-project/migrations)
(defun migrate-apps (&optional (apps nil))
"Run migrate function for each app in APPS list. If APPS is nil, migrate all apps listed in *config* :installed-apps."
(let ((apps (or apps (getf (envy:config :ningle-tutorial-project/config) :installed-apps))))
(unless apps
(error "No apps specified and no :installed-apps found in config."))
(with-db-connection
(dolist (app apps)
(let* ((migrations-pkg-name (string-upcase (format nil "~A/MIGRATIONS" (string-upcase (symbol-name app)))))
(migrations-pkg (find-package migrations-pkg-name)))
(unless migrations-pkg
(error "Migrations package ~A not found." migrations-pkg-name))
;; Set app-specific config before calling migrate
(let ((migrate-fn (find-symbol "MIGRATE" migrations-pkg))) ;; Name known to project
(unless (and migrate-fn (fboundp migrate-fn))
(error "Migrate function not found in package ~A." migrations-pkg-name))
(funcall migrate-fn)))))))
We start by defining a migrate-apps function, it can either be passed a list of apps, or it will read the :installed-apps setting that we added in config.lisp, if there are no apps an error is signalled, however, if there are, we, once again, use the with-db-connection macro and loop over the list of apps, getting each package name with a migrations suffix, if there’s no such package an error is signalled.
Assuming the migrations package has been found, an attempt it made to find the migrate function within it (this does mean that each app has to have a migrations package with a migrate function), if this function couldn’t be found an error is signalled, however if it could be, the migration function for that application is called.
Since we removed much of the logic we previously had from here, we removed forms.lisp so we will immediately need to remove the import we had in the defpackage, it should now look like this.
(defpackage ningle-tutorial-project
(:use :cl :sxql)
(:export #:start
#:stop))Additionally there was a register route, this must be completely removed, which leaves us with only four controllers in this file, including the /profile controller we are yet to write! So let’s look at them one by one.
While this view has not changed much at all, where we previously hard coded the user, we can now pass a real user from the session into our templates.
(setf (ningle:route *app* "/")
(lambda (params)
(let ((user (gethash :user ningle:*session*)) ;; Change this
(posts (list (list :author (list :username "Bob") :content "Experimenting with Dylan" :created-at "2025-01-24 @ 13:34")
(list :author (list :username "Jane") :content "Wrote in my diary today" :created-at "2025-01-24 @ 13:23"))))
(djula:render-template* "main/index.html" nil :title "Home" :user user :posts posts))))This is our new controller that will only be accessible if the user is logged in. We can see this works by grabbing the user from the session (using a let) and using a simple if to either render the template if there is a user, or set the http response code to 403 and render the “Unauthorized” error.
(setf (ningle:route *app* "/profile")
(lambda (params)
(let ((user (gethash :user ningle:*session*)))
(if user
(djula:render-template* "main/profile.html" nil :title "Profile" :user user)
(progn
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error "Unauthorized"))))))Again, not much has changed here, the only thing we have done is update the code such that the model is now the ningle-auth, and in the final line, we use cu-sith to pass the logged in user into the template, along with a list of the users registered with the system.
(setf (ningle:route *app* "/people")
(lambda (params)
(let ((users (mito:retrieve-dao 'ningle-auth/models:user)))
(djula:render-template* "main/people.html" nil :title "People" :users users :user (cu-sith:logged-in-p)))))A slight change here is, again, to pass the user pulled from the session into the template, but also because we enabled a user to be looked up by username, or email, we have changed the variables, just for clarity.
(setf (ningle:route *app* "/people/:person")
(lambda (params)
(let* ((username-or-email (ingle:get-param :person params))
(person (first (mito:select-dao
'ningle-auth/models:user
(where (:or (:= :username username-or-email)
(:= :email username-or-email)))))))
(djula:render-template* "main/person.html" nil :title "Person" :person person :user (cu-sith:logged-in-p)))))Putting it all together!
(defpackage ningle-tutorial-project
(:use :cl :sxql)
(:export #:start
#:stop))
(in-package ningle-tutorial-project)
(defvar *app* (make-instance 'ningle:app))
(setf (ningle:route *app* "/")
(lambda (params)
(let ((user (gethash :user ningle:*session*))
(posts (list (list :author (list :username "Bob") :content "Experimenting with Dylan" :created-at "2025-01-24 @ 13:34")
(list :author (list :username "Jane") :content "Wrote in my diary today" :created-at "2025-01-24 @ 13:23"))))
(djula:render-template* "main/index.html" nil :title "Home" :user user :posts posts))))
(setf (ningle:route *app* "/profile")
(lambda (params)
(let ((user (gethash :user ningle:*session*)))
(if user
(djula:render-template* "main/profile.html" nil :title "Profile" :user user)
(progn
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error "Unauthorized"))))))
(setf (ningle:route *app* "/people")
(lambda (params)
(let ((users (mito:retrieve-dao 'ningle-auth/models:user)))
(djula:render-template* "main/people.html" nil :title "People" :users users :user (cu-sith:logged-in-p)))))
(setf (ningle:route *app* "/people/:person")
(lambda (params)
(let* ((username-or-email (ingle:get-param :person params))
(person (first (mito:select-dao
'ningle-auth/models:user
(where (:or (:= :username username-or-email)
(:= :email username-or-email)))))))
(djula:render-template* "main/person.html" nil :title "Person" :person person :user (cu-sith:logged-in-p)))))
(defmethod ningle:not-found ((app ningle:<app>))
(declare (ignore app))
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error "Not Found"))
(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
(djula:set-static-url "/public/")
(clack:clackup
(lack.builder:builder (envy-ningle:build-middleware :ningle-tutorial-project/config *app*))
:server server
:address address
:port port))
(defun stop (instance)
(clack:stop instance))Now that our application logic is done, we turn now towards our templates, there’s only three, we need to update the base, our person template, and to write our new profile template.
In our base.html we will be adapting the upper right of the screen, where we previously had a registration button, we will expand this somewhat to include “register” and “login” if a user is not logged in otherwise a profile link and “logout”.
<div class="d-flex ms-auto">
{% if user %}
<a href="/profile" class="btn btn-primary">{{ user.username }}</a>
|
<a href="/auth/logout" class="btn btn-secondary">Logout</a>
{% else %}
<a href="/auth/register" class="btn btn-primary">Register</a>
|
<a href="/auth/login" class="btn btn-success">Login</a>
{% endif %}
</div>Since we have adjusted the data that we pass into the person template, we need to likewise adapt the template to the new data. The reason we have both user and person is that the user is the active logged in user, and the person is the one that is being looked up to view this page, and these are very likely to be different values, unless, you know, you’re Ed Balls.
<div class="col">
{% if not person %} ;; change 'user' to 'person'
<h1>No users</h1>
{% else %}
<div class="card">
<div class="card-body">
<h5 class="card-title">{{ person.username }}</h5> ;; change 'user' to 'person'
<p class="card-text">{{ person.email }}</p> ;; change 'user' to 'person'
<p class="text-muted small"></p>
</div>
</div>
{% endif %}
</div>Our new profile template will be real simple, since the check is if it is accessible at all, it really doesn’t have to contain much, at least, right now.
1
2
3
4
5
6
7
8
9
10
11
12
13
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12 text-center">
<div class="row">
<h1>Profile</h1>
</div>
</div>
</div>
</div>
{% endblock %}
I am by no means a CSS expert, and things aren’t really looking the way I would like them do, I will include what css I have written, although it really is beyond my ability to teach good css!
form#login input {
display: block; /* Ensure inputs take up the full width */
width: 100% !important; /* Override any conflicting styles */
max-width: 100%; /* Ensure no unnecessary constraints */
box-sizing: border-box;
}
form#login input[type="text"],
form#login input[type="password"] {
@extend .form-control; /* Apply Bootstrap's .form-control */
display: block; /* Ensure they are block-level elements */
width: 100%; /* Make the input full width */
margin-bottom: 1rem; /* Spacing */
}
form#login input[type="submit"] {
@extend .btn;
@extend .btn-primary;
width: 100%;
}
form#login div {
@extend .mb-3;
}
form#login label {
@extend .form-label;
font-weight: bold;
margin-bottom: 0.5rem;
}If you are still here, thank you, truly, this was quite a lot to both write the code for, and write up, so I really do appreciate you reading this far, I certainly hope you found it helpful and interesting. It certainly covered a lot, but security is something to take seriously, and understanding how to write a complete authentication system, even one this basic, requires a lot of learning!
Fortunately next time wont be anywhere near as large, we will be looking at how to email the urls with tokens to users to make this system practical to use in the real world!
Welcome back to this Ningle tutorial series, in this part we are gonna have another look at some middleware, now that we have settings and configuration done there’s another piece of middleware we might want to look at; application mounting, many web frameworks have the means to use apps within other apps, you might want to do this because you have some functionality you use over and over again in many projects, it makes sense to make it into an app and simply include it in other apps. You might also might want to make applications available for others to use in their applications.
Which is exactly what we are gonna do here, we spent some time building a registration view, but for users we might want to have a full registration system that will have:
We will begin by building the basic views that return a simple template and mount them into our main application, we will then fill the actual logic out in another tutorial. So, we will create a new Ningle project that has 6 views that simply handle get requests, the important thing to bear in mind is that we will have to adjust the layout of our templates, we need our auth app to use its own templates, or use the templates of a parent app, this means we will have to namespace our templates, if you have use django before this will seem familiar.
Using my project builder set up a new project for our authentication application.
(nmunro:make-project #p"~/quicklisp/local-projects/ningle-auth/")This will create a project skeleton, complete with an asd file, a src, and tests directory. In the asd file we need to add some packages (we will add more in a later tutorial).
:depends-on (:cl-dotenv
:clack
:djula
:envy-ningle
:mito
:ningle)In the src/main.lisp file, we will add the following:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
(defpackage ningle-auth
(:use :cl)
(:export #:*app*
#:start
#:stop))
(in-package ningle-auth)
(defvar *app* (make-instance 'ningle:app))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-auth "src/templates/"))
(setf (ningle:route *app* "/register")
(lambda (params)
(format t "Test: ~A~%" (mito:retrieve-by-sql "SELECT 2 + 3 AS result"))
(djula:render-template* "ningle-auth/register.html" nil :title "Register")))
(setf (ningle:route *app* "/login")
(lambda (params)
(djula:render-template* "ningle-auth/login.html" nil :title "Login")))
(setf (ningle:route *app* "/logout")
(lambda (params)
(djula:render-template* "ningle-auth/logout.html" nil :title "Logout")))
(setf (ningle:route *app* "/reset")
(lambda (params)
(djula:render-template* "ningle-auth/reset.html" nil :title "Reset")))
(setf (ningle:route *app* "/verify")
(lambda (params)
(djula:render-template* "ningle-auth/verify.html" nil :title "Verify")))
(setf (ningle:route *app* "/delete")
(lambda (params)
(djula:render-template* "ningle-auth/delete.html" nil :title "Delete")))
(defmethod ningle:not-found ((app ningle:<app>))
(declare (ignore app))
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error "Not Found"))
(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-auth "src/templates/"))
(djula:set-static-url "/public/")
(clack:clackup
(lack.builder:builder (envy-ningle:build-middleware :ningle-auth/config *app*))
:server server
:address address
:port port))
(defun stop (instance)
(clack:stop instance))
Just as we did with our main application, we will need to create a src/config.lisp:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(defpackage ningle-auth/config
(:use :cl :envy))
(in-package ningle-auth/config)
(dotenv:load-env (asdf:system-relative-pathname :ningle-auth ".env"))
(setf (config-env-var) "APP_ENV")
(defconfig :common
`(:application-root ,(asdf:component-pathname (asdf:find-system :ningle-auth))))
(defconfig |test|
`(:debug T
:middleware ((:session)
(:mito (:sqlite3 :database-name ,(uiop:getenv "SQLITE_DB_NAME"))))))
Now, I mentioned that the template files need to be organised in a certain way, we will start with the new template layout in our auth application, the directory structure should look like this:
➜ ningle-auth git:(main) tree .
.
├── ningle-auth.asd
├── README.md
├── src
│ ├── config.lisp
│ ├── main.lisp
│ └── templates
│ ├── ningle-auth
│ │ ├── delete.html
│ │ ├── login.html
│ │ ├── logout.html
│ │ ├── register.html
│ │ ├── reset.html
│ │ └── verify.html
│ ├── base.html
│ └── error.html
└── tests
└── main.lispSo in your src/templates directory there will be a directory called ningle-auth and two files base.html and error.html, it is important that this structure is followed, as when the app is used as part of a larger app, we want to be able to layer templates, and this is how we do it.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
<!doctype html>
<html lang="en">
<head>
<title>{{ title }}</title>
<link href="https://cdn.jsdelivr.net/npm/[email protected]/dist/css/bootstrap.min.css" rel="stylesheet">
</head>
<body>
<div class="container mt-4">
{% block content %}
{% endblock %}
</div>
<script src="https://cdn.jsdelivr.net/npm/[email protected]/dist/js/bootstrap.bundle.min.js"></script>
</body>
</html>
1
2
3
4
5
6
7
8
9
10
11
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<h1>{{ error }}</h1>
</div>
</div>
</div>
{% endblock %}
Now the rest of the html files are similar, with only the title changing. Using the following html, create files for:
1
2
3
4
5
6
7
8
9
10
11
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<h1>Delete</h1>
</div>
</div>
</div>
{% endblock %}
1
2
3
4
5
6
7
8
9
10
11
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<h1>Login</h1>
</div>
</div>
</div>
{% endblock %}
1
2
3
4
5
6
7
8
9
10
11
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<h1>Logout</h1>
</div>
</div>
</div>
{% endblock %}
1
2
3
4
5
6
7
8
9
10
11
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<h1>Register</h1>
</div>
</div>
</div>
{% endblock %}
1
2
3
4
5
6
7
8
9
10
11
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<h1>Reset</h1>
</div>
</div>
</div>
{% endblock %}
1
2
3
4
5
6
7
8
9
10
11
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<h1>Verify</h1>
</div>
</div>
</div>
{% endblock %}
There is one final file to create, the .env file! Even though this application wont typically run on its own, we will use one to test it is all working, since we did write src/config.lisp afterall!
1
2
APP_ENV=test
SQLITE_DB_NAME=ningle-auth.db
Now that the auth application has been created we will test that it at least runs on its own, once we have confirmed this, we can integrate it into our main app. Like with our main application, we will load the system and run the start function that we defined.
(ql:quickload :ningle-auth)
To load "ningle-auth":
Load 1 ASDF system:
ningle-auth
; Loading "ningle-auth"
..................................................
[package ningle-auth/config].
(:NINGLE-AUTH)
(ningle-auth:start)
NOTICE: Running in debug mode. Debugger will be invoked on errors.
Specify ':debug nil' to turn it off on remote environments.
Woo server is started.
Listening on 127.0.0.1:8000.
#S(CLACK.HANDLER::HANDLER
:SERVER :WOO
:SWANK-PORT NIL
:ACCEPTOR #<BT2:THREAD "clack-handler-woo" {1203E4E3E3}>)
*If this works correctly, you should be able to access the defined routes in your web browser, if not, and there is an error, check that another web server isn’t running on port 8000 first! When you are able to access the simple routes from your web browser, we are ready to integrate this into our main application!
Made it this far? Congratulations, we are almost at the end, I’m sure you’ll be glad to know, there isn’t all that much more to do, but we do have to ensure we follow the structure we set up in the auth app, which we will get to in just a moment, first, lets remember to add the ningle-auth app to our dependencies in our project asd file.
:depends-on (:cl-dotenv
:clack
:djula
:cl-forms
:cl-forms.djula
:cl-forms.ningle
:envy
:envy-ningle
:ingle
:mito
:mito-auth
:ningle
:ningle-auth) ;; add thisNext, we need to move most of our template files into a directory called main, to make things easy, the only two templates we will not move are base.html and error.html; create a new directory src/templates/main and put everything else in there.
For reference this is what your directory structure should look like:
➜ ningle-tutorial-project git:(main) tree .
.
├── ningle-tutorial-project.asd
├── ntp.db
├── README.md
├── src
│ ├── config.lisp
│ ├── forms.lisp
│ ├── main.lisp
│ ├── migrations.lisp
│ ├── models.lisp
│ ├── static
│ │ ├── css
│ │ │ └── main.css
│ │ └── images
│ │ ├── logo.jpg
│ │ └── lua.jpg
│ └── templates
│ ├── base.html
│ ├── error.html
│ └── main
│ ├── index.html
│ ├── login.html
│ ├── logout.html
│ ├── people.html
│ ├── person.html
│ └── register.html
└── tests
└── main.lispWith the templates having been moved, we must find all areas in src/main.lisp where we reference one of these templates and point to the new location, thankfully there’s only 4 lines that need to be changed, the render-template* calls, below is what they should be changed to.
(djula:render-template* "main/index.html" nil :title "Home" :user user :posts posts)
(djula:render-template* "main/people.html" nil :title "People" :users users)
(djula:render-template* "main/person.html" nil :title "Person" :user user)
(djula:render-template* "main/register.html" nil :title "Register" :form form)Here is a complete listing of the file in question.
(defpackage ningle-tutorial-project
(:use :cl :sxql)
(:import-from
:ningle-tutorial-project/forms
#:email
#:username
#:password
#:password-verify
#:register)
(:export #:start
#:stop))
(in-package ningle-tutorial-project)
(defvar *app* (make-instance 'ningle:app))
(setf (ningle:route *app* "/")
(lambda (params)
(let ((user (list :username "NMunro"))
(posts (list (list :author (list :username "Bob") :content "Experimenting with Dylan" :created-at "2025-01-24 @ 13:34")
(list :author (list :username "Jane") :content "Wrote in my diary today" :created-at "2025-01-24 @ 13:23"))))
(djula:render-template* "main/index.html" nil :title "Home" :user user :posts posts))))
(setf (ningle:route *app* "/people")
(lambda (params)
(let ((users (mito:retrieve-dao 'ningle-tutorial-project/models:user)))
(djula:render-template* "main/people.html" nil :title "People" :users users))))
(setf (ningle:route *app* "/people/:person")
(lambda (params)
(let* ((person (ingle:get-param :person params))
(user (first (mito:select-dao
'ningle-tutorial-project/models:user
(where (:or (:= :username person)
(:= :email person)))))))
(djula:render-template* "main/person.html" nil :title "Person" :user user))))
(setf (ningle:route *app* "/register" :method '(:GET :POST))
(lambda (params)
(let ((form (cl-forms:find-form 'register)))
(if (string= "GET" (lack.request:request-method ningle:*request*))
(djula:render-template* "main/register.html" nil :title "Register" :form form)
(handler-case
(progn
(cl-forms:handle-request form) ; Can throw an error if CSRF fails
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (email username password password-verify) form
(when (mito:select-dao 'ningle-tutorial-project/models:user
(where (:or (:= :username username)
(:= :email email))))
(error "Either username or email is already registered"))
(when (string/= password password-verify)
(error "Passwords do not match"))
(mito:create-dao 'ningle-tutorial-project/models:user
:email email
:username username
:password password)
(ingle:redirect "/people")))))
(error (err)
(djula:render-template* "error.html" nil :title "Error" :error err))
(simple-error (csrf-error)
(setf (lack.response:response-status ningle:*response*) 403)
(djula:render-template* "error.html" nil :title "Error" :error csrf-error)))))))
(defmethod ningle:not-found ((app ningle:<app>))
(declare (ignore app))
(setf (lack.response:response-status ningle:*response*) 404)
(djula:render-template* "error.html" nil :title "Error" :error "Not Found"))
(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
(djula:set-static-url "/public/")
(clack:clackup
(lack.builder:builder (envy-ningle:build-middleware :ningle-tutorial-project/config *app*))
:server server
:address address
:port port))
(defun stop (instance)
(clack:stop instance))The final step we must complete is actually mounting our ningle-auth application into our main app, which is thankfully quite easy. Mounting middleware exists for ningle and so we can configure this in src/config.lisp, to demonstrate this we will add it to our sqlite config:
1
2
3
4
5
6
(defconfig |sqlite|
`(:debug T
:middleware ((:session)
(:mito (:sqlite3 :database-name ,(uiop:getenv "SQLITE_DB_NAME")))
(:mount "/auth" ,ningle-auth:*app*) ;; This line!
(:static :root ,(asdf:system-relative-pathname :ningle-tutorial-project "src/static/") :path "/public/"))))
You can see on line #5 that a new mount point is being defined, we are mounting all the routes that ningle-auth has, onto the /auth prefix. This means that, for example, the /register route in ningle-auth will actually be accessed /auth/register.
If you can check that you can access all the urls to confirm this works, then we have assurances that we are set up correctly, however we need to come back to the templates one last time.
The reason we changed the directory structure, because ningle-auth is now running in the context of our main app, we can actually override the templates, so if we wanted to, in our src/templates directory, we could create a ningle-auth directory and create our own register.html, login.html, etc, allowing us to style and develop our pages as we see fit, allowing complete control to override, if that is our wish. By NOT moving the base.html and error.html files, we ensure that templates from another app can inherit our styles and layouts in a simple and predictable manner.
Wow, what a ride… Thanks for sticking with it this month, although, next month isn’t going to be much easier as we begin to develop a real authentication application for use in our microblog app! As always, I hope you have found this helpful and you have learned something.
In this tutorial you should be able to:
Welcome back, in this tutorial we will look at how to simplify the complexities introduced last time. We had three different versions of our application, depending on which SQL database we wanted to use, this is hardly an ideal situation, we might want to run SQLite on one environment and PostgreSQL on another, it does not make sense to have to edit code to change such things, we should have code that is generalised and some configuration (like environmental variables) can provide the system with the connection information.
We want to separate our application configuration from our application logic, in software development we might build an application and have different environments in which is can be deployed, and different cloud providers/environments might have different capabilities, for example some providers provide PostgreSQL and others MySQL. As application designers we do not want to concern ourselves with having to patch our application based whatever an environment has provided, it would be better if we had a means by which we could read in how we connect to our databases and defer to that.
This type of separation is very common, in fact it is this separation that ningle itself if for! Just as now we are creating a means to connect to a number of different databases based on config, ningle allows us to run on a number of different webservers, without ningle we would have to write code directly in the way a web server expects, ningle allows us to write more generalised code.
Enter envy, a package that allows us to define different application configurations. Envy will allow us to set up different configurations and switch them based on an environmental variable, just like we wanted. Using this allows us to remove all of our database specific connection code and read it from a configuration, the configuration of which can be changed, the application can be restarted and everything should just work.
We have a slight complication in that we have our migration code, so we will need a way to also extract the active settings, but I wrote a package to assist in this envy-ningle, we will use both these packages to clean up our code.
To begin with we will need to ensure we have installed and added the packages we need to our project asd file, there are two that we will be installing:
Note: My package (envy-ningle) is NOT in quicklisp, so you will need to clone it using git into your local-packages directory. Please ensure that you use the tag v0.0.1 for this tutorial, it is a package I work on and use in my own projects, so the latest may not necessarily work for any given chapter. I will try to ensure the correct versions are specified, but if you find a mistake let me know.
Once you have acquired the packages, as normal you will need to add them in the :depends-on section.
:depends-on (:clack
:cl-dotenv
:djula
:cl-forms
:cl-forms.djula
:cl-forms.ningle
:envy ;; Add this
:envy-ningle ;; Add this
:ingle
:mito
:mito-auth
:ningle)We must write our application configs somewhere, so we will do that in src/config.lisp, as always when adding a new file to our application we must ensure it is added to the asd file, in the :components section. This will ensure the file will be loaded and compiled when the system is loaded.
:components ((:module "src"
:components
((:file "config") ;; Add this
(:file "models")
(:file "migrations")
(:file "forms")
(:file "main"))))So we should write this file now!
As normal we set up a package, declare what packages we will use (:use :cl :envy) and set the active package to this one. There’s some conventions we must follow using this that may seem unimportant at first, but actually are, specifically the |sqlite|, |mysql|, and |postgresql| they must include the | surrounding the name, (although the name doesn’t have to be sqlite, mysql, or postgresql, those are just what I used based on the last tutorial).
(defpackage ningle-tutorial-project/config
(:use :cl :envy))
(in-package ningle-tutorial-project/config)We will start by loading the .env file using the dotenv package, we will remove it from our main.lisp file a little later, but we need to include it here, next we will inform envy of what the name of the environmental variable is that will be used to switch config, in this case APP_ENV.
(dotenv:load-env (asdf:system-relative-pathname :ningle-tutorial-project ".env"))
(setf (config-env-var) "APP_ENV")This means that in your .env file you should add the following:
Note: I am using the sqlite config here, but you can use any of the configs below.
APP_ENV=sqliteWe can define a “common” set of configs using the :common label, this differs from the other labels that use the | to surround them. The :common config isn’t one that will actually be used, it just provides a place to store the, well, common, configuration. While we don’t yet necessarily have any shared config at this point, it is important to understand how to achieve it. In this example we set an application-root that all configs will share.
In envy we use the defconfig macro to define a config. Configs take a name, and a list of items. There is a shared configuration which is called :common, that any number of other custom configs that inherit from, their names are arbitary, but must be surrounded by |, for example |staging|, or |production|.
This is the :common we will use in this tutorial:
(defconfig :common
`(:application-root ,(asdf:component-pathname (asdf:find-system :ningle-tutorial-project))))We can now define our actual configs, our “development” config will be sqlite, which will define our database connection, however, because mito defines database connections as middleware, we can define the middleware section in our config. Each config will have a different middleware section. Unfortunately there will be some repetition with the (:session) and (:static ...) middleware sections.
(defconfig |sqlite|
`(:debug T
:middleware ((:session)
(:mito (:sqlite3 :database-name ,(uiop:getenv "SQLITE_DB_NAME")))
(:static :root ,(asdf:system-relative-pathname :ningle-tutorial-project "src/static/") :path "/public/"))))For our MySQL config we have this:
Note: Please do make sure to use the (or ...) form, this will ensure that the file can compile correctly.
(defconfig |mysql|
`(:middleware ((:session)
(:mito (:mysql
:database-name ,(uiop:native-namestring (uiop:parse-unix-namestring (or (uiop:getenv "MYSQL_DB_NAME") "")))
:username ,(or (uiop:getenv "MYSQL_USER") "")
:password ,(or (uiop:getenv "MYSQL_PASSWORD") "")
:host ,(or (uiop:getenv "MYSQL_ADDRESS") "")
:port (parse-integer ,(or (uiop:getenv "MYSQL_PORT") 0))))
(:static :root ,(asdf:system-relative-pathname :ningle-tutorial-project "src/static/") :path "/public/"))))And finally our PostgreSQL:
Note: Please do make sure to use the (or ...) form, this will ensure that the file can compile correctly.
(defconfig |postgresql|
`(:middleware ((:session)
(:mito (:postgres
:database-name ,(uiop:native-namestring (uiop:parse-unix-namestring (or (uiop:getenv "POSTGRES_DB_NAME") "")))
:username ,(or (uiop:getenv "POSTGRES_USER") "")
:password ,(or (uiop:getenv "POSTGRES_PASSWORD") "")
:host ,(or (uiop:getenv "POSTGRES_ADDRESS") "")
:port (parse-integer ,(or (uiop:getenv "POSTGRES_PORT") 0))))
(:static :root ,(asdf:system-relative-pathname :ningle-tutorial-project "src/static/") :path "/public/"))))NOTE: This config is offered for educational purposes highlighting how to write a config that allows the connection of the three major sql databases you are likely to use. In a more practical example one would have a single database and where instead of (or (uiop:getenv "SOME_ENV") "") to safely fall back, you might instead write:
(or (uiop:getenv "MYSQL_DB_NAME") (error "No MYSQL_DB_NAME envvar"))
This would print something out like so:
#<THREAD tid=259 "main thread" RUNNING {70063603C3}>:
No MYSQL_DB_NAME envvar
Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.
restarts (invokable by number or by possibly-abbreviated name):
0: [TRY-RECOMPILING ] Recompile config and try loading it again
1: [RETRY ] Retry
loading FASL for #<CL-SOURCE-FILE "ningle-tutorial-project" "src" "config">.
2: [ACCEPT ] Continue, treating
loading FASL for #<CL-SOURCE-FILE "ningle-tutorial-project" "src" "config">
as having been successful.
3: Retry ASDF operation.
4: [CLEAR-CONFIGURATION-AND-RETRY] Retry ASDF operation after resetting the
configuration.
5: Retry ASDF operation.
6: Retry ASDF operation after resetting the
configuration.
7: [ABORT ] Give up on "ningle-tutorial-project"
8: [REGISTER-LOCAL-PROJECTS ] Register local projects and try again.
9: Exit debugger, returning to top level.
("top level form") [toplevel]
; Using form offset instead of character position.
error finding frame source: Source path no longer exists.
source: NIL
0]
You can see the error message highlighted at the top of the output.
None of this should be especially new, this middleware section should be familiar from last time, simply wrapped up in the envy:defconfig macro.
Here is the file in its entirety:
(defpackage ningle-tutorial-project/config
(:use :cl :envy))
(in-package ningle-tutorial-project/config)
(dotenv:load-env (asdf:system-relative-pathname :ningle-tutorial-project ".env"))
(setf (config-env-var) "APP_ENV")
(defconfig :common
`(:application-root ,(asdf:component-pathname (asdf:find-system :ningle-tutorial-project))))
(defconfig |sqlite|
`(:debug T
:middleware ((:session)
(:mito (:sqlite3 :database-name ,(uiop:getenv "SQLITE_DB_NAME")))
(:static :root ,(asdf:system-relative-pathname :ningle-tutorial-project "src/static/") :path "/public/"))))
(defconfig |mysql|
`(:middleware ((:session)
(:mito (:mysql
:database-name ,(uiop:native-namestring (uiop:parse-unix-namestring (or (uiop:getenv "MYSQL_DB_NAME") "")))
:username ,(or (uiop:getenv "MYSQL_USER") "")
:password ,(or (uiop:getenv "MYSQL_PASSWORD") "")
:host ,(or (uiop:getenv "MYSQL_ADDRESS") "")
:port (parse-integer ,(or (uiop:getenv "MYSQL_PORT") 0))))
(:static :root ,(asdf:system-relative-pathname :ningle-tutorial-project "src/static/") :path "/public/"))))
(defconfig |postgresql|
`(:middleware ((:session)
(:mito (:postgres
:database-name ,(uiop:native-namestring (uiop:parse-unix-namestring (or (uiop:getenv "POSTGRES_DB_NAME") "")))
:username ,(or (uiop:getenv "POSTGRES_USER") "")
:password ,(or (uiop:getenv "POSTGRES_PASSWORD") "")
:host ,(or (uiop:getenv "POSTGRES_ADDRESS") "")
:port (parse-integer ,(or (uiop:getenv "POSTGRES_PORT") 0))))
(:static :root ,(asdf:system-relative-pathname :ningle-tutorial-project "src/static/") :path "/public/"))))As mentioned, we need to do some cleanup in our main.lisp, the first is to remove the dotenv code that has been moved into the config.lisp file, but we will also need to take advantage of the envy-ningle package to load the active configuration into the lack builder code.
To remove the dotenv code:
(defvar *app* (make-instance 'ningle:app))
;; remove the line below
(dotenv:load-env (asdf:system-relative-pathname :ningle-tutorial-project ".env"))
(setf (ningle:route *app* "/")Now to edit the start function, it should look like the following:
(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
(djula:set-static-url "/public/")
(clack:clackup
(lack.builder:builder (envy-ningle:build-middleware :ningle-tutorial-project/config *app*))
:server server
:address address
:port port))As you can see, all of the previous middleware code that had to be changed if you wanted to switch databases, is now a single line, because envy loads the config based on the environmental variable, the envy-ningle:build-middleware function will then read that config and insert the middleware into the application. I hope you will agree that it is much simpler and makes your application much easier to manage.
If you are not yet convinced and you think you’re fine to keep things as they were, consider that we have duplicated our database connection logic in migrations.lisp and if we decide we do need to change our connection we have to do it in two places, possibly more if we have many models and want to break the code up.
We will use the same structure for how we loaded configuration in our main.lisp file, the way we use envy-ningle is different, previously we called the build-middleware function, which is designed to place the config middleware into the lack builder, here we want to get only the database connection information and thus we will use the extract-mito-config (admittedly not the best name), to get the database connection information and use it in mito:connect-toplevel.
(defun migrate ()
"Explicitly apply migrations when called."
(format t "Applying migrations...~%")
(multiple-value-bind (backend args) (envy-ningle:extract-mito-config :ningle-tutorial-project/config)
(unless backend
(error "No :mito middleware config found in ENVY config."))
(apply #'mito:connect-toplevel backend args)
(mito:ensure-table-exists 'ningle-tutorial-project/models:user)
(mito:migrate-table 'ningle-tutorial-project/models:user)
(mito:disconnect-toplevel)
(format t "Migrations complete.~%")))As you can see here, we use multiple-value-bind to get the “backend” (which will be one of the three supported SQL databases), and then the arguments that backend expects. If there isn’t a backend, an error is thrown, if there is, we call apply on the mito:connect-toplevel with the “backend” and “args” values.
Now that all the code has been written, we will want to test it all works. The simplest way to do this is while the value of “APP_ENV” in your .env file is “sqlite”, run the migrations.
(ningle-tutorial-project/migrations:migrate)
You should see the sqlite specific output, if that works, we can then change the value of “APP_ENV” to be “mysql” or “postgresql”, whichever you have available to you, and we can run the migrations again.
(ningle-tutorial-project/migrations:migrate)
This time we would expect to see different sql output, and if you do, you can confirm that the configurating switching is working as expected.
I hope you found that helpful, and that you agree that it’s better to separate our configuration from our actual application code.
To recap, after working your way though this tutorial you should be able to:
Welcome back, in this tutorial we will begin looking at how to work with SQL databases, specifically SQLite3, MySQL, and PostgreSQL. We will be using the mito ORM to create user models and save them to the database using the form we created previously. Mito itself is a basic ORM and includes several mixins to provide additional functionality, we will use one called mito-auth to provide password hashing and salting.
It is important to know that mito is based on top of a SQL library known as SXQL, we will occasionally use SXQL to write queries with mito, while it’s not always required to use SXQL, there are times where it will make life easier. To achieve this, I elected to :use SXQL in my package definition.
(defpackage ningle-tutorial-project
(:use :cl :sxql)Part of working with databases using an ORM is creating the initial database/tables and managing changes over time, called migrations, mito appears to have a migrations system, although I was unable to get it working, but I developed a means by which to apply migrations, so perhaps in a future tutorial the subject can be revisited. As such, in addition to seeing how to connect to the respective SQL databases, we will write implementation specific migration functions.
We will follow the example of setting up a secure user registration system across all three SQL implementations. One thing to bear in mind is that it is beyond the scope of this tutorial to instruct how to setup MySQL or PostgreSQL, I would recommend learning how to set them up using docker. All that having been said, let’s have a look at the different databases and how to connect to them!
Please bear in mind that when working with SQLite remember to add .db to your .gitignore as you most certainly don’t want to accidentally commit a database into git! SQLite, being a file based database (unlike MySQL and PostgreSQL) will create a file that represents your database so this step only applies to SQLite.
To begin with we will need to ensure we have installed and added the packages we need to our project asd file, there are three that we will be installing:
As normal you will need to add them in the :depends-on section. Please note however that there is an issue in mito-auth that prevents it from working in MySQL, I have submitted a fix but it has not been merged yet, so for now you can use my branch, if you do, please ensure you check it out via git into your quicklisp/local-projects directory.
:depends-on (:clack
:cl-dotenv
:djula
:cl-forms
:cl-forms.djula
:cl-forms.ningle
:ingle ;; Add this
:mito ;; Add this
:mito-auth ;; Add this
:ningle)Mito is a package for managing models/tables in our application, mito-auth is a mixin that enables models to have a secure password field, not all models will need this, but our user model will! ingle is a small library that includes some very useful utilities, one of which is a redirect function which will be very useful indeed!
Reader David J. Kordsmeier has reported the need to build and link libmagic on Mac. They have linked a gist. For clarity, if you need to build and link libmagic on Mac.
;; This fixes a magic.h not found !
brew reinstall libmagic pkgconf
export CPPFLAGS="-I$(brew --prefix)/include $CPPFLAGS"
export LDFLAGS="-L$(brew --prefix)/lib $LDFLAGS"
export PKG_CONFIG_PATH="$(brew --prefix)/lib/pkgconfig:$PKG_CONFIG_PATH"
;; then run your lisp, and install
(ql:quickload :magicffi)
Now that that is done, we must set up the middleware, you might remember from Part 3 that middleware is placed in the lack.builder:builder function call in our start function.
Mito provides middleware to establish and manage database connections for SQLite3, MySQL, and PostgreSQL, when you build your solution you will need to pick a database implementation, for production systems I suggest PostgreSQL, but if you are just starting out, you can use SQLite.
(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
(djula:set-static-url "/public/")
(clack:clackup
(lack.builder:builder
:session
`(:mito
(:sqlite3
:database-name ,(uiop:getenv "SQLITE_DB_NAME")))
(:static
:root (asdf:system-relative-pathname :ningle-tutorial-project "src/static/")
:path "/public/")
*app*)
:server server
:address address
:port port))(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
(djula:set-static-url "/public/")
(clack:clackup
(lack.builder:builder
:session
`(:mito
(:mysql
:database-name ,(uiop:native-namestring (uiop:parse-unix-namestring (uiop:getenv "MYSQL_DB_NAME")))
:username ,(uiop:getenv "MYSQL_USER")
:password ,(uiop:getenv "MYSQL_PASSWORD")
:host ,(uiop:getenv "MYSQL_ADDRESS")
:port ,(parse-integer (uiop:getenv "MYSQL_PORT"))))
(:static
:root (asdf:system-relative-pathname :ningle-tutorial-project "src/static/")
:path "/public/")
*app*)
:server server
:address address
:port port))(defun start (&key (server :woo) (address "127.0.0.1") (port 8000))
(djula:add-template-directory (asdf:system-relative-pathname :ningle-tutorial-project "src/templates/"))
(djula:set-static-url "/public/")
(clack:clackup
(lack.builder:builder
:session
`(:mito
(:postgres
:database-name ,(uiop:native-namestring (uiop:parse-unix-namestring (uiop:getenv "POSTGRES_DB_NAME")))
:username ,(uiop:getenv "POSTGRES_USER")
:password ,(uiop:getenv "POSTGRES_PASSWORD")
:host ,(uiop:getenv "POSTGRES_ADDRESS")
:port ,(parse-integer (uiop:getenv "POSTGRES_PORT"))))
(:static
:root (asdf:system-relative-pathname :ningle-tutorial-project "src/static/")
:path "/public/")
*app*)
:server server
:address address
:port port))Before we go further with building models and migration functions, we should test that the connections work and the most basic of SQL statements. We will be working on our register controller, so that seems like as good a place as any to place a simple check.
(setf (ningle:route *app* "/register" :method '(:GET :POST))
(lambda (params)
(let ((query (mito:retrieve-by-sql "SELECT 2 + 3 AS result")))
(format t "Test: ~A~%" query))
(let ((form (cl-forms:find-form 'register)))
...Here, in the controller we have added a small (temporary) check to ensure that the database connections are set up correctly, when you run the application and perform a GET request on this route, you should see the output printed in the console for:
Test: ((RESULT 5))
It might look a little odd, but rest assured that this is proof that everything is right and the connection works! We will be removing this later as it serves just as a small check. So with that done, we can begin to look into writing our first model, our user model.
Models are a way to represent both a generic object, and any specific object of that type in a relational database system. For example you might have a Book model, that represents a book table, however a book is just a way to classify something any doesn’t tell you anything specific about any individual book. So here we will create a User model, that refers to all users, but each instance of a User will contain the specific information about any given user.
We will create a new file called models.lisp:
(defpackage ningle-tutorial-project/models
(:use :cl :mito)
(:export #:user))
(in-package ningle-tutorial-project/models)
(deftable user (mito-auth:has-secure-password)
((email :col-type (:varchar 255) :initarg :email :accessor email)
(username :col-type (:varchar 255) :initarg :username :accessor username))
(:unique-keys email username))Now, mito provides a deftable macro that hides some of the complexities, there is a way to use a regular class and change the metaclass, but it’s much less typing and makes the code look nicer to use the deftable syntax. It is important to note however that we use the mixin from mito-auth called has-secure-password. Obviously this mixin wouldn’t be needed in all of our models, but because we are creating a user that will log into our system, we need to ensure we are handling passwords securely.
Now that we have this we need to write the migration code I mentioned earlier, databases (and their models) change over time as application requirements change, as columns get added, removed, changed, etc it can be tricky to get right and you certainly would prefer to have these done automatically, a stray SQL query in the wrong connected database can do incredible damage (trust me, I know!), so migrations allow us to track these changes and have the database system manage them for us.
This code will set up connections to the implementation we want to use and delegate migrations to mito, so pick your implementation and place it in migrations.lisp.
(defpackage ningle-tutorial-project/migrations
(:use :cl :mito)
(:export #:migrate))
(in-package :ningle-tutorial-project/migrations)
(defun migrate ()
"Explicitly apply migrations when called."
(dotenv:load-env (asdf:system-relative-pathname :ningle-tutorial-project ".env"))
(format t "Applying migrations...~%")
(mito:connect-toplevel
:sqlite3
:database-name (uiop:native-namestring (uiop:parse-unix-namestring (uiop:getenv "SQLITE_DB_NAME"))))
(mito:ensure-table-exists 'ningle-tutorial-project/models:user)
(mito:migrate-table 'ningle-tutorial-project/models:user)
(mito:disconnect-toplevel)
(format t "Migrations complete.~%"))(defpackage ningle-tutorial-project/migrations
(:use :cl :mito)
(:export #:migrate))
(in-package :ningle-tutorial-project/migrations)
(defun migrate ()
"Explicitly apply migrations when called."
(dotenv:load-env (asdf:system-relative-pathname :ningle-tutorial-project ".env"))
(format t "Applying migrations...~%")
(mito:connect-toplevel
:mysql
:database-name (uiop:native-namestring (uiop:parse-unix-namestring (uiop:getenv "MYSQL_DB_NAME")))
:username (uiop:getenv "MYSQL_USER")
:password (uiop:getenv "MYSQL_PASSWORD")
:host (uiop:getenv "MYSQL_ADDRESS")
:port (parse-integer (uiop:getenv "MYSQL_PORT")))
(mito:ensure-table-exists 'ningle-tutorial-project/models:user)
(mito:migrate-table 'ningle-tutorial-project/models:user)
(mito:disconnect-toplevel)
(format t "Migrations complete.~%"))(defpackage ningle-tutorial-project/migrations
(:use :cl :mito)
(:export #:migrate))
(in-package :ningle-tutorial-project/migrations)
(defun migrate ()
"Explicitly apply migrations when called."
(dotenv:load-env (asdf:system-relative-pathname :ningle-tutorial-project ".env"))
(format t "Applying migrations...~%")
(mito:connect-toplevel
:postgres
:database-name (uiop:getenv "POSTGRES_DB_NAME")
:host (uiop:getenv "POSTGRES_ADDRESS")
:port (parse-integer (uiop:getenv "POSTGRES_PORT"))
:username (uiop:getenv "POSTGRES_USER")
:password (uiop:getenv "POSTGRES_PASSWORD"))
(mito:ensure-table-exists 'ningle-tutorial-project/models:user)
(mito:migrate-table 'ningle-tutorial-project/models:user)
(mito:disconnect-toplevel)
(format t "Migrations complete.~%"))It will be necessary to add these two files into the :components section of your project asd file.
:components ((:module "src"
:components
((:file "models")
(:file "migrations")
(:file "forms")
(:file "main"))))Just remember if you are using MySQL or PostgreSQL, you will need to ensure that the database you want to connect to exists (in our case ntp), and that your connecting user has the correct permissions!
Now that everything is set up, we will need to perform our initial migrations:
(ningle-tutorial-project/migrations:migrate)If this has worked, you will see a lot of output SQL statements, it’s quite verbose, however this only means that it is working and we can move onto actually creating and saving models.
Now that we have migrations and models working we should remember to remove this verification code that we wrote earlier.
(let ((query (mito:retrieve-by-sql "SELECT 2 + 3 AS result")))
(format t "Test: ~A~%" query))What we are going to do now is use the user register form and connect it to our database, because we are registering users we will have to do some checks to ensure since we stated that usernames and email addresses are unique, we might want to raise an error.
(when valid
(cl-forms:with-form-field-values (email username password password-verify) form
(when (mito:select-dao 'ningle-tutorial-project/models:user
(where (:or (:= :username username)
(:= :email email))))
(error "Either username or email is already registered"))We can see from this snippet here that mito uses the SXQL Domain Specific Language for expressing SQL statements. Using the select-dao we can query the user table and apply where clauses using a more Lispy like syntax to check to see if an account with the username or email already exists. Such DSLs are common when interacting with SQL inside another programming language, but it’s good to know that from what we learned earlier that it can handle arbitrary SQL strings or this more Lispy syntax, so you can use pure SQL syntax, if necessary.
While having this check isn’t necessary, it does make the error handling somewhat nicer, as well as exploring parts of the mito api. We will also add a check to raise an error if the passwords submitted in the form do not match each other.
(when (string/= password password-verify)
(error "Passwords do not match"))If both of these pass (and you can test different permutations of course), we can continue to using mito to create our first user object!
(mito:create-dao 'ningle-tutorial-project/models:user
:email email
:username username
:password password)The final thing to add is that we should redirect to another route, which we can do with the ingle:redirect function.
(ingle:redirect "/people")You will notice that we are redirecting to a route that doesn’t (yet) exist, we will write the controller below after we have finished this controller, the multiple-value-bind section of which, when completed, looks like this:
(multiple-value-bind (valid errors)
(cl-forms:validate-form form)
(when errors
(format t "Errors: ~A~%" errors))
(when valid
(cl-forms:with-form-field-values (email username password password-verify) form
(when (mito:select-dao 'ningle-tutorial-project/models:user
(where (:or (:= :username username)
(:= :email email))))
(error "Either username or email is already registered"))
(when (string/= password password-verify)
(error "Passwords do not match"))
(mito:create-dao 'ningle-tutorial-project/models:user
:email email
:username username
:password password)
(ingle:redirect "/people"))))We will look at two final examples of using mito before we finish this tutoral, as mentioned earlier we will write a new /people controller, which will list all the users registered in the system, and we will create a /people/:person controller to show the details of an individual user.
Starting with the /people controller, we create a controller like we have seen before, we then use a let binding to store the result of (mito:retrieve-dao 'ningle-tutoral-project/model:user), this is how we would get all rows from a table represented by the class 'ningle-tutorial-project/models:user. We then pass the results into a template.
(setf (ningle:route *app* "/people")
(lambda (params)
(let ((users (mito:retrieve-dao 'ningle-tutorial-project/models:user)))
(djula:render-template* "people.html" nil :title "People" :users users))))The html for this is written as such:
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row" >
<div class="col-12">
{% for user in users %}
<div class="row mb-4">
<div class="col">
<div class="card">
<div class="card-body">
<h5 class="card-title"><a href="/people/{{ user.username }}">{{ user.username }}</a></h5>
<p class="card-text"><a href="/people/{{ user.email }}">{{ user.email }}</a></p>
<p class="text-muted small"></p>
</div>
</div>
</div>
</div>
{% endfor %}
{% if not users %}
<div class="row">
<div class="col text-center">
<p class="text-muted">No users to display.</p>
</div>
</div>
{% endif %}
</div>
</div>
</div>
{% endblock %}In our individual person view, we see how a route may have variable data, our :person component of the URL string, this will be either a username or email, it doesn’t really matter which as we can have a SQL query that will find a record that will match the :person string with either the username or email. We also take advantage of another ingle function, the get-param, which will get the value out of :person. We use a let* binding to store the user derived from :person and the result of mito:select-dao (using the person), we then pass the user object into a template.
As we saw before this query was used to check for the existence of a username or email address in our register controller.
(setf (ningle:route *app* "/people/:person")
(lambda (params)
(let* ((person (ingle:get-param :person params))
(user (first (mito:select-dao
'ningle-tutorial-project/models:user
(where (:or (:= :username person)
(:= :email person)))))))
(djula:render-template* "person.html" nil :title "Person" :user user))))And here is the template for an individual user.
{% extends "base.html" %}
{% block content %}
<div class="container">
<div class="row">
<div class="col-12">
<div class="row mb-4">
<div class="col">
{% if not user %}
<h1>No users</h1>
{% else %}
<div class="card">
<div class="card-body">
<h5 class="card-title">{{ user.username }}</h5>
<p class="card-text">{{ user.email }}</p>
<p class="text-muted small"></p>
</div>
</div>
{% endif %}
</div>
</div>
</div>
</div>
</div>
{% endblock %}This was a rather large chapter and we covered a lot, looking at the different means by which to connect to a SQL database, defining models, running migrations and executing queries, of course we are just getting started but this is a massive step forward and our application is beginning to take shape. I certainly hope you have enjoyed it and found it useful!
To recap, after working your way though this tutorial you should be able to: