Chapter 8 commit (authentication and Hermetic).

There are some bugs within the code with this commit. The translation
from Japanese to English is making it hard to follow along in some
places. With that said, this repo. if for learning and becoming
familiar with Caveman2, Common Lisp and the other things it comes with.

rails-to-caveman.asd

@@ -10,6 +10,7 @@
                #:cl-ppcre
                #:uiop
 	       #:local-time ; <-- Added Chapter 6
+	       #:ratify ; <-- Chapter 7
 
                ;; for @route annotation
                #:cl-syntax-annot
@@ -21,14 +22,18 @@
 	       #:mito ; <--- Added in Chapter 4.
                #:datafly
                #:sxql
+
+	       ;; for authentication
+	       #:hermetic
 	       )
-  :components ((:module "src"
-                :components
-                ((:file "main" :depends-on ("config" "view" "db"))
-                 (:file "web" :depends-on ("view"))
-                 (:file "view" :depends-on ("config"))
-                 (:file "db" :depends-on ("config"))
-		 (:file "model" :depends-on ("db")) ; <--- Chapter 4.
-                 (:file "config"))))
-  :description ""
+  :components
+  ((:module "src"
+    :components ((:file "main" :depends-on ("config" "view" "db"))
+		 (:file "web" :depends-on ("view" "model"))
+		 (:file "view" :depends-on ("config"))
+		 (:file "db" :depends-on ("config"))
+		 (:file "model" :depends-on ("db"))
+		 (:file "locale" :depends-on ("config")) ; <--- This!
+		 (:file "config"))))
+  :description "Rails to Caveman2 port."
   :in-order-to ((test-op (test-op "rails-to-caveman-test"))))

src/config.lisp

