From 3d707c540968a1745b0bad11b6b904b49674e03e Mon Sep 17 00:00:00 2001 From: Craig Oates Date: Sun, 19 Dec 2021 07:23:18 +0000 Subject: [PATCH] Chapter 6 commit (bug with /user/:id route when posting). This mostly sets up the basic CRUD operations you normally find on a website. There is some code for CSRF, also. There is one major bit of malfunctioning coding though. It is the 'setf' bit of code. I have tried to rearrange the code to see if I can get it to work but I simply cannot work it out. I have decided to leave the code as it is described in the tutorial (for Chapter 6) and hope there is some incite in future chapters to help me fix the problem. --- rails-to-caveman.asd | 1 + src/model.lisp | 8 +- src/web.lisp | 227 +++++++++++++++++++++++++++++++++++-- static/css/main.css | 7 ++ templates/layouts/app.html | 3 + templates/users/edit.html | 25 ++++ templates/users/form.html | 96 ++++++++++++++++ templates/users/index.html | 15 +-- templates/users/new.html | 21 ++++ templates/users/show.html | 2 +- 10 files changed, 386 insertions(+), 19 deletions(-) create mode 100644 templates/users/edit.html create mode 100644 templates/users/form.html create mode 100644 templates/users/new.html diff --git a/rails-to-caveman.asd b/rails-to-caveman.asd index 731d45f..c1e3b1c 100644 --- a/rails-to-caveman.asd +++ b/rails-to-caveman.asd @@ -9,6 +9,7 @@ #:envy #:cl-ppcre #:uiop + #:local-time ; <-- Added Chapter 6 ;; for @route annotation #:cl-syntax-annot diff --git a/src/model.lisp b/src/model.lisp index ae38f84..33cc82e 100644 --- a/src/model.lisp +++ b/src/model.lisp @@ -1,5 +1,5 @@ -;;(in-package #:cl-user) ; Not sure if this needs to exist (Chapter 4) -(defpackage rails-to-caveman.model +(in-package #:cl-user) ; Not sure if this needs to exist (Chapter 4) +(defpackage #:rails-to-caveman.model (:use #:cl #:rails-to-caveman.db #:mito)) @@ -105,3 +105,7 @@ this tutorial was translated/ported from." (mapcar #'mito:object-id (mito:retrieve-dao 'rails-to-caveman.model::user)))) +;; A common strategy to deal with SQLite Boolean types is to set +;; constants and refer to them instead of passing hard coded 1 & 0. +(defconstant +false+ 0) +(defconstant +true+ 1) diff --git a/src/web.lisp b/src/web.lisp index b435482..fc73d13 100644 --- a/src/web.lisp +++ b/src/web.lisp @@ -1,5 +1,5 @@ (in-package #:cl-user) -(defpackage rails-to-caveman.web +(defpackage #:rails-to-caveman.web (:use #:cl #:caveman2 #:rails-to-caveman.config @@ -39,7 +39,10 @@ (render "users/index.html" `(:users ,(with-connection (db) (mito:select-dao 'rails-to-caveman.model::user - (sxql:order-by :number)))))) + (sxql:order-by :number))) + :token ,(token) + :notice (flash-gethash + :notice ningle:*request*)))) (defroute "/users/search" (&key |q|) (render "users/index.html" @@ -51,11 +54,207 @@ (sxql:order-by :number)))))) (defroute "/users/:id" (&key id) - (setf id (parse-integer id)) - (render "users/show.html" - `(:user ,(with-connection (db) - (mito:find-dao 'rails-to-caveman.model::user - :id id))))) + (let ((id (ignore-errors (parse-integer id)))) + (if (null id) + (myway.mapper:next-route) + (let ((user (with-connection (db) + (mito:find-dao 'rails-to-caveman.model::user + :id id)))) + ;; (setf id (parse-integer id)) + (if user + (render "users/show.html" + `(:user ,(with-connection (db) + (mito:find-dao 'rails-to-caveman.model::user + :id id)) + :notice ,(flash-gethash + :notice ningle:*session*))) + (on-exception *web* 404)))))) + +(defroute "/user/new" () + (render #P"users/new.html" + `(:users ,(with-connection (db) + (make-instance 'rails-to-caveman.model::user)) + :token ,(token)))) + +(defroute "/users/:id/edit" (&key id) + (let* ((id (ignore-errors (parse-integer id))) + (user (with-connection (db) ; NOTE `USER' AND NOT USERS. + (and id + (mito:find-dao 'rails-to-caveman.model::user + :id id))))) + (if user (render "users/edit.html" + `(:user ,user :token ,(token))) + (on-exception *web* 404)))) + +(defroute ("/user/:id" :method :post) + (&key |authenticity-token| + id + (|number| "") + |name| + |full-name| + (|sex| "") + |birthday-year| + |birthday-month| + |birthday-day| + |email| + (|administrator| "")) + (if (not (string= |authenticity-token| (token))) + '(403 () ("Denied")) + (with-connection (db) + (let ((id (ignore-errors (parse-integer id))) + (user (and id + (mito:find-dao + 'rails-to-caveman.model::user :id id)))) + (if (null user) + '(500 () ("Could not edit because user doesn't exist."))) + (progn + + #| CHAPTER 6 CODE NOT WORKING HERE. + ================================= + + I could not get this part of the code (setf) to work when + following the tutorial. Because of this, I have decided to + leave the code the tutorial (in Chapter 6) + provided. Hopefully, there are other code examples which + will provide an answer to get this part of the code + working. + + For now, this route (I.E. when you try to update a user) the site will + throw an error and not update it. + |# + + (setf (rails-to-caveman.model::number-of user) (parse-integer |number| :junk-allowed t) + (rails-to-caveman.model::name-of user) |name| + (rails-to-caveman.model::full-name-of user) |full-name| + (rails-to-caveman.model::sex-of user) (parse-integer |sex| :junk-allowed t) + (rails-to-caveman.model::birthday-of user) (local-time:parse-timestring + (format nil "~A-~A-~A" + |birthday-year| + |birthday-month| + |birthday-day|)) + (rails-to-caveman.model::email-of user) |email| + (rails-to-caveman.model::administrator-of user) (eq rails-to-caveman.model::+true+ + (zerop (parse-integer + |administrator| + :junk-allowed t)))) + (mito:save-dao user) + (setf (gethash :notice ningle:*session*) "Updated") + `(303 (:location ,(format nil "/users/~D" id)))))))) + +(defroute ("/user" :method :post) + (&key |authenticity-token| + (|number| "") + |name| + |full-name| + (|sex| "") + |birthday-year| + |birthday-month| + |birthday-day| + |email| + (|administrator| "")) + (if(not(string= |authenticity-token| (token))) + '(403 () ("Denied")) + (with-connection (db) + (let ((user (mito:create-dao + 'rails-to-caveman.model::user + :number (parse-integer |number| :junk-allowed t) + :name |name| + :full-name |full-name| + :sex (parse-integer |sex| :junk-allowed t) + :birthday (local-time:parse-timestring + (format nil "~A-~A-~A" + |birthday-year| + |birthday-month| + |birthday-day|)) + :email |email| + :administrator (eq + rails-to-caveman.model::+true+ + (zerop + (parse-integer |administrator| + :junk-allowed t)))))) + (setf(gethash :notice ningle:*session*)"Stored!") + `(303 (:location ,(format + nil "/users/~D"(mito:object-id user)))))))) + +(defroute delete-user ("/users/:id" :method :delete) + (&key |authenticity-token| id) + (if (not (string= |authenticity-token| (token))) + `(403 (:content-type "text/plain") ("Denied")) + (with-connection (db) + (let* ((id (ignore-errors (parse-integer id))) + (user (and id + (mito:find-dao 'rails-to-caveman.model::user + :id id)))) + (if (null user) + `(500 (:content-type "text-plain") + (,(format nil + "~%Could not delete. User doesn't exist. Id ~S" + id))) + (progn (mito:delete-dao user) + (setf (gethash :notice ningle:*session* "Deleted.") + `(303 (:location "/users/index"))))))))) + +(defroute ("/users/:id" :method :post) + (&key |authenticity-token| + id + (|number| "") + |name| + |full-name| + (|sex| "") + |birthday-year| + |birthday-month| + |birthday-day| + |email| + (|administrator| "") + |_method|) + (if (not (string= |authenticity-token| (token))) + `(403 () ("Denied")) + (cond ((string= |_method| "delete") + (delete-user + (acons "ID" id (lack.request:request-body-parameters + ningle:*request*)))) + ((find |_method| `("" "post")) + (with-connection (db) + (let ((id (ignore-errors (parse-integer id))) + (user (and id (mito:find-dao + 'rails-to-caveman.model::user + :id id)))) + (if (null user) + '(500 (:content-type "text/plan" + ("Could not find the user.")) + (progn (setf (rails-to-caveman.model::number-of user) + (parse-integer |number| :junk-allowed t) + (rails-to-caveman.model::name-of user) + |name| + (rails-to-caveman.model::full-name-of user) + (rails-to-caveman.model::sex-of user) + (parse-integer |sex| :junk-allowed t) + (rails-to-caveman.model::birthday-of user) + (local-time:parse-timestring + (format nil "~A-~A-~A" + |birthday-year| + |birthday-month| + |birthday-day|)) + (rails-to-caveman.model::email-of user) + |email| + (rails-to-caveman.model::administrator user) + (eq rails-to-caveman.model::+true+ + (zerop (parse-integer + |administrator| + :junk-allowed t)))) + (mito:save-dao user) + (setf (gethash + :notice ningle:*session*) + "Updated") + `(303 (:location ,(format nil + "/users/~D" + id))))))))) + (t `(400 (:content-type "text/plain") + (,(format nil "Unsupported method ~S" + |_method|))))))) + + + (defroute "/about" () ;; about.html should be in the /templates directory. @@ -198,9 +397,19 @@ ((:pan . 2680) (:glass . 2550) (:pepper-mill . 4515) - (:peeler . 945))))) - )) + (:peeler . 945))))))) + +(defun token () + "CSRF token." + (cdr (assoc "lack.session" + (lack.request:request-cookies ningle:*request*) + :test #'string=) ;string equality (always forget this) + )) +(defun flash-gethash (key table) + (let ((value (gethash key table))) + (remhash key table) + value)) ;; ;; Error pages diff --git a/static/css/main.css b/static/css/main.css index a8c8a65..4b8a472 100644 --- a/static/css/main.css +++ b/static/css/main.css @@ -80,3 +80,10 @@ div.toolbar { font-size: 90%; text-align: right; } + +/* flash */ +p.notice { + border: 1px solid blue; + padding: 3px; + background-color: #ccf; +} diff --git a/templates/layouts/app.html b/templates/layouts/app.html index 5fc7e2c..08b7f17 100644 --- a/templates/layouts/app.html +++ b/templates/layouts/app.html @@ -11,6 +11,9 @@ {% include "shared/header.html" %}
+ {% if notice %} +

{{notice}}

+ {% endif %} {% block content %}{% endblock %}