( 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* ) ) ) )