@ -1,5 +1,5 @@
( in-package #:cl-user )
( in-package #:cl-user )
( defpackage #: rails-to-caveman.web
( defpackage rails-to-caveman.web
( :use #:cl
( :use #:cl
#:caveman2
#:caveman2
#:rails-to-caveman.config
#:rails-to-caveman.config
@ -32,7 +32,9 @@
;; to leave the code commented out.
;; to leave the code commented out.
;; '(:message "This is not a message") ; Added Chapter 3.
;; '(: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" ( )
( defroute "/users/index" ( )
@ -42,7 +44,7 @@
( sxql:order-by :number ) ) )
( sxql:order-by :number ) ) )
:token , ( token )
:token , ( token )
:notice ( flash-gethash
:notice ( flash-gethash
:notice ningle:*request* ) ) ) )
:notice ningle:*request* ) ) ) )
( defroute "/users/search" ( &key |q| )
( defroute "/users/search" ( &key |q| )
( render "users/index.html"
( render "users/index.html"
@ -72,9 +74,14 @@
( defroute "/user/new" ( )
( defroute "/user/new" ( )
( render #P"users/new.html"
( render #P"users/new.html"
` ( :users , ( with-connection ( db )
` ( :user , ( current-user )
( make-instance 'rails-to-caveman.model::user ) )
:new-user , ( with-connection ( db )
:token , ( token ) ) ) )
( 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 )
( defroute "/users/:id/edit" ( &key id )
( let* ( ( id ( ignore-errors ( parse-integer id ) ) )
( let* ( ( id ( ignore-errors ( parse-integer id ) ) )
@ -82,102 +89,157 @@
( and id
( and id
( mito:find-dao 'rails-to-caveman.model::user
( mito:find-dao 'rails-to-caveman.model::user
:id id ) ) ) ) )
:id id ) ) ) ) )
( if user ( render "user s/edit.html"
( if user ( render "account s/edit.html"
` ( :user , user :token , ( token ) ) )
` ( :user , user :token , ( token ) ) )
( on-exception *web* 404 ) ) ) )
( on-exception *web* 404 ) ) ) )
#|
( defroute ( "/user/:id" :method :post )
( defroute ( "/user/:id" :method :post )
( &key |authenticity-token|
( &key |authenticity-token|
id
id
( |number| "" )
( |number| "" )
|name|
|name|
|full-name|
|full-name|
( |sex| "" )
( |sex| "" )
|birthday-year|
|birthday-year|
|birthday-month|
|birthday-month|
|birthday-day|
|birthday-day|
|email|
|email|
( |administrator| "" ) )
( |administrator| "" ) )
( if ( not ( string= |authenticity-token| ( token ) ) )
( if ( not ( string= |authenticity-token| ( token ) ) )
' ( 403 ( ) ( "Denied" ) )
' ( 403 ( ) ( "Denied" ) )
( with-connection ( db )
( with-connection ( db )
( let ( ( id ( ignore-errors ( parse-integer id ) ) )
( let ( ( id ( ignore-errors ( parse-integer id ) ) )
( user ( and id
( user ( and id
( mito:find-dao
( mito:find-dao
'rails-to-caveman.model::user :id id ) ) ) )
'rails-to-caveman.model::user :id id ) ) ) )
( if ( null user )
( if ( null user )
' ( 500 ( ) ( "Could not edit because user doesn't exist." ) ) )
' ( 500 ( ) ( "Could not edit because user doesn't exist." ) ) )
( progn
( progn
#| CHAPTER 6 CODE NOT WORKING HERE.
#| CHAPTER 6 CODE NOT WORKING HERE.
=================================
=================================
I could not get this part of the code ( setf ) to work when
I could not get this part of the code ( setf ) to work when
following the tutorial. Because of this, I have decided to
following the tutorial. Because of this, I have decided to
leave the code the tutorial ( in Chapter 6 )
leave the code the tutorial ( in Chapter 6 )
provided. Hopefully, there are other code examples which
provided. Hopefully, there are other code examples which
will provide an answer to get this part of the code
will provide an answer to get this part of the code
working.
working.
For now, this route ( I.E. when you try to update a user ) the site will
For now, this route ( I.E. when you try to update a user ) the site will
throw an error and not update it.
throw an error and not update it.
| #
| #
( setf ( rails-to-caveman.model::number-of user ) ( parse-integer |number| :junk-allowed t )
;; (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::name-of user) |name|
( rails-to-caveman.model::full-name-of user ) |full-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::sex-of user) (parse-integer |sex| :junk-allowed t)
( rails-to-caveman.model::birthday-of user ) ( local-time:parse-timestring
;; (rails-to-caveman.model::birthday-of user) (local-time:parse-timestring
( format nil "~A-~A-~A"
;; (format nil "~A-~A-~A"
|birthday-year|
;; |birthday-year|
|birthday-month|
;; |birthday-month|
|birthday-day| ) )
;; |birthday-day|))
( rails-to-caveman.model::email-of user ) |email|
;; (rails-to-caveman.model::email-of user) |email|
( rails-to-caveman.model::administrator-of user ) ( eq rails-to-caveman.model::+true+
;; (rails-to-caveman.model::administrator-of user) (eq rails-to-caveman.model::+true+
( zerop ( parse-integer
;; (zerop (parse-integer
|administrator|
;; |administrator|
:junk-allowed t ) ) ) )
;; :junk-allowed t))))
( mito:save-dao user )
( mito:save-dao user )
( setf ( gethash :notice ningle:*session* ) "Updated" )
( setf ( gethash :notice ningle:*session* ) "Updated" )
` ( 303 ( :location , ( format nil "/users/~D" id ) ) ) ) ) ) ) )
` ( 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 )
( defroute ( "/user" :method :post )
( &key |authenticity-token|
( &key method )
( |number| "" )
;; (format t "~%[INFO] THIS IS THE ROUTE YOU THINK IT IS ~A"
|name|
;; (lack.request:request-body-parameters
|full-name|
;; ningle:*request*))
( |sex| "" )
( cond ( ( string= "put" method ) ( put-user
|birthday-year|
( lack.request:request-body-parameters
|birthday-month|
ningle:*request* ) ) )
|birthday-day|
( t ` ( 400 ( :content-type "text/plain" )
|email|
( , ( format nil "Unknown method ~S" method ) ) ) ) ) )
( |administrator| "" ) )
( if ( not ( string= |authenticity-token| ( token ) ) )
( defroute put-user ( "/user" :method :put )
' ( 403 ( ) ( "Denied" ) )
( &rest args
( with-connection ( db )
&key
( let ( ( user ( mito:create-dao
authenticity-token
'rails-to-caveman.model::user
birthday-year
:number ( parse-integer |number| :junk-allowed t )
birthday-month
:name |name|
birthday-day
:full-name |full-name|
number
:sex ( parse-integer |sex| :junk-allowed t )
name
:birthday ( local-time:parse-timestring
full-name
( format nil "~A-~A-~A"
email
|birthday-year|
administrator )
|birthday-month|
( declare ( ignore number
|birthday-day| ) )
name
:email |email|
full-name
:administrator ( eq
email
rails-to-caveman.model::+true+
administrator ) )
( zerop
( if ( not ( string= authenticity-token ( token ) ) )
( parse-integer |administrator|
` ( 403 ( :content-type "text/plain" ) "Denied" )
:junk-allowed t ) ) ) ) ) )
( multiple-value-bind ( user errors )
( setf ( gethash :notice ningle:*session* ) "Stored!" )
( validate-user
` ( 303 ( :location , ( format
( apply #' make-instance 'rails-to-caveman.model::user
nil "/users/~D" ( mito:object-id 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 )
( defroute delete-user ( "/users/:id" :method :delete )
( &key |authenticity-token| id )
( &key |authenticity-token| id )
( if ( not ( string= |authenticity-token| ( token ) ) )
( if ( not ( string= |authenticity-token| ( token ) ) )
` ( 403 ( :content-type "text/plain" ) ( "Denied" ) )
` ( 403 ( :content-type "text/plain" ) ( "Denied" ) )
( with-connection ( db )
( with-connection ( db )
@ -194,67 +256,226 @@
( setf ( gethash :notice ningle:*session* "Deleted." )
( setf ( gethash :notice ningle:*session* "Deleted." )
` ( 303 ( :location "/users/index" ) ) ) ) ) ) ) ) )
` ( 303 ( :location "/users/index" ) ) ) ) ) ) ) ) )
( defroute ( "/users/:id" :method :post )
( defroute ( "/user/:id" :method :post )
( &key |authenticity-token|
( &key id method )
id
( cond ( ( string= method "delete" )
( |number| "" )
( delete-user
|name|
( acons "ID" id
|full-name|
( lack.request:request-body-parameters ningle:*request* ) ) ) )
( |sex| "" )
( ( find method ' ( "" "post" nil ) :test #' equal )
|birthday-year|
( post-user ( acons "id"
|birthday-month|
id
|birthday-day|
( lack.request:request-body-parameters ningle:*request* ) ) ) )
|email|
( t ` ( 400 ( :content-type "text/plain" )
( |administrator| "" )
( , ( format nil "Unsupported method ~S" method ) ) ) ) ) )
|_method| )
( if ( not ( string= |authenticity-token| ( token ) ) )
;;; YOU ARE UP TO HERE:
` ( 403 ( ) ( "Denied" ) )
;;; CAN'T GET THE VALIDATION TO WORK WHEN CREATING A NEW ACCOUNT.
( cond ( ( string= |_method| "delete" )
( defun post-user ( request )
( delete-user
( format t "[INFO] You have reached post-user request" )
( acons "ID" id ( lack.request:request-body-parameters
( destructuring-bind
ningle:*request* ) ) ) )
( &key
( ( find |_method| ` ( "" "post" ) )
authenticity-token
( with-connection ( db )
id
( let ( ( id ( ignore-errors ( parse-integer id ) ) )
number
( user ( and id ( mito:find-dao
name
'rails-to-caveman.model::user
full-name
:id id ) ) ) )
sex
( if ( null user )
birthday-year
' ( 500 ( :content-type "text/plan"
birthday-month
( "Could not find the user." ) )
birthday-day
( progn ( setf ( rails-to-caveman.model::number-of user )
email
( parse-integer |number| :junk-allowed t )
administrator
( rails-to-caveman.model::name-of user )
&allow-other-keys )
|name|
( with-connection ( db )
( rails-to-caveman.model::full-name-of user )
( loop :for ( key . value )
( rails-to-caveman.model::sex-of user )
:in request
( parse-integer |sex| :junk-allowed t )
:collect ( let ( ( *package* ( find-package :keyword ) ) )
( rails-to-caveman.model::birthday-of user )
( read-from-string key ) )
( local-time:parse-timestring
:collect value )
( format nil "~A-~A-~A"
( if ( not ( string= authenticity-token ( token ) ) )
|birthday-year|
` ( 403 ( ) ( "Denied" ) )
|birthday-month|
( let* ( ( id ( ignore-errors ( parse-integer id ) ) )
|birthday-day| ) )
( user ( and id
( rails-to-caveman.model::email-of user )
( mito:find-dao 'rails-to-caveman.model::user :id id ) ) ) )
|email|
( if ( null user )
( rails-to-caveman.model::administrator user )
` ( 500 ( :content-type "text/plain" )
( eq rails-to-caveman.model::+true+
( "Could not edit exists user." ) )
( zerop ( parse-integer
( progn ( setf ( rails-to-caveman.model::number-of user ) number
|administrator|
( rails-to-caveman.model::name-of user ) name
:junk-allowed t ) ) ) )
( rails-to-caveman.model::full-name-of user ) full-name
( mito:save-dao user )
( rails-to-caveman.model::sex-of user ) sex
( setf ( gethash
( rails-to-caveman.model::birthday-of user ) "2021-12-21"
:notice ningle:*session* )
;; (format nil
"Updated" )
;; "~A-~A-~A"
` ( 303 ( :location , ( format nil
;; birthday-year
"/users/~D"
;; birthday-month
id ) ) ) ) ) ) ) ) )
;; birthday-day)
( t ` ( 400 ( :content-type "text/plain" )
( rails-to-caveman.model::email-of user ) email
( , ( format nil "Unsupported method ~S"
( rails-to-caveman.model::administrator-of user ) administrator )
|_method| ) ) ) ) ) ) )
( 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" ( )
( defroute "/about" ( )
;; about.html should be in the /templates directory.
;; about.html should be in the /templates directory.
@ -410,6 +631,7 @@
( let ( ( value ( gethash key table ) ) )
( let ( ( value ( gethash key table ) ) )
( remhash key table )
( remhash key table )
value ) )
value ) )
;;
;;
;; Error pages
;; Error pages
@ -417,3 +639,37 @@
( declare ( ignore app ) )
( declare ( ignore app ) )
( merge-pathnames #P"_errors/404.html"
( merge-pathnames #P"_errors/404.html"
*template-directory* ) )
*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* ) ) ) )