From 3a3392bba77ed28daa183c8dfd79ba87edf2ee0d Mon Sep 17 00:00:00 2001 From: Craig Oates Date: Mon, 10 Jan 2022 21:40:20 +0000 Subject: [PATCH] Chapter 13 commit (code is very flaky). The code is a bit all of the place because of the changes not being applied everywhere. So, some pages are loading when only logged in and producing errors when not. Because this is a learning exercise, I am not too concerned with this because the main point is to learn how to do what the chapter is trying to explain. Also, the tutorials are not updating the code in all places as it goes along so, again, I am not too concerned with the errors in certain parts of the source code. --- src/model.lisp | 49 +++++++++++++++++++-------------------- src/web.lisp | 41 ++++++++++++++++++-------------- templates/users/form.html | 6 +++++ templates/users/new.html | 1 + 4 files changed, 54 insertions(+), 43 deletions(-) diff --git a/src/model.lisp b/src/model.lisp index d8c4655..027c792 100644 --- a/src/model.lisp +++ b/src/model.lisp @@ -322,31 +322,30 @@ reference for future projects. This is a learning project after all. (defun validate-user (user &rest target-slots) - (step - (with-check-validate (user) ; target-slots) - ((number (:require t) - (:key #'parse-integer) - (:assert (< 0 number 100)) - (:unique (:= :number number))) - (name (:require t) - (:type string) - (:assert (ppcre:scan "^[A-Za-z][A-Za-z0-9]*$" name)) - (:assert (<= 2 (length name) 20) "length must be (<= 2 x 20)") - (:unique (:like :name name))) - ((n full-name) - (:require t) - (:type string) - (:assert (<= 1 (length n) 20) "length must be (<= 1 x 20)")) - (email (:key #'ratify:test-email)) - ;; (password (:require t) - ;; (:type string) - ;; (:assert (< 0 (length password)) "Empty string is invalid")) - (birthday (:key #'local-time:parse-timestring)) - (sex (:require t) - (:key #'parse-integer) - (:assert (<= 1 sex 2))) - (administrator (:require t) - (:key (lambda(x) (zerop (parse-integer x))))))))) + (with-check-validate (user) ; target-slots) + ((number (:require t) + (:key #'parse-integer) + (:assert (< 0 number 100)) + (:unique (:= :number number))) + (name (:require t) + (:type string) + (:assert (ppcre:scan "^[A-Za-z][A-Za-z0-9]*$" name)) + (:assert (<= 2 (length name) 20) "length must be (<= 2 x 20)") + (:unique (:like :name name))) + ((n full-name) + (:require t) + (:type string) + (:assert (<= 1 (length n) 20) "length must be (<= 1 x 20)")) + (email (:key #'ratify:test-email)) + (password (:require t) + (:type string) + (:assert (< 0 (length password)) "Empty string is invalid")) + (birthday (:key #'local-time:parse-timestring)) + (sex (:require t) + (:key #'parse-integer) + (:assert (<= 1 sex 2))) + (administrator (:require t) + (:key (lambda(x) (zerop (parse-integer x)))))))) (defun validate-article (article &rest target-slots) (with-check-validate (article) ; target-slots) diff --git a/src/web.lisp b/src/web.lisp index ead7c72..8d1c091 100644 --- a/src/web.lisp +++ b/src/web.lisp @@ -199,11 +199,12 @@ nil "/users/~D"(mito:object-id user)))))))) (defroute ("/user" :method :post) (&key method) ;; (format t "~%[INFO] THIS IS THE ROUTE YOU THINK IT IS ~A" - ;; (lack.request:request-body-parameters - ;; ningle:*request*)) - (cond ((string= "put" method) (put-user - (lack.request:request-body-parameters - ningle:*request*))) + ;; (lack.request:request-body-parameters + ;; ningle:*request*)) + (cond ((string= "put" method) + (put-user + (lack.request:request-body-parameters + ningle:*request*))) (t `(400 (:content-type "text/plain") (,(format nil "Unknown method ~S" method)))))) @@ -217,11 +218,13 @@ nil "/users/~D"(mito:object-id user)))))))) number name full-name + password email administrator) (declare (ignore number name full-name + password email administrator)) (if (not (string= authenticity-token (token))) @@ -229,21 +232,22 @@ nil "/users/~D"(mito:object-id user)))))))) (multiple-value-bind (user errors) (validate-user (apply #'make-instance 'rails-to-caveman.model::user - ;; :birthday "2021-12-12" - ;; (format nil "~A-~A-~A" birthday-year birthday-month birthday-day) + :birthday + (format nil "~D-~D-~D" birthday-year birthday-month birthday-day) :allow-other-keys t args)) - (if errors `(400 () - (,(render "users/new.html" - `(:user ,user - :errors ,errors - :token,(token))))) + (if errors + `(400 () (,(render "users/new.html" + `(:user ,user + :errors ,errors + :token ,(token))))) (progn (setf(gethash :notice ningle:*session*)"Stored!") - `(303 (:location - ,(format - nil - "/users/~D" - (with-connection (db) - (mito:object-id user)))))))))) + (with-connection (db) + (mito:save-dao user) ; bookmark + (let ((the-id (mito:object-id user))) + (step + (format t "~&[INFO] THE ID: ~A" the-id)) + `(303 (:location + ,(format nil "users/~D" the-id)))))))))) (defroute delete-user ("/users/:id" :method :delete) (&key |authenticity-token| id) @@ -584,6 +588,7 @@ nil "/users/~D"(mito:object-id user)))))))) :user ,(current-user) :news (1 2 3 4 5) :blogs (1 2 3 4 5) + :articles ,(articles-make 5) ,@(roles))))) ;; Reimplemented in Chapter 13. diff --git a/templates/users/form.html b/templates/users/form.html index 3d98a66..a0d9da2 100644 --- a/templates/users/form.html +++ b/templates/users/form.html @@ -1,4 +1,5 @@ {% include "shared/errors.html" %} + @@ -8,6 +9,10 @@ + + + + @@ -73,3 +78,4 @@ +{% include "shared/user_form.html" %} diff --git a/templates/users/new.html b/templates/users/new.html index 4e50610..9c9cef7 100644 --- a/templates/users/new.html +++ b/templates/users/new.html @@ -6,6 +6,7 @@ {% block content %}

{% lisp (title!) %}

{{user}}

+

{{errors}}