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

@@ -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)
-   (with-check-validate (user) ; target-slots)
+      ((number (:require t)
-       ((number (:require t)
+	       (:key #'parse-integer)
-		(:key #'parse-integer)
+	       (:assert (< 0 number 100))
-		(:assert (< 0 number 100))
+	       (:unique (:= :number number)))
-		(:unique (:= :number number)))
+       (name (:require t)
-	(name (:require t)
+	     (:type string)
-	      (:type string)
+	     (:assert (ppcre:scan "^[A-Za-z][A-Za-z0-9]*$" name))
-	      (:assert (ppcre:scan "^[A-Za-z][A-Za-z0-9]*$" name))
+	     (:assert (<= 2 (length name) 20) "length must be (<= 2 x 20)")
-	      (:assert (<= 2 (length name) 20) "length must be (<= 2 x 20)")
+	     (:unique (:like :name name)))
-	      (:unique (:like :name name)))
+       ((n full-name)
-	((n full-name)
+	(:require t)
-	 (:require t)
+	(:type string)
-	 (:type string)
+	(:assert (<= 1 (length n) 20) "length must be (<= 1 x 20)"))
-	 (:assert (<= 1 (length n) 20) "length must be (<= 1 x 20)"))
+       (email (:key #'ratify:test-email))
-	(email (:key #'ratify:test-email))
+       (password (:require t)
-	;; (password (:require t)
+		 (:type string)
-	;; 		 (:type string)
+		 (:assert (< 0 (length password)) "Empty string is invalid"))
-	;; 		 (:assert (< 0 (length password)) "Empty string is invalid"))
+       (birthday (:key #'local-time:parse-timestring))
-	(birthday (:key #'local-time:parse-timestring))
+       (sex (:require t)
-	(sex (:require t)
+	    (:key #'parse-integer)
-	     (:key #'parse-integer)
+	    (:assert (<= 1 sex 2)))
-	     (:assert (<= 1 sex 2)))
+       (administrator (:require t)
-	(administrator (:require t)
+		      (:key (lambda(x) (zerop (parse-integer x))))))))
-		       (:key (lambda(x) (zerop (parse-integer x)))))))))
 
 (defun validate-article (article &rest target-slots)
   (with-check-validate (article) ; target-slots)

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
+  ;; 	  (lack.request:request-body-parameters
-  ;; 			    ningle:*request*))
+  ;; 	   ningle:*request*))
-  (cond ((string= "put" method) (put-user
+  (cond ((string= "put" method)
-				 (lack.request:request-body-parameters
+	 (put-user
-				  ningle:*request*)))
+	  (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"
+		  :birthday
-		  ;; (format nil "~A-~A-~A" birthday-year birthday-month birthday-day)
+		  (format nil "~D-~D-~D" birthday-year birthday-month birthday-day)
 		  :allow-other-keys t args))
-	(if errors `(400 ()
+	(if errors
-			 (,(render "users/new.html"
+	    `(400 () (,(render "users/new.html"
-				   `(:user ,user
+			       `(:user ,user
-				     :errors ,errors
+				 :errors ,errors
-				     :token,(token)))))
+				 :token ,(token)))))
 	    (progn (setf(gethash :notice ningle:*session*)"Stored!")
-		   `(303 (:location
+		   (with-connection (db)
-			  ,(format
+		     (mito:save-dao user) ; bookmark
-			    nil
+		   (let ((the-id (mito:object-id user)))
-			    "/users/~D"
+		     (step
-			    (with-connection (db)
+		      (format t "~&[INFO] THE ID: ~A" the-id))
-			      (mito:object-id user))))))))))
+		     `(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.

templates/users/form.html

@@ -1,4 +1,5 @@
 {% include "shared/errors.html" %}
+
 <table class="attr">
   <tr>
     <th><label for="user-number">{% filter i18n %}Number{% endfilter %}</label></th>
@@ -8,6 +9,10 @@
     <th><label for="user-name">{% filter i18n %}Name{% endfilter %}</label></th>
     <td><input type="text" value="{{user.name}}" name="NAME" id="user-name" /></td>
   </tr>
+  <tr>
+    <th><label for="password">Password</label></th>
+    <td><input id="password" type="text" name="PASSWORD" /></td>
+  </tr>
   <tr>
     <th><label for="user-full-name">{% filter i18n %}Full Name{% endfilter %}</label></th>
     <td><input type="text" value="{{user.full-name}}" name="FULL-NAME" id="user-full-name" /></td>
@@ -73,3 +78,4 @@
     <th><label for="user-email">{% filter i18n %}Email{% endfilter %}</label></th>
     <td><input type="text" name="EMAIL" id="user-email" value="{{user.email}}"/></td>
   </tr>
+{% include "shared/user_form.html" %}

templates/users/new.html

@@ -6,6 +6,7 @@
 {% block content %}
 <h1>{% lisp (title!) %}</h1>
 <p>{{user}}</p>
+<p>{{errors}}</p>
 <form class="new-user" id="new-user" action="/user" method="post"
       enctype="multipart/form-data">
   <!-- Method and Authenticity-token need to be in capitals -->