(in-package #:cl-user)
(defpackage rails-to-caveman.web
  (:use #:cl
	#:caveman2
        #:rails-to-caveman.config
	#:rails-to-caveman.view
        #:rails-to-caveman.db
	#:rails-to-caveman.model
        #:sxql
	#:mito)
  (: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 "/" ()
  (render #P"index.html"
	  ;; Use to pass message to view -- it is expecting a
	  ;; `MESSAGE' item. You do not need to add it, though. Or,
	  ;; you can pass it an empty value/string if you do not want
	  ;; to leave the code commented out.

	  ;; '(:message "This is not a message") ; Added Chapter 3.
	  `(:numbers (1 2 3 4 5)
	    :token ,(token))
	  ;; :alert "Bitchin")
	  ))

(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 "/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.
  (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*))))