;; (in-package #:cl-user)
(defpackage #:rails-to-caveman.web
  (:use #:cl
	#:caveman2
        #:rails-to-caveman.config
	#:rails-to-caveman.view
	#:rails-to-caveman.model
        #:sxql
	#:mito
	#:cl-who)
  (:import-from #:rails-to-caveman.db
		#:connection-settings
		#:db
		#:with-connection)
  (:export #:*web*))
(in-package #:rails-to-caveman.web)

;; for @route annotation
(syntax:use-syntax :annot)

;;
;; Application

(defclass <web> (<app>) ())
(defvar *web* (make-instance '<web>))
(clear-routing-rules *web*)

;;
;; Routing rules

(defroute "/" ()
  "Top page"
  (let ((articless (articles-make 5)))
    (format t "[INFO] ~a" articless)
    (render #P"index.html" `(:notice ,(flash-gethash :notice ningle:*session*)
                             :user,(when (hermetic:logged-in-p)
                                     (current-user))
                             ,@(roles)
                             :token ,(token)
                             :alert ,(flash-gethash :alert ningle:*session*)
                             ;; :news ,articles
                             :blogs (1 2 3 4 5)
                             :articles ,articless))))

(defroute "/users/index"()
  (render "users/index.html"
	  `(:users ,(with-connection (db)
		      (mito:select-dao 'rails-to-caveman.model::user
			(sxql:order-by :number)))
	    :token ,(token)
	    :notice (flash-gethash
		     :notice ningle:*request*))))

(defroute "/users/search" (&key |q|)
  (render "users/index.html"
	  `(:users ,(with-connection (db)
		      (mito:select-dao 'rails-to-caveman.model::user
			(sxql:where
			 `(:or (:like :name ,|q|)
			       (:like :full-name ,|q|)))
			(sxql:order-by :number))))))

(defroute "/users/:id" (&key 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"
	  `(: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)))
	 (user (with-connection (db) ; NOTE `USER' AND NOT USERS.
		 (and id
		      (mito:find-dao 'rails-to-caveman.model::user
				     :id id)))))
    (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))))))))
|#

#| 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 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)
  (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 ("/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 ("/entries" :method :post) (&key method)
  (cond ((string= "put" method)
	 (create-entry (lack.request:request-body-parameters
			ningle:*request*)))
	(t `(401 () (,(format nil "Unknown method ~S" method))))))

(defroute entries-index "/entries" (&key id)
  (with-connection (db)
    (let ((author (when id (mito:find-dao
			    'rails-to-caveman.model::user :id id))))
      (format t "[INFO] ~A" author)
      (render "entries/index.html"
	      `(:member ,author
		:user ,(current-user)
		:news ,(articles-make 5)
		:blogs ,(entries :limit 5)
		:articles ,(articles-make 5)
		:entries ,(entries :author author)
		,@(roles)
		:token ,(token)
		;; :member ,(rails-to-caveman.model::author-of entry))))))
		)))))

(defroute show-entry "/entries/:id" (&key id)
  (if (null (ignore-errors (parse-integer id)))
      (myway:next-route)
      (with-connection (db)
      (let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id id))
	    (entries (entries :limit 5)))
	(render "entries/show.html"
		`(,@(roles)
		  :entry ,entry
		  :token ,(token)
		  :user ,(current-user)
		  :entries ,entries
		  :blogs ,entries
		  :news ,(articles 5)
		  :member ,(rails-to-caveman.model::author-of entry)))))))

(defroute create-entry ("/entries" :method :post) ; :post was :put
  (&key authenticity-token)
  (step
  (if (not (string= authenticity-token (token)))
      '(401 () ("Denied"))
      (with-connection (db)
	(multiple-value-bind (entry errors)
	    (rails-to-caveman.model::validate-entry
	     (apply #'make-instance 'rails-to-caveman.model::entry
		    :user (current-user)
		    (request-params
		     (lack.request:request-body-parameters
		      ningle:*request*))))
	  (if errors (render "entries/new.html"
			     `(,@(roles)
			       :entry ,entry
			       :token ,(token)
			       :errors ,errors
			       :user ,(current-user)
			       :blogs ,(entries :limit 5)
			       :news ,(articles 5)))
	      (progn (mito:save-dao entry)
		     (setf (gethash :notice ningle:*session*)
			   "Stored")
		     `(303 (:location
			    ,(format nil "/entries/~D"
				     (mito:object-id entry)))))))))))

(defroute ("/entries/:id" :method :post) (&key method id)
  (step
  (cond ((string= "post" method)
	 (update-entry (acons "ID" id
			      (lack.request:request-body-parameters
			       ningle:*request*))))
	((string= "delete" method)
	 (destroy-entry (acons "ID" id
			       (lack.request:request-body-parameters
				ningle:*request*))))
	(t `(401 () (,(format nil "Unknown method ~S" method)))))))

(defun update-entry (request)
  (destructuring-bind (&key
			 authenticity-token
			 id
			 title
			 body
			 posted-year
			 posted-month
			 posted-day
			 posted-hour
			 posted-min
		       &allow-other-keys)
      (request-params request)
    (if (not (string= authenticity-token(token)))
	'(401 ()("Denied"))
	(if (null (ignore-errors (parse-integer id)))
	    (myway:next-route)
	    (with-connection (db)
	    (let ((entry (mito:find-dao
			  'rails-to-caveman.model::entry :id id)))
	      (setf (rails-to-caveman.model::title-of entry) title
		    (rails-to-caveman.model::body-of entry) body
		    (rails-to-caveman.model::date-posted-of entry)
		    (format nil "~A-~A-~AT~A:~A:00"
			    posted-year
			    posted-month
			    posted-day
			    posted-hour
			    posted-min))
	      (multiple-value-bind (entry errors)
		  (rails-to-caveman.model::validate-entry entry)
		(if errors (render "entries/edit.html"
				   `(,@(roles)
				     :member ,(rails-to-caveman.model::author-of entry)
				     :user ,(current-user)
				     :token ,(token)
				     :entry ,entry
				     :news ,(articles 5)
				     :blogs ,(entries :limit 5)
				     :errors ,errors ))
		    (progn (mito:save-dao entry)
			   (setf (gethash :notice ningle:*session*) "Updated")
			   `(303 (:location
				  ,(format nil "/entries/~D"
					   (mito:object-id entry)))))))))))))

(defroute "/entries/new" (&key)
  (step
   (render "entries/new.html"
	   `(,@(roles)
	       :token ,(token)
	       :entry ,(make-instance 'rails-to-caveman.model::entry
				      :date-posted
				      (local-time:now))
	       :user ,(current-user)
	       :blogs ,(entries :limit 5)
	       :news ,(articles 5)))))

(defroute "/entries/:id/edit" (&key id)
  (if (null (ignore-errors (parse-integer id)))
      (myway:next-route)
      (render "entries/edit.html"
	      `(,@(roles)
		:entry ,(with-connection (db)
			  (mito:find-dao 'rails-to-caveman.model::entry :id id))
		:user ,(current-user)
		:blogs ,(entries :limit 5)
		:news ,(articles 5)))))

(defroute destroy-entry ("/entries/:id" :method :delete)
  (&key authenticity-token id)
  (if (not (string= authenticity-token (token)))
      '(401 () ("Denied"))
      (with-connection (db)
      (if (null (ignore-errors (parse-integer id)))
	  (myway:next-route)
	  (let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id id)))
	    (if (null entry)
		`(401 () (,(format nil "Entry id ~A is not exist" id)))
		(progn (mito:delete-dao entry)
		       (setf (gethash :notice ningle:*session*) "Deleted")
		       `(303 (:location
			      ,(format nil "/user/~D/entries"
				       (mito:object-id (current-user))))))))))))

(defroute "/user/:id/entries" (&key id)
  (entries-index (acons "ID" id
			(lack.request:request-body-parameters
			 ningle:*request*))))

(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 "/articles" ()  
  (render "articles/index.html"
	  `(:user ,(current-user)
	    :news ,(articles-make 5)
	    :blogs (1 2 3 4 5)
	    :token ,(token)
	    :articles
		  ,(hermetic:auth (:adminstrator)
				  (with-connection (db)
				    (mito:retrieve-dao 'rails-to-caveman.model::article))
				  (articles-make 5))
		  ,@(roles))))

(defroute ("/articles" :method :post) (&key method)
  (cond ((string= "put" method) (new-article
				 (lack.request:request-body-parameters ningle:*request*)))
	(t `(401 () (,(format nil "Unknown method ~S" method))))))

(defroute "/articles/:id" (&key id)
  ;; (if (null (ignore-errors (parse-integer id)))
  ;;     myway.mapper:next-route)
  ;;     (let ((article (with-connection (db)
  ;; 		       (mito:find-dao 'rails-to-caveman.model::article
  ;; 				      :id id)))
  ;; 	    (if (find :administrator (hermetic:roles))
  ;; 		#0=(render "articles/show.html"
  ;; 			   `(:articles (1 2 3 4 5) ;,article
  ;; 				      ,@(roles)
  ;; 				      :token ,(token)
  ;; 				      :user ,(current-user)
  ;; 				      ;; :news ,(articles-make 5)
  ;; 				      :news (1 2 3 4 5)
  ;; 				      :blogs (1 2 3 4 5))
  ;; 			   (if (publicp article)
  ;; 			       #0# '(404 ()
  ;; 				     ("No articles"))))))))
      (render "articles/show.html"
	      `(:article ,(with-connection (db)
			    (mito:find-dao 'rails-to-caveman.model::article :id id))
			 ,@(roles)
			 :user ,(current-user)
			 :news (1 2 3 4 5)
			 :blogs (1 2 3 4 5))))

(defroute ("/articles/:id" :method :post)(&key method id)
  (cond ((and (string= "post" method)
	      (ignore-errors(parse-integer id)))
	 (edit-article (acons "ID" id
			      (lack.request:request-body-parameters ningle:*request*))))
	((and (string= "delete" method)
	      (ignore-errors(parse-integer id)))
	 (destroy-article (acons "ID" id
				 (lack.request:request-body-parameters ningle:*request*))))
	(t `(401()(,(format nil "Unknown method ~S"method))))))

(defroute destroy-article ("/article/:id" :method :delete)
  (&key authenticity-token id)
  (step
  (if (not (string= authenticity-token(token)))
      '(401()("Denied"))
      (if (not (hermetic:logged-in-p))
	  '(403 () ("Denied"))
	  (if (null (ignore-errors (setf id (parse-integer id))))
	      (myway.mapper:next-route)
	      (progn (with-connection (db)
		       (mito:delete-by-values 'rails-to-caveman.model::article :id id))
		     `(303 (:location "/articles"))))))))

(defroute "/articles/new" ()
  (render "articles/new.html"
	  `(:article ,(make-instance 'rails-to-caveman.model::article)
	    :user ,(current-user)
	    :new (1 2 3 4 5)
	    :blogs (1 2 3 4 5)
		     ,@(roles)
		     :token ,(token))))

(defroute new-article ("/articles" :method :put) ; :put need to be put?
  (&key authenticity-token no-expiration-p)
  (if (not (string= authenticity-token (token)))
      '(401 () ("Denied"))
      (let ((render-args `(:user
			   ,(current-user)
			   ,@(roles)
			   :token ,(token)
			   :news ,(articles 5)
			   :blogs (1 2 3 4 5))))
	(multiple-value-bind (article errors)
	    (rails-to-caveman.model::validate-article
	     (apply #'make-instance 'rails-to-caveman.model::article
		    (request-params (lack.request:request-body-parameters
				     ningle:*request*))))
	  (if errors
	      (render "articles/new.html"
		      (list* :article article
			     :errors errors
			     :no-expiration-p no-expiration-p
			     render-args))
	      (progn (with-connection (db)
		       (mito:insert-dao article)
		     (setf (gethash :notice ningle:*session*)"Stored")
		     `(303 (:location
			    ,(format nil "/articles/~D"
				     (mito:object-id article)))))))))))

(defroute new-article ("/articles" :method :put)
  (&key authenticity-token
	released-year
	released-month
	released-day
	released-hour
	released-min
	expired-year
	expired-month
	expired-day
	expired-hour
	expired-min)
  ;; (dev:peep ningle:*request*)
  (force-output)
  (if (not (string= authenticity-token (token)))
      `(401 () ("Denied"))
      (with-connection (db)
	(let ((render-args `(:user ,(current-user)
				   ,@(roles)
				   :token ,(token)
				   :news (1 2 3 4 5)
				   :blogs (1 2 3 4 5)))
	      (now-time (local-time:now)))
	  (multiple-value-bind (article errors)
	      (rails-to-caveman.model::validate-article
	       (apply #'make-instance 'rails-to-caveman.model::article
		      :allow-other-keys t
		      ;; This deviates from Chapter 9's code because
		      ;; the new article form does not populate the
		      ;; date-released part of the form properly. So,
		      ;; to get around it, date-released is created
		      ;; here instead of it being passed in to this
		      ;; function as values to be parsed.
		      :date-released (format nil "~A-~A-~AT~A:~A:00"
					     (local-time:timestamp-year now-time)
					     (local-time:timestamp-month now-time)
					     (local-time:timestamp-day now-time)
					     (local-time:timestamp-hour now-time)
		       			     (local-time:timestamp-minute now-time))
		      :date-expired (format nil "~A-~A-~AT~A:~A:00"
					    expired-year
					    expired-month
					    expired-day
					    expired-hour
					    expired-min)
		      (request-params (lack.request:request-body-parameters ningle:*request*))))
	    (if errors
		(step
		 (render "articles/new.html"
			(list* :article article
			       :errors errors
			       render-args)))
		(progn (mito:insert-dao article)
		       (setf (gethash :notice ningle:*session*) "Stored")
		       `(303 (:location
			      ,(format nil "/articles/~D"
				       (mito:object-id article)))))))))))




(defroute "/articles/:id/edit" (&key id)
  (step
  (render "articles/edit.html"
	  `(:article ,(with-connection (db)
			(mito:find-dao
			 'rails-to-caveman.model::article :id id))
	    :user ,(current-user)
		     ,@(roles)
		     :token ,(token)
		     :news (1 2 3 4 5)
		     :blogs (1 2 3 4 5)))))

(defun edit-article (request)
  (step
  (destructuring-bind
      (&key authenticity-token
	 id
	 title
	 body
	 released-min
	 released-hour
	 released-day
	 released-month
	 released-year
	 expired-min
	 expired-hour
	 expired-day
	 expired-month
	 expired-year
	 member-only
       &allow-other-keys)
      (request-params request)
    (if (not (string= authenticity-token (token)))
	'(401 () ("Denied"))
	(if (not (hermetic:logged-in-p))
	    '(403 () ("Denied"))
	    (let ((article (with-connection (db)
			     (mito:find-dao
			      'rails-to-caveman.model::article :id id))))
	      ;; (format t "[INFO] ~A" (getf article 'title))
	      (setf (rails-to-caveman.model::title-of article) title
		    (rails-to-caveman.model::body-of article) body
		    (rails-to-caveman.model::date-released-of article)
		    (format nil "~A-~A-~AT~A:~A:00"
			    released-year
			    released-month
			    released-day
			    released-hour
			    released-min)
		    (rails-to-caveman.model::date-expired-of article)
		    (format nil "~A-~A-~AT~A:~A:00"
			    expired-year
			    expired-month
			    expired-day
			    expired-hour
			    expired-min)
		    (rails-to-caveman.model::member-only article) member-only)
	      (multiple-value-bind (article errors)
		  (rails-to-caveman.model::validate-article article)
		   (if errors (render "articles/edit.html"
				      `(:article ,article
					:errors ,errors
					:user ,(current-user)
					,@(roles)
					:token ,(token)
					:news (1 2 3 4 5)
					:blogs (1 2 3 4 5)))
		       (progn (with-connection (db)
				(mito:save-dao article))
			      (setf (gethash :notice ningle:*session*) "Updated")
			      `(303 (:location ,(format nil "/articles/~D"
							(mito:object-id article)))))))))))))
		    

(defroute "/about" ()
  ;; about.html should be in the /templates directory.
  (render #P"about.html" '(:page-title "About")))

(defroute "/hello/:name" (&key name)
  ;; Substitutes ':name' with `NAME'.
  (format nil "Hello, ~A" name))

(defroute "/say/*/to/*" (&key splat)
  ;; If route is /say/hello/to/world (in the browser). It will match
  ;; to /say/hello/to/world. 'hello' and 'world' are the wildcard
  ;; values in this example.
  (format nil "~A" splat))

(defroute ("/hello/([\\w]+)" :regexp t) (&key captures)
  ;; Parse the second part of the URL via a regular expression
  ;; (regexp). The result of the parsed regexp text is stored in
  ;; `CAPTURES', hence the use of 'first' in the format string.
  (format nil "Hello, ~A!" (first captures)))

(defroute "/hello/?:name?" (&key name)
  ;; Generates two types of routes:
  
  ;; 1. /hello/earth
  ;; 2. /hello?NAME=earth

  ;; The query string must be in UPPERCASE. Otherwise, the `NAME' will
  ;; be bound to `nil'.
  (format nil "Hello, ~A" name))

(defroute "/hello/?:name?" (&key |name|)
  ;; If you want the query string in lowercase, enclose `name' (in
  ;; this case) with vertical bars '|'. This will force you to have
  ;; only one route (unlike the route above). `NAME' will now bind to
  ;; `NIL'.

  ;; 1. /hello?name=earth
  ;; 2. /hello?NAME=earth <--- no longer works ('earth' binds to nil).
  ;; 3. /hello/earth      <--- no longer works
  (format nil "Hello, ~A" |name|))

(defroute "/lesson/step*/:name" (&key splat name)
  ;; Directory style: Working with Parameters.
  ;; Example URL: /lesson/step1/Sato
  (case (parse-integer (car splat) :junk-allowed t)
    (1 (format nil "Hello, ~A" name))))

(defroute "/lesson/step*" (&key splat (|name| "Anonymous"))
  ;; 'Anonymous' is the default value for `|name|'.
  ;; Query style: Working with Parameters.
  ;; Example URL: /lesson/step1?name=Sato
  (case (parse-integer (car splat) :junk-allowed t)
    (1 (format nil "Hello, ~A" |name|))))

(defroute "/lesson/step*" (&key splat name)
  ;; If /lesson/step1 is used, it will be redirected to /lesson/step2,
  ;; then /lesson/step3 and finally /lesson/step4. No matter where you
  ;; start (along as it is below 4), the redirects will always take
  ;; you to /lesson/step4.

  ;; The example includes `NAME' BUT it is never used. I am keeping it
  ;; here for consistency between the reference material and this code
  ;; base.
  (case (parse-integer (car splat) :junk-allowed t)
    (1 '(302 (:location "/lesson/step2")))
    (2 '(302 (:location "/lesson/step3")))
    (3 '(302 (:location "/lesson/step4")))
    (4 "Moved to step4")
    
    ;; To be honest, I do not know what this is actually doing. It is
    ;; mentioned in 'STEP5 Flash' in Chapter 3 (I.E. Tutorial 3:
    ;; Routing). This applies to case's 5 and 6. 
    (5 (setf (gethash :notice *session*) "Move to step6")
     `(302 (:location "/lesson/step6")))
    (6 (let((notice (gethash :notice *session*)))
	 (remhash :notice *session*) notice))

    ;; This is part of an example about using djula (which is a
    ;; template engine used by Caveman2. djula is a port of Python's
    ;; Django template engine.
    ;; step7.html should be in the /templates directory.
    (7 (render "step7.html"
	       `(:price ,(floor(* 2000 1.08)))))
    (8 (render "step7.html" '(:price 1000)))
    (9 (render "step9.html"
	       '(:comment "<script>alert('danger')</script>Hello")))
    ;; If you dare to embed HTML, add safe after the variable
    ;; reference on the View side (step10.html).
    (10 (render "step10.html"
		'(:comment "<strong>safe html</strong>")))
    (11 `(200 (:content-type "text/html; charset=utf-8")
	      (, (let ((population 704414) (surface 141.31))
		   (render "step11.html"
			   `(:contents
			     ,(format nil
				      ;; ~D = Decimal
				      
				      ;; ~,,2F = Fixed-Format
				      ;; Floating-Point
				      
				      ;; ~,,2F = Print exactly two
				      ;; digits after the decimal
				      ;; point and many as necessary
				      ;; before the decimal point.
				      "Population: ~D Floor Surface: ~D Population/Surface: ~,,2F"
				      population
				      (floor surface)
				      (/ population surface))))))))
    (12 (render "step11.html"
		`(:contents ,(local-time:format-timestring
			      nil
			      (local-time:now)
			      :format '((:year 4)"/"(:month 2)"/"(:day 2)"(" :short-weekday ") "
					(:hour 2)":"(:min 2)":"(:sec 2))))))
    (13 `(200 (:content-type "text/html; charset=utf-8")
	      ;; This view uses 'format' in step13.html (view in
	      ;; /templates directory).
	      (,(render "step13.html" '(:population 127767944)))))
    (14 (render "step14.html"
		;; The view uses a custom filter which was added to
		;; view.lisp.
		`(:contents ,(format nil "foo~%bar~%bazz"))))
    ;; The view demonstrates how to form links.
    (15 (render "step15.html"))
    ;; The view demonstrates how to display images.
    ;; Images are stored in the /static/images directory.
    (16 (render "step16.html"))
    ;; Provides control branches which you can navigate via djula in
    ;; step17.html (/templates directory).
    (17 `(200 (:content-type "text/html; charset=utf-8")
	      ;; Adjust `STOCK' to adjust what is viewed in step17.html.
	      (,(let((stock 10))
		  (render "step17.html"
			  `(:stock-zerop ,(< 0 stock) :stock ,stock))))))
    ;; This creates a list (cons list) which is then cycled through in
    ;; /templates/step18.html using the djula template engine..
    (18 (render "step18.html"
		'(:items
		  ((:pan . 2680)
		   (:glass . 2550)
		   (:pepper-mill . 4515)
		   (: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

(defmethod on-exception ((app <web>) (code (eql 404)))
  (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*))))

(defun publicp (article)
  (local-time:timestamp< (date-released-of article)
			 (local-time:now)
			 (date-expired-of article)))

(defun format-to-date (&optional(time (local-time:now)))
  (local-time:format-timestring
   nil
   time
   :format '((:year 4)"-"(:month 2)"-"(:day 2))))

(defun articles-make (n &key (logged-in-p (hermetic:logged-in-p))
		     (user(and logged-in-p (current-user))))
  (if logged-in-p
      (if (rails-to-caveman.model::administrator-of user)
      (with-connection (db)
	(mito:select-dao 'rails-to-caveman.model::article
	  (sxql:order-by (:desc :date-released))
	  (sxql:limit n))
	(let ((now (rails-to-caveman.web::format-to-date)))
	  (mito:select-dao 'rails-to-caveman.model::article
	    (sxql:where (:and (:< :date-released now)))
	    ;; 		   (:< now :date-expired)))
	    (sxql:order-by (:desc :date-released))
	    (sxql:limit n)))))
  (let ((now (rails-to-caveman.web::format-to-date)))
    (with-connection (db)
      (mito:select-dao 'rails-to-caveman.model::article
	(sxql:where (:and (:< :date-released now)
			  (:< now :date-expired)
			  (:= :only-member rails-to-caveman.model::+false+)))
	(sxql:order-by (:desc :date-released))
	(sxql:limit n))))))

;; (defun articles (n &key (logged-in-p(hermetic:logged-in-p))
;; 		    (user (and logged-in-p (current-user))))
;;   (if logged-in-p
;;       (if (your-app.model::administrator-of user)
;; 	  (mito:select-dao 'your-app.model::article
;; 	    (sxql:order-by (:desc :date-released))
;; 	    (sxql:limit n))
;; 	  (let ((now(your-app.web::format-to-date)))
;; 	    (mito:select-dao 'your-app.model::article
;; 	      (sxql:where
;; 	       (:and (:< :date-released now)
;; 		     (:< now :date-expired)))
;; 	      (sxql:order-by (:desc :date-released))
;; 	      (sxql:limit n))))

;;       (let ((now(your-app.web::format-to-date)))
;; 	(mito:select-dao 'your-app.model::article
;; 	  (sxql:where (:and (:< :date-released now)
;; 			    (:< now :date-expired)
;; 			    (:= :only-member your-app.model::+false+)))
;; 	  (sxql:order-by(:desc :date-released))
;; 	  (sxql:limit n)))))

(defun entries (&key (logged-in-p (hermetic:logged-in-p))
		  (user (and logged-in-p (current-user)))
		  author limit)
  (with-connection (db)
    (mito:select-dao 'rails-to-caveman.model::entry
      (sxql:where (trivia:match*(logged-in-p author)
		    ((nil nil) `(:= "public" :status))
		    ((nil _)
		     `(:and (:= ,(mito:object-id author) :user-id)
			    (:= "public" :status)))
		    ((_ nil) `(:or (:= "public" :status)
				   (:= "member-only" :status)
				   (:and (:= "draft" :stats)
					 (:= ,(mito:object-id user)
					  :user-id))))
		    ((_ _) (if(mito:object= user author)
			      `(:= ,(mito:object-id user)
				:user-id)
			      `(:and (:= ,(mito:object-id author) :user-id)
				     (:or (:= "public" :status)
					  (:= "member-only" :status)))))))
      (sxql:order-by (:desc :date-posted)) (when limit (sxql:limit limit)))))