@@ -1,6 +1,7 @@
 (in-package #:cl-user)
 (defpackage rails-to-caveman.config
-  (:use #:cl)
+  (:use #:cl
+	#:rails-to-caveman.locale)
   (:import-from #:envy
 		#:config-env-var
                 #:defconfig)

src/locale.lisp

@@ -0,0 +1,51 @@
+(in-package #:cl-user)
+(defpackage #:rails-to-caveman.locale
+  (:use #:cl)
+  (:export #:define-dictionary
+	   #:with-i18n
+	   #:accept-language
+	   #:parse-accept-language
+	   #:find-locale
+	   #:find-acceptable-locale))
+(in-package #:rails-to-caveman.locale)
+
+(cl-locale:define-dictionary rails-to-caveman
+  ("ja" (merge-pathnames "locale/ja-jp.lisp"
+			 rails-to-caveman.config:*static-directory*))
+  ("ja-JP" (merge-pathnames "locale/ja-jp.lisp"
+			    rails-to-caveman.config:*static-directory*)))
+
+(defmacro define-dictionary (name &rest args)
+  `(progn (cl-locale:define-dictionary ,name ,@args)
+	  (defun reload ()
+	    (loop :for (locale dictionary)
+		    :in (list ,@(mapcar (lambda (arg)
+					 `(list ,@arg)) args))
+	    :do (cl-locale.core::register-dictionary ',name dictionary
+						     :locale locale)))))
+
+(defmacro with-i18n ((dictionary locale) &body string-generate-form)
+  `(let ((cl-locale.core::*dictionary*
+	   (cl-locale.core::ensure-dictionary ',dictionary))
+	 (cl-locale.core::*locale* ,locale))
+     (cl-locale:i18n (progn ,@string-generate-form))))
+
+(defun accept-language ()
+  (and ningle:*request* (gethash "accept-langauge"
+				 (getf (lack.request:request-env
+					ningle:*request*) :headers))))
+
+(defun parse-accept-language (paremeter)
+  (mapcar #'car (sort (mapcar (lambda (param)
+				(ppcre:split ";q=" param))
+			      (ppcre:split #\, paremeter))
+		      #'> :key (lambda (x)
+				 (read-from-string (or (cadr x) "1"))))))
+
+(defun find-locale (locale)
+  (and cl-locale.core::*dictionary*
+       (gethash locale cl-locale.core::*dictionary*)))
+
+(defun find-acceptable-locale (locales)
+  (find-if #'find-locale locales))
+

src/model.lisp

@@ -1,63 +1,69 @@
-(in-package #:cl-user) ; Not sure if this needs to exist (Chapter 4)
-(defpackage #:rails-to-caveman.model
+(in-package #:cl-user)
+(defpackage rails-to-caveman.model
   (:use #:cl
 	#:rails-to-caveman.db
-	#:mito))
+	#:mito
+	#:local-time
+	#:ratify
+	#:ratify-types
+	#:cl-ppcre)
+  (:import-from #:ratify-types
+	        #:parse-string
+		)
+  (:export #:user
+	   #:validate-user
+	   #:seeds
+	   #:rebuild
+	   #:with-check-validate
+	   #:administrator
+	   #:email
+	   #:full-name
+	   #:id
+	   #:name
+	   #:sex))
 (in-package #:rails-to-caveman.model)
 
-;;; Defines the USER table class for the database.
-;;; Will be used by mito (an ORM).
-(defclass user ()
-  ((number
-    :col-type
-    :integer
-    :initarg
-    :number
-    :reader number-of)
+(defclass user()
+  ((number :col-type
+	   :integer
+	   :initarg
+	   :number
+	   :accessor number-of)
    (name :col-type (:varchar 64)
 	 :initarg
 	 :name
-	 :reader name-of)
-   (full-name :col-type
-	      (or (:varchar 128) :null)
-	      :initarg
-	      :full-name
-	      :reader full-name-of)
-   (email :col-type
-	  (or :null :text)
+	 :accessor name-of)
+   (full-name
+    :col-type (or (:varchar 128) :null)
+    :initarg
+    :full-name
+    :accessor full-name-of)
+   (email :col-type (or :null :text)
 	  :initarg
 	  :email
 	  :accessor email-of)
-   (birthday :col-type
-	     (or :null :date)
+   (birthday :col-type (or :null :date)
 	     :initarg
 	     :birthday
-	     :reader birthday-of)
+	     :accessor birthday-of)
    (sex :col-type
 	:integer
 	:initarg
 	:sex
-	:initform 1
-	:reader sex-of)
-
-   #| CHANGED :ACCESSOR VALUE FROM TUTORIAL (CHAPTER 4)
-   ===================================================
-   The Chapter 4 tutorial has the :accessor value set to
-   'administratorp'. Unfortunately, this causes initialisation
-   argument errors when trying to seed the database. To fix this, I
-   had to remove the 'p' part from that line. At the time of
-   writing, I do not know if that will have a negative effect on
-   future tutorials.
-
-   I have left a note in the 'seeds' function below highlighting the
-   change to the :accessor value.
-   |#
+	:initform "1" ; <--- This!
+	:accessor sex-of)
    (administrator :col-type
 		  :boolean
 		  :initarg
 		  :administrator
-		  :initform nil
-		  :accessor administrator))
+		  :initform "1" ; as NIL. ; <--- This!
+		  :accessor administrator-of)
+   (password :col-type
+	     :text
+	     :initarg
+	     :password
+	     :accessor password-of
+	     :inflate #'cl-pass:hash ))
   (:metaclass mito:dao-table-class))
 
 
@@ -88,7 +94,8 @@
 			 ;; seed the database (using 'seeds'
 			 ;; function. I have, also, left a note in the
 			 ;; 'user' class definition highlighting this.
-			 :administrator (zerop 0))))))
+			 :administrator (zerop 0)
+			 :password "asagao!")))))
 
 
 (defun rebuild ()
@@ -109,3 +116,239 @@ this tutorial was translated/ported from."
 ;; constants and refer to them instead of passing hard coded 1 & 0.
 (defconstant +false+ 0)
 (defconstant +true+  1)
+
+#| MACRO FOR VALIDATE-USER
+==========================
+At the time of writing, I have not got much experience writing
+macros. So, the code below does not make much sense to me. I was part
+of the tutorial in Chapter 7, though. So, I am not venturing off piste
+here.
+
+The reason for this macro is reduce the amount of code needed for the
+'validate-user' function. The tutorial provides two versions of the
+'validate-user' function (I.E. macro and macro-less). I have commented
+out the macro-less version of 'validate-user' and use the macro
+version. I did not delete it because I wanted to keep it as a
+reference for future projects. This is a learning project after all.
+|#
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun canonicalize-assertions(assertions)
+    (mapcar (lambda(assert)
+	      (etypecase(car assert)
+		(SYMBOL (cons (list (car assert)(car assert))
+			      (cdr assert)))
+		((CONS (AND SYMBOL (NOT (OR KEYWORD BOOLEAN)))
+		       (CONS (AND SYMBOL (NOT (OR KEYWORD BOOLEAN)))
+			     NULL))
+		 (assert(every (lambda(clause)
+				 (keywordp (car clause)))
+			       (cdr assert))) assert))) assertions))
+  (defun <initialize-slots>(var targets)
+    (alexandria:with-unique-names(slot name)
+      `(DOLIST(,slot (C2MOP:CLASS-SLOTS (CLASS-OF ,var)))
+	 (LET((,name(C2MOP:SLOT-DEFINITION-NAME ,slot)))
+	   (WHEN(OR (AND ,targets (FIND ,name ,targets)
+			 (SLOT-BOUNDP ,var ,name)
+			 (EQUAL "" (SLOT-VALUE ,var ,name)))
+		    (AND (SLOT-BOUNDP ,var ,name)
+			 (EQUAL "" (SLOT-VALUE ,var ,name))))
+	     (SLOT-MAKUNBOUND ,var ,name))))))
+  (defun <spec-pair>(clause g.obj g.alist)
+    (destructuring-bind((local-var slot-name)
+			. assertions)clause
+      `(CONS ',slot-name
+	     ,(<spec-function> assertions g.obj slot-name g.alist local-var
+			       (push-form-generator slot-name g.alist)))))
+  (defun parse-assertions(assertions)
+    (typecase (car assertions)
+      ((CONS (EQL :REQUIRE)
+	     (CONS (EQL T)NULL))
+       (values t (cdr assertions)))
+      ((CONS (EQL :REQUIRE)
+	     (CONS NULL NULL))
+       (values nil (cdr assertions)))
+      (T (values nil assertions))))
+  (defun push-form-generator(slot-name alist)
+    (lambda(message)
+      `(push (cons ',slot-name ,message) ,alist)))
+  (defun <spec-function>(assertions g.obj slot-name g.alist local-var generator)
+    (multiple-value-bind(requirep assertions)(parse-assertions assertions)
+      `(LAMBDA()
+	 (IF(SLOT-BOUNDP ,g.obj ',slot-name)
+	    ,(let((form(make-form assertions g.alist local-var g.obj slot-name)))
+	       (when form `(LET((,local-var (SLOT-VALUE ,g.obj ',slot-name)))
+			     ,form)))
+	    ,@(when requirep
+		(list (funcall generator "is required")))))))
+  (defun make-form(assertions g.alist local-var g.obj slot-name)
+    (if(endp assertions)
+       nil
+       (apply #'spec-diverge g.alist slot-name g.obj local-var
+	      (cdr assertions)(car assertions))))
+  (defun <type-spec-body>(local-var spec-value rest g.alist g.obj slot-name generator format-arguments)
+    `(IF(TYPEP ,local-var ',spec-value)
+	,(make-form rest g.alist local-var g.obj slot-name)
+	,(funcall generator
+		  (if format-arguments
+		      `(format nil ,@format-arguments)
+		      `(format nil "not type-of ~S" ',spec-value)))))
+  (defun <key-spec-body>(spec-value local-var g.obj slot-name rest g.alist generator format-arguments)
+    (let((v(gensym"CANONICALIZED"))
+	 (c(gensym"CONDITION")))
+      `(handler-case
+	   (let((,v (funcall ,spec-value ,local-var)))
+	     (setf (slot-value ,g.obj ',slot-name)
+		   ,v ,local-var ,v)
+	     ,(make-form rest g.alist local-var g.obj slot-name))
+	 (error(,c),(funcall generator
+			     (if format-arguments
+				 `(format nil ,@format-arguments)
+				 `(princ-to-string ,c)))))))
+  (defun <assert-spec-body>(spec-value rest g.alist local-var g.obj slot-name generator format-arguments)
+    `(if ,spec-value
+	 ,(make-form rest g.alist local-var g.obj slot-name)
+	 ,(funcall generator
+		   (if format-arguments
+		       `(format nil ,@format-arguments)
+		       `(format nil "must satisfies ~S but ~S"'
+				,spec-value ,local-var)))))
+  (defun <unique-spec-body>
+      (g.obj spec-value rest g.alist local-var slot-name generator format-arguments)
+    `(UNLESS(MITO:OBJECT-ID ,g.obj)
+       (IF(NULL(MITO:SELECT-DAO
+		   (CLASS-OF ,g.obj)
+		 (SXQL:WHERE
+		  ,spec-value)
+		 (SXQL:LIMIT 1)))
+	  ,(make-form rest g.alist local-var g.obj slot-name)
+	  ,(funcall generator
+		    (if format-arguments
+			`(format nil
+				 ,@format-arguments)
+			"already exists")))))
+  (defun spec-diverge
+      (g.alist slot-name g.obj local-var rest spec-key spec-value
+       &rest format-arguments)
+    (ecase spec-key
+      (:type (<type-spec-body> local-var spec-value rest g.alist g.obj slot-name
+			       (push-form-generator slot-name g.alist)
+			       format-arguments))
+      (:key (<key-spec-body> spec-value local-var g.obj slot-name rest g.alist
+			     (push-form-generator slot-name g.alist)
+			     format-arguments))
+      (:assert (<assert-spec-body> spec-value rest g.alist local-var g.obj slot-name
+				   (push-form-generator slot-name g.alist)
+				   format-arguments))
+      (:unique (<unique-spec-body> g.obj spec-value rest g.alist local-var slot-name
+				   (push-form-generator slot-name g.alist)
+				   format-arguments)))))
+
+
+(defmacro with-check-validate ((var) (&rest assertions))
+  ;; initialize
+  (check-type var symbol)
+  (setf assertions
+	(mapcar
+	 (lambda(assert)
+	   (etypecase(car assert)
+	     (symbol (cons (list (car assert) (car assert)) (cdr assert)))
+	     ((cons (and symbol (not (or keyword boolean)))
+		    (cons (and symbol (not (or keyword boolean))) null))
+	      (assert (every (lambda (clause) (keywordp (car clause)))
+			    (cdr assert))) assert)))
+	 assertions))
+  (let ((alist (gensym"ALIST"))
+       (slot (gensym "SLOT")) (name (gensym"NAME")))
+    ;; body
+    `(LET ((,alist))
+       (dolist (,slot (c2mop:class-slots (class-of ,var)))
+	 (let ((,name (c2mop:slot-definition-name ,slot)))
+	   (when (and (slot-boundp ,var ,name)
+		      (equal "" (slot-value ,var ,name)))
+	     (slot-makunbound ,var ,name))))
+       ,@(loop :for ((local-var slot-name) . assertions) :in assertions
+	       :collect (labels((rec(assertions)
+				  (if (endp assertions)
+				      nil
+				      (apply #'body (cdr assertions)(car assertions))))
+				(body (rest key value &rest format-arguments)
+				  (ecase key (:type `(if (typep ,local-var ',value)
+							 ,(rec rest)
+							 (push (cons ',slot-name
+								     ,(if format-arguments
+									  `(format nil
+										   ,@format-arguments)
+									  `(format nil
+										   "is not type-of ~S"'
+										   ,value)))
+							       ,alist)))
+					 (:key (let ((v(gensym"CANONICALIZED"))
+						     (c (gensym"CONDITION")))
+						 `(handler-case (let ((,v (funcall ,value ,local-var)))
+								  (setf (slot-value ,var ',slot-name)
+									,v
+									,local-var
+									,v)
+								  ,(rec rest))
+						    (error (,c) (push (cons ',slot-name (princ-to-string ,c))
+								      ,alist)))))
+					 (:assert `(if ,value ,(rec rest)
+						       (PUSH (CONS ',slot-name
+								   ,(if format-arguments
+									`(format nil ,@format-arguments)
+									`(FORMAT NIL "must satisfies ~S but ~S"
+										 ',value ,local-var)))
+							     ,alist)))
+					 (:unique `(unless(mito:object-id ,var)
+						     (if (null (mito:select-dao
+								   (class-of ,var)
+								 (sxql:where ,value)
+								 (sxql:limit 1)))
+							 ,(rec rest)
+							 (push
+							  (cons
+							   ',slot-name
+							   "is already exists")
+							  ,alist)))))))
+			  (if (equal '(:require t) (car assertions))
+			      `(if (slot-boundp ,var ',slot-name)
+				   (let ((,local-var
+					   (slot-value ,var ',slot-name)))
+				     ,(rec (cdr assertions)))
+				   (push (cons ',slot-name ,"is required") ,alist))
+			      (progn (when (equal '(:require nil)
+						  (car assertions))
+				       (pop assertions))
+				     `(if (slot-boundp ,var ',slot-name)
+					  (let ((,local-var(slot-value ,var ',slot-name)))
+					    ,(rec assertions)))))))
+       (values ,var (reverse ,alist)))))
+
+
+(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)))))))))

src/view.lisp

@@ -1,6 +1,7 @@
 (in-package #:cl-user)
-(defpackage rails-to-caveman.view
-  (:use #:cl)
+(defpackage #:rails-to-caveman.view
+  (:use #:cl
+	#:rails-to-caveman.locale)
   (:import-from #:rails-to-caveman.config
                 #:*template-directory*)
   (:import-from #:caveman2
@@ -44,7 +45,8 @@
                 #:config
                 #:appenv
                 #:developmentp
-                #:productionp)
+                #:productionp
+		#:rails-to-caveman.locale)
   (:import-from #:caveman2
                 #:url-for)
   (:export #:title!) ; Added in Chapter 3 (Mockup section).
@@ -52,6 +54,7 @@
 ;; in-package and let code added in Chapter 3, also. This is
 ;; preperation for Switching Layout Templates section.
 (in-package #:rails-to-caveman.djula) ; Make sure this states your app name.
+
 (let(title)
   (defun title! (&optional sub)
     (if sub
@@ -68,3 +71,10 @@
 ;;; project's TODOs. This filter is used in 'step13.html' (in
 ;;; /templates directory).
 (djula::def-filter :break(it) (cl-ppcre:regex-replace-all #\newline it "<br />"))
+
+(djula::def-filter :i18n(it)
+  (rails-to-caveman.locale::with-i18n
+      (rails-to-caveman.locale::rails-to-caveman
+       (rails-to-caveman.locale::find-acceptable-locale
+	(rails-to-caveman.locale::parse-accept-language
+	 (rails-to-caveman.locale::accept-language)))) it))

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
@@ -32,7 +32,9 @@
 	  ;; to leave the code commented out.
 
 	  ;; '(:message "This is not a message") ; Added Chapter 3.
-	  '(:numbers (1 2 3 4 5))
+	  `(:numbers (1 2 3 4 5)
+	    :token ,(token))
+	  ;; :alert "Bitchin")
 	  ))
 
 (defroute "/users/index"()
@@ -42,7 +44,7 @@
 			(sxql:order-by :number)))
 	    :token ,(token)
 	    :notice (flash-gethash
-		      :notice ningle:*request*))))
+		     :notice ningle:*request*))))
 
 (defroute "/users/search" (&key |q|)
   (render "users/index.html"
@@ -72,9 +74,14 @@
 
 (defroute "/user/new" ()
   (render #P"users/new.html"
-	  `(:users ,(with-connection (db)
-		      (make-instance 'rails-to-caveman.model::user))
-	    :token ,(token))))
+	  `(:user ,(current-user)
+	    :new-user ,(with-connection (db)
+			 (rails-to-caveman.model::validate-user
+			 (make-instance 'rails-to-caveman.model::user)))
+	    :news (1 2 3 4 5)
+	    :blogs (1 2 3 4 5)
+		  ,@(roles)
+		  :token ,(token))))
 
 (defroute "/users/:id/edit" (&key id)
   (let* ((id (ignore-errors (parse-integer id)))
@@ -82,102 +89,157 @@
 		 (and id
 		      (mito:find-dao 'rails-to-caveman.model::user
 				     :id id)))))
-    (if user (render "users/edit.html"
+    (if user (render "accounts/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))))))))
-
+(&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))))))))
+|#
+
+#| ROUTE/FUNCTION KEPT FOR REFERENCE (MACRO-LESS VERSION)
+=========================================================
+(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))))))))
+|#
+
+;;; Macro-based version of route (validate-user).
 (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))))))))
+    (&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*)))
+	(t `(400 (:content-type "text/plain")
+		 (,(format nil "Unknown method ~S" method))))))
+
+(defroute put-user ("/user" :method :put)
+  (&rest args
+	 &key
+	 authenticity-token
+	 birthday-year
+	 birthday-month
+	 birthday-day
+	 number
+	 name
+	 full-name
+	 email
+	 administrator)
+  (declare (ignore number
+		   name
+		   full-name
+		   email
+		   administrator))
+  (if (not (string= authenticity-token (token)))
+      `(403 (:content-type "text/plain") "Denied")
+      (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)
+		  :allow-other-keys t args))
+	(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))))))))))
 
 (defroute delete-user ("/users/:id" :method :delete)
-    (&key |authenticity-token| id)
+  (&key |authenticity-token| id)
   (if (not (string= |authenticity-token| (token)))
       `(403 (:content-type "text/plain") ("Denied"))
       (with-connection (db)
@@ -194,67 +256,226 @@
 		     (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 ("/user/:id" :method :post)
+    (&key id method)
+  (cond ((string= method "delete")
+	 (delete-user
+	  (acons "ID" id
+		 (lack.request:request-body-parameters ningle:*request*))))
+	((find method '("" "post" nil) :test #'equal)
+	 (post-user (acons "id"
+			   id
+			   (lack.request:request-body-parameters ningle:*request*))))
+	(t `(400 (:content-type "text/plain")
+		 (,(format nil "Unsupported method ~S" method))))))
+
+;;; YOU ARE UP TO HERE:
+;;; CAN'T GET THE VALIDATION TO WORK WHEN CREATING A NEW ACCOUNT.
+(defun post-user(request)
+  (format t "[INFO] You have reached post-user request")
+  (destructuring-bind
+      (&key
+	 authenticity-token
+	 id
+	 number
+	 name
+	 full-name
+	 sex
+	 birthday-year
+	 birthday-month
+	 birthday-day
+	 email
+	 administrator
+       &allow-other-keys)
+      (with-connection (db)
+	(loop :for (key . value)
+		:in request
+	      :collect (let((*package*(find-package :keyword)))
+			 (read-from-string key))
+	      :collect value)
+	(if (not (string= authenticity-token (token)))
+	    `(403 () ("Denied"))
+	    (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")
+			("Could not edit exists user."))
+		  (progn (setf (rails-to-caveman.model::number-of user) number
+			       (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) sex
+			       (rails-to-caveman.model::birthday-of user) "2021-12-21"
+			       ;; (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) administrator)
+			 (multiple-value-bind (user errors)
+			     (rails-to-caveman.model::validate-user user))
+			 (if errors
+			     `(400 ()(,(render "user/edit.html"
+					       `(:user ,user
+						 :errors ,errors
+						 :token ,(token)))))
+			     (progn (mito:save-dao user)
+				    (setf (gethash :notice ningle:*session*)"Updated")
+				    `(303 (:location
+					   ,(format nil "/user/~D" id))))))))))))
+
+(defroute "/account" ()
+  (if (not (hermetic:logged-in-p))
+      '(401 ())
+      (render "users/show.html"
+	      `(:user ,(current-user)
+		:news (1 2 3 4 5)
+		:blogs (1 2 3 4 5) ,@(roles)
+		:token ,(token)))))
+
+
+(defroute "/account/new"() )
+
+(defroute "/account/edit" ()
+  (if (not (hermetic:logged-in-p))
+      '(401 ())
+      (render "accounts/edit.html"
+	      `(:token ,(token)
+		:user ,(current-user)
+		:news (1 2 3 4 5)
+		:blogs (1 2 3 4 5)
+		,@(roles)))))
+
+(defroute("/account" :method :post)
+    (&key number
+	  name
+	  full-name
+	  sex
+	  birthday-year
+	  birthday-month
+	  birthday-day
+	  email
+	  (administrator "1")
+	  authenticity-token)
+  (if (not (string= authenticity-token (token)))
+      '(403 (:content-type "text/plain") ("Denied"))
+      (if (not (hermetic:logged-in-p))
+	  '(401 ())
+	  (let* ((user (current-user)))
+	    (setf (rails-to-caveman.model::number-of user) number
+		  (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) sex
+		  (rails-to-caveman.model::birthday-of user)
+		  (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) administrator
+		  (rails-to-caveman.model::password-of user)
+		  (gethash :password ningle:*session*))
+	    (multiple-value-bind (user errors)
+		(rails-to-caveman.model::validate-user user)
+	      (if errors
+		  `(400 ()
+			(,(render "accounts/edit.html"
+				  `(:user ,user
+				    :errors ,errors
+				    :news (1 2 3 4 5)
+				    :blogs (1 2 3 4 5)
+				    ,@(roles)
+				    :token ,(token)))))
+		  (progn (with-connection (db)
+			   (mito:save-dao user)
+			   (setf (gethash :notice ningle:*session*)
+				 "Updated")
+			   '(303 (:location "/account"))))))))))
+
+(defroute("/account" :method :put)() )
+(defroute("/account" :method :delete)() )
+
+(defroute "/password" () ; as show
+  (if (not (hermetic:logged-in-p))
+      '(401 ())
+      '(303 (:location "/account"))))
+
+(defroute "/password/edit" ()
+  (if (not (hermetic:logged-in-p))
+      '(401 ())
+      (render "passwords/edit.html"
+	      `(:token ,(token)))))
+
+(defroute ("/password" :method :post) (&key old new confirmation authenticity-token)
+  (if (not (hermetic:logged-in-p))
+      '(403 (:content-type "text/plain")("Denied"))
+      (let*((user(current-user))
+	    (render-args `(:user ,user :token ,(token)
+			   :news (1 2 3 4 5)
+			   :blogs (1 2 3 4 5))))
+	(if (not (string= authenticity-token(token)))
+	    `(403 (:content-type "text/plain") ("Denied"))
+	    (if (equal "" old)
+		(render "password/edit.html"
+			(list* :errors '((current-password . "is required"))
+			       render-args))
+		(if (not
+		     (cl-pass:check-password old (rails-to-caveman.model::password-of user)))
+		    (render "passwords/edit.html"
+			    (list* :errors '((password . "is not correct")) render-args))
+		    (if (not (equal new confirmation))
+			(render "passwords/edit.html"
+				(list* :errors '((confirmation . "is failed"))
+				       render-args))
+			(progn (setf (rails-to-caveman.model::password-of user) new)
+			       (multiple-value-bind (user errors)
+				   (rails-to-caveman.model::validate-user user
+									  'rails-to-caveman.model::password)
+				 (if errors
+				     (render "passwords/edit.html"
+					     (list* :errors errors render-args))
+				     (progn (mito:save-dao user)
+					    (setf (gethash :notice ningle:*session*) "Password is changed")
+					    '(303 (:location "/account")))))))))))))
+
+(defroute ("/session" :method :post) (&key method)
+  (cond ((string= "delete" method)
+	 (logout (lack.request:request-body-parameters ningle:*request*)))
+	((string= "post" method)
+	 (post-session (lack.request:request-body-parameters ningle:*request*)))
+	(t `(400 (:content-type "text/plain")
+		 (,(format nil "Unknown method ~S" method))))))
+
+(defun post-session (request)
+  (destructuring-bind
+      (&key name password authenticity-token &allow-other-keys)
+      (request-params request)
+    (if (not (string= authenticity-token (token)))
+	`(403 (:content-type "text/plain") ("Denied"))
+	(let ((params (list :|username| name
+			    :|password| password)))
+	  (format t "You look like you have logged in")
+	  (hermetic:login params
+			  (progn (with-connection (db)
+				   (setf
+				    (gethash :id ningle:*session*) (mito:object-id
+								    (mito:find-dao
+								     'rails-to-caveman.model::user
+								     :name name))
+				    (gethash :password ningle:*session*) password))
+				 '(303 (:location "/")))
+			  (progn (setf (gethash :alert ningle:*session*) "Name and password don't match.")
+				 '(303 (:location "/")))
+			  (progn (setf (gethash :alert ningle:*session*) "No such user")
+				 '(303 (:location "/"))))))))
+
+(defroute logout ("/session" :method :delete) (&key authenticity-token)
+  (if (not (string= authenticity-token (token)))
+      `(403 (:content-type "text/plain") ("Denied"))
+      (hermetic::logout (progn (flash-gethash :id ningle:*session*)
+			       '(303 (:location "/")))
+			'(303 (:location "/")))))
+
 
 (defroute "/about" ()
   ;; about.html should be in the /templates directory.
@@ -410,6 +631,7 @@
   (let ((value (gethash key table)))
     (remhash key table)
     value))
+
 ;;
 ;; Error pages
 
@@ -417,3 +639,37 @@
   (declare (ignore app))
   (merge-pathnames #P"_errors/404.html"
                    *template-directory*))
+
+(hermetic:setup :user-p (lambda (name)
+			  (with-connection (db)
+			    (mito:find-dao
+			     'rails-to-caveman.model::user :name name)))
+		:user-pass (lambda (name)
+			     (rails-to-caveman.model::password-of
+			      (with-connection (db)
+				(mito:find-dao 'rails-to-caveman.model::user :name name))))
+		:user-roles (lambda (name)
+			      (cons :logged-in
+				    (let ((user (with-connection (db)
+						  (mito:find-dao 'rails-to-caveman.model::user :name name))))
+				      (and user (rails-to-caveman.model::administrator-of user)
+					   '(:administrator)))))
+		:session ningle:*session*
+		:denied (constantly '(400 (:content-type "text/plain") ("Authenticate denied"))))
+
+(defun request-params (request)
+  (loop :for (key . value) :in request
+	:collect (let ((*package* (find-package :keyword)))
+		   (read-from-string key))
+	:collect value))
+
+(defun roles()
+  (loop :for role :in (hermetic:roles)
+	:collect role
+	:collect t))
+
+(defun current-user ()
+  (with-connection (db)
+    (mito:find-dao
+     'rails-to-caveman.model::user
+     :id (gethash :id ningle:*session*))))

static/locale/ja-jp.lisp

@@ -0,0 +1,12 @@
+(("hello" . "(=ﾟωﾟ)ﾉぃょぅ")
+ ("Number" . "背番号")
+ ("Name" . "ユーザー名")
+ ("Full Name" . "氏名")
+ ("Sex" . "性別")
+ ("Male" . "男")
+ ("Female" . "女")
+ ("Birthday" . "誕生日")
+ ("Email" . "メールアドレス")
+ ("Administrator" . "管理者")
+ ("Create user" . "登録する")
+ ("is required" . "を入力してください。"))

templates/accounts/edit.html

@@ -0,0 +1,20 @@
+{% extends "layouts/app.html" %}
+{% block title %}
+{% lisp (title! "Edit account info") %}
+{% endblock %}
+
+{% block content %}
+<h1>{% lisp (title!) %}</h1>
+
+<div class="toolbar">
+        <a href="/account">Go back my account</a>
+</div>
+
+<form class="edit_account" id="edit_account" action="/account" method="post">
+        <input type="hidden" name="METHOD" value="post">
+        <input type="hidden" name="AUTHENTICITY-TOKEN" value="{{token}}">
+	{% include "users/form.html" %}
+        {% include "shared/user_form.html" %}
+        <div><input type="submit" name="commit" value="Update"></div>
+</form>
+{% endblock %}

templates/accounts/show.html

@@ -0,0 +1,15 @@
+{% extends "layouts/app.html" %}
+{% block title %}
+{% lisp (title! "My account") %}
+{% endblock %}
+
+{% block content %}
+<h1>{% lisp (title!) %}</h1>
+
+<ul class="toolbar">
+  <a href="/account/edit">Edit account info</a>
+  <a href="password/edit">Change password</a>
+</ul>
+
+{% include "user/body.html" %}
+{% endblock %}

templates/index.html

@@ -20,9 +20,12 @@
     no guarantee it will contain anything n it, though.
   -->
 <h2>{{ message }}</h2>
-
 {% for b in numbers %}
 <li><a href="#">Blog Header</a></li>
 {% endfor %}
+
+{% if alert %}
+<p class="alert">{{alert}}</p>
+{% endif %}
   
 {% endblock %}

templates/layouts/app.html

@@ -17,9 +17,10 @@
         {% block content %}{% endblock %}
       </main>
       <aside id="sidebar">
-        {% lisp (rails-to-caveman.view:render "shared/sidebar.html"
-        '(:news (1 2 3 4 5)
-          :blogs (1 2 3 4 5))) %}
+        <!-- {REMOVE% lisp (rails-to-caveman.view:render "shared/sidebar.html" -->
+        <!-- '(:news (1 2 3 4 5) -->
+        <!-- :blogs (1 2 3 4 5))) %} -->
+	{% include "shared/sidebar.html" %}
       </aside>
       <footer>
         {% include "shared/footer.html" %}

templates/passwords/edit.html

@@ -0,0 +1,34 @@
+{% extends "layouts/app.html" %}
+{% block title %}
+{% lisp (title! "Change password") %}
+{% endblock %}
+
+{% block content %}
+<h1>{% lisp (title!) %}</h1>
+
+<div class="toolbar">
+        <a href="/account">Go back my accout</a>
+</div>
+
+<form action="/password" method="post">
+        <input type="hidden" name="AUTHENTICITY-TOKEN" value="{{token}}">
+        {% include "shared/errors.html" %}
+
+        <table class="attr">
+                <tr>
+                        <th><label for="accout-current-password">Current password</label></th>
+                        <td><input type="password" name="OLD" id="account-current-password" /></td>
+                </tr>
+                <tr>
+                        <th><label for="accout-password">Password</label></th>
+                        <td><input type="password" name="NEW" id="account-password" /></td>
+                </tr>
+                <tr>
+                        <th><label for="password-confirmation">Password confirmation</label></th>
+                        <td><input type="password" name="CONFIRMATION" id="password-confirmation" /></td>
+                </tr>
+        </table>
+
+        <div><input type="submit" name="commit" value="Update" /></div>
+</form>
+{% endblock %}

templates/shared/errors.html

@@ -0,0 +1,10 @@
+{%if errors %}
+<div id="errors">
+  <h3>Errors</h3>
+  <ul>
+    {% for (slot . message) in errors %}
+    <li>{{slot|capfirst|lisp: (lambda (s) (substitute #\space #\- s))|i18n}} {{message|i18n}}</li>
+    {% endfor %}
+  </ul>
+{% endif %}
+  

templates/shared/header.html

@@ -1,11 +1,27 @@
 <img src="images/lisplogo.svg" width="200" alt="Your app">
 
 <nav class="menubar">
-        <ul>
-                <li><a href="/">Home</a></li>
-                <li><a href="#">News</a></li>
-                <li><a href="#">Blog</a></li>
-                <li><a href="/users/index">Members</a></li>
-                <li><a href="#">Settings</a></li>
-        </ul>
+  <ul>
+    <li><a href="/">Home</a></li>
+    <li><a href="#">News</a></li>
+    <li><a href="#">Blog</a></li>
+    <li><a href="/account">{{user.name}}-San</a></li>
+    <li><a href="/users/index">Members</a></li>
+    {% if logged-in %}
+    <li><a href="#">Settings</a></li>
+    {% endif %}
+  </ul>
 </nav>
+
+{% if logged-in %}
+<ul class="account-menu">
+  <li>
+    <form id="logout-form" action="/session" method="post">
+      <input type="hidden" name="AUTHENTICITY-TOKEN" value="{{token}}">
+      <input type="hidden" name="METHOD" value="delete">
+      <input type="submit" value="Logout">
+    </form>
+  </li>
+</ul>
+{% endif %}
+

templates/shared/login_form.html

@@ -1,14 +1,19 @@
 <h2>Login</h2>
-<form id="login_form">
-    <div>
-        <label>user name:</label>
-        <input type="text">
-    </div>
-    <div>
-        <label>password:</label>
-        <input type="password">
-    </div>
-    <div>
-        <input type="submit" value="Login">
-    </div>
+{% if alert %}
+<p class="alert">{{alert}}</p>
+{% endif %}
+<form id="login_form" action="/session" method="post">
+        <input type="hidden" name="AUTHENTICITY-TOKEN" value="{{token}}">
+        <input type="hidden" name="METHOD" value="post">
+        <div>
+                <label>user name:</label>
+                <input type="text" name="NAME">
+        </div>
+        <div>
+                <label>password:</label>
+                <input type="password" name="PASSWORD">
+        </div>
+        <div>
+                <input type="submit" value="Login">
+        </div>
 </form>

templates/shared/sidebar.html

@@ -1,4 +1,6 @@
+{% if not logged-in %}
 {% include "shared/login_form.html" %}
+{% endif %}
 <h2>Latest News</h2>
 <ul>
   {% for n in news %}

templates/shared/user_form.html

@@ -0,0 +1,18 @@
+{% if user.id %}
+<tr>
+  <th><label for="password">Password</label></th>
+  <td><input id="password" type="text" name="PASSWORD" /></td>
+</tr>
+{% endif %}
+
+{% if administrator %}
+<tr>
+  <th>{%filter i18n %}Administrator{% endfilter %}</th>
+  <td>
+    <input name="ADMINISTRATOR" type="hidden" value="0"/>
+    <input type="checkbox" value="1" name="administrator" id="user-administrator"/>
+  </td>
+</tr>
+{% endif %}
+</table>
+

templates/users/body.html

@@ -0,0 +1,46 @@
+<table class="attr">
+        <tr>
+                <th width="150">Number</th>
+                <td>{{user.number}}</td>
+        </tr>
+        <tr>
+                <th>Name</th>
+                <td>{{user.name}}</td>
+        </tr>
+        <tr>
+                <th>Full name</th>
+                <td>{{user.full-name}}</td>
+        </tr>
+        <tr>
+                <th>Sex</th>
+                <td>
+                        {% ifequal user.sex 1 %}
+                        Male
+                        {% else %}
+                        Female
+                        {% endifequal %}
+                </td>
+        </tr>
+        <tr>
+                <th>Birthday</th>
+                <td>
+                        {{ user.birthday|
+                        lisp: local-time:timestamp-to-universal|
+                        date: ((:year 4)"/"(:month 2)"/"(:day 2)) }}
+                </td>
+        </tr>
+        <tr>
+                <th>Mail adress</th>
+                <td>{{user.email}}</td>
+        </tr>
+        <tr>
+                <th>administrator</th>
+                <td>
+                        {% if user.administrator %}
+                        Yes
+                        {% else %}
+                        No
+                        {% endif %}
+                </td>
+        </tr>
+</table>

templates/users/edit.html

@@ -14,11 +14,11 @@
       action="/user/{{user.id}}" method="post">
   <input name="_method" type="hidden" value="patch"/>
   <input name="authenticity-token" type="hidden" value="{{token}}"/>
-
   {% include "users/form.html" %}
+  {% include "users/user_form.html" %}
   
   <div>
-    <input type="submit" name="commit" value="edit user"/>
+    <input type="submit" name="COMMIT" value="Edit user"/>
   </div>
   
 </form>

templates/users/form.html

@@ -1,52 +1,30 @@
+{% include "shared/errors.html" %}
 <table class="attr">
   <tr>
-    <th><label for="user-number">Number</label></th>
-    <td><input size="8" type="text" name="number"
-	       value="{{user.number}}" id="user-number"/></td>
+    <th><label for="user-number">{% filter i18n %}Number{% endfilter %}</label></th>
+    <td><input size="8" type="text" name="NUMBER" value="{{user.number}}" id="user-number" /></td>
   </tr>
   <tr>
-    <th><label for="user-name">Name</label></th>
-    <td><input type="text" name="name"
-	       value="{{user.name}}"
-	       id="user-name"/></td>
+    <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="user-full-name">Full Name</label></th>
-    <td><input type="text" value="{{user.full-name}}"
-	       name="full-name" id="user-full-name"/></td>
+    <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>
   </tr>
   <tr>
-    <th>Sex</th>
+    <th>{% filter i18n %}Sex{% endfilter %}</th>
     <td>
-      <input type="radio" value="1"
-	     {% ifequal user.sex 1 %}checked="checked"{% endifequal %}
-	     name="sex" id="member-sex-1"/>
-      <label for="member-sex-1">Male</label>
-      <input type="radio" value="2"
-	     {% ifequal user.sex 2 %}checked="checked"{% endifequal %}
-	     name="sex" id="member-sex-2"/>
-      <label for="member-sex-2">Female</label>
+      <input type="radio" value="1" {%ifequal user.sex 1%}checked="checked"{%endifequal%} name="SEX" id="member-sex-1" />
+      <label for="member-sex-1">{% filter i18n %}Male{% endfilter %}</label>
+      <input type="radio" value="2" {%ifequal user.sex 2%}checked="checked"{%endifequal%} name="SEX" id="member-sex-2" />
+      <label for="member-sex-1">{% filter i18n %}Female{% endfilter %}</label>
     </td>
   </tr>
-  
   <tr>
-    <th><label for="user-email">Email</label></th>
-    <td><input type="text" name="email" id="user-email"/></td>
-  </tr>
-  <tr>
-    <th>Administration</th>
-    <td>
-      <input name="administrator" type="hidden" value="0"/>
-      <input type="checkbox" value="1" name="administrator" id="user-administrator"/>
-      <label for="user-administrator">Administrator</label>
-    </td>
-  </tr>
-
-  <tr>
-    <th><label for="user-birthday">Birthday</label></th>
-    <td>
-      <select id="member-birthday-li" name="birthday-year">
-	{{ user.birthday
+    <th><label for="user-birthday">{% filter i18n %}Birthday{% endfilter %}</label></th>
+    <td><select id="member-birthday-li" name="BIRTHDAY-YEAR">
+        {{ user.birthday
         | lisp: (lambda(timestamp)
         (let((current-year(local-time:timestamp-year(local-time:now))))
         (loop :for i :upfrom 1940 :to current-year
@@ -60,7 +38,7 @@
         | safe
         }}
       </select>
-<select id="member-birthday-2i" name="birthday-month">
+      <select id="member-birthday-2i" name="BIRTHDAY-MONTH">
         {{ user.birthday
         | lisp: (lambda(timestamp)
         (loop :for i :upfrom 1 to 12
@@ -75,7 +53,7 @@
         | safe
         }}
       </select>
-      <select id="birthday-3i" name="birthday-day">
+      <select id="birthday-3i" name="BIRTHDAY-DAY">
         {{ user.birthday
         | lisp: (lambda(timestamp)
         (loop :for i :upfrom 1 to 31
@@ -91,6 +69,7 @@
       </select>
     </td>
   </tr>
-
-  
-</table>
+  <tr>
+    <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>

templates/users/index.html

@@ -26,7 +26,7 @@
                         <td>{{user.full-name}}</td>
 			<td>
 			  <a href="/users/{{user.id}}/edit">Edit</a> |
-			  <form action="/users/{{user.id}}" method="post">
+			  <form action="/account/{{user.id}}" method="post">
 			    <input type="hidden" name="_method" value="delete">
 			    <input type="hidden" name="authenticity-token" value="{{token}}">
 			    <input type="submit" value="Delete {{user.id}}">

templates/users/new.html

@@ -5,17 +5,18 @@
 
 {% block content %}
 <h1>{% lisp (title!) %}</h1>
-<p>{{token}}</p>
+<p>{{user}}</p>
 <form class="new-user" id="new-user" action="/user" method="post">
-  <input name="authenticity-token" type="hidden" value="{{token}}" />
-  {% include "users/form.html" %}
-        <div>
-                <input type="submit" name="commit" value="create user" />
-        </div>
+  <!-- Method and Authenticity-token need to be in capitals -->
+  <input name="AUTHENTICITY-TOKEN" type="hidden" value="{{token}}"/>
+  <input name="METHOD" type="hidden" value="put" />
+  {{ new-user
+  | lisp: (lambda (user)
+  (rails-to-caveman.view::render "users/form.html" `(:user ,user)))
+  | safe
+  }} 
+  <div>
+    <input type="submit" name="COMMIT" VALUE="{% filter i18n %}Create user{% endfilter %}" />
+  </div>
 </form>
 {% endblock %}
-
-{% extends "layouts/app.html" %}
-{% block title %}
-{% lisp (title! "New member") %}
-{% endblock %}

templates/users/show.html

@@ -3,52 +3,10 @@
 {% block content %}
 <h1>{% lisp (title!) %}</h1>
 
-<div class="toolbar"><a href="/users/{{user.id}}/edit">Edit</a></div>
+<ul class="toolbar">
+  <a href="account/edit">Edit Account Info</a>
+  <a href="password/edit">Change Password</a>
+</ul>
 
-<table class="attr">
-        <tr>
-                <th width="150">Number</th>
-                <td>{{user.number}}</td>
-        </tr>
-        <tr>
-                <th>Name</th>
-                <td>{{user.name}}</td>
-        </tr>
-        <tr>
-                <th>Full name</th>
-                <td>{{user.full-name}}</td>
-        </tr>
-        <tr>
-                <th>Sex</th>
-                <td>
-                        {% ifequal user.sex 1 %}
-                        Male
-                        {% else %}
-                        Female
-                        {% endifequal %}
-                </td>
-        </tr>
-        <tr>
-                <th>Birthday</th>
-                <td>
-                        {{ user.birthday|
-                        lisp: local-time:timestamp-to-universal|
-                        date: ((:year 4)"/"(:month 2)"/"(:day 2)) }}
-                </td>
-        </tr>
-        <tr>
-                <th>Mail adress</th>
-                <td>{{user.email}}</td>
-        </tr>
-        <tr>
-                <th>administrator</th>
-                <td>
-                        {% if user.administrator %}
-                        Yes
-                        {% else %}
-                        No
-                        {% endif %}
-                </td>
-        </tr>
-</table>
+{% include "users/body.html" %}
 {% endblock %}