@ -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" ( )
@ -72,8 +74,13 @@
( 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 )
( 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 ) ) ) )
:token , ( token ) ) ) )
( defroute "/users/:id/edit" ( &key id )
( defroute "/users/:id/edit" ( &key id )
@ -82,99 +89,154 @@
( 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 )
( defroute ( "/user" :method :post )
( &key |authenticity-token|
( &key |authenticity-token|
( |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 )
( 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 )
( with-connection ( db )
( let ( ( user ( mito:create-dao
( mito:object-id user ) ) ) ) ) ) ) ) ) )
'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 ) ) ) ) ) ) ) )
( defroute delete-user ( "/users/:id" :method :delete )
( defroute delete-user ( "/users/:id" :method :delete )
( &key |authenticity-token| id )
( &key |authenticity-token| id )
@ -194,66 +256,225 @@
( 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| "" )
|name|
|full-name|
( |sex| "" )
|birthday-year|
|birthday-month|
|birthday-day|
|email|
( |administrator| "" )
|_method| )
( if ( not ( string= |authenticity-token| ( token ) ) )
` ( 403 ( ) ( "Denied" ) )
( cond ( ( string= |_method| "delete" )
( delete-user
( delete-user
( acons "ID" id ( lack.request:request-body-parameters
( acons "ID" id
ningle:*request* ) ) ) )
( lack.request:request-body-parameters ningle:*request* ) ) ) )
( ( find |_method| ` ( "" "post" ) )
( ( 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 )
( with-connection ( db )
( let ( ( id ( ignore-errors ( parse-integer id ) ) )
( loop :for ( key . value )
( user ( and id ( mito:find-dao
:in request
'rails-to-caveman.model::user
:collect ( let ( ( *package* ( find-package :keyword ) ) )
:id id ) ) ) )
( 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 )
( if ( null user )
' ( 500 ( :content-type "text/plan"
` ( 500 ( :content-type "text/plain" )
( "Could not find the user." ) )
( "Could not edit exists user." ) )
( progn ( setf ( rails-to-caveman.model::number-of user )
( progn ( setf ( rails-to-caveman.model::number-of user ) number
( parse-integer |number| :junk-allowed t )
( rails-to-caveman.model::name-of user ) name
( rails-to-caveman.model::name-of user )
( rails-to-caveman.model::full-name-of user ) full-name
|name|
( rails-to-caveman.model::sex-of user ) sex
( rails-to-caveman.model::full-name-of user )
( rails-to-caveman.model::birthday-of user ) "2021-12-21"
( rails-to-caveman.model::sex-of user )
;; (format nil
( parse-integer |sex| :junk-allowed t )
;; "~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 )
( rails-to-caveman.model::birthday-of user )
( local-time:parse-timestring
( format nil "~A~A~A" birthday-year
( format nil "~A-~A-~A"
birthday-month
|birthday-year|
birthday-day )
|birthday-month|
( rails-to-caveman.model::email-of user ) email
|birthday-day| ) )
( rails-to-caveman.model::administrator-of user ) administrator
( rails-to-caveman.model::email-of user )
( rails-to-caveman.model::password-of user )
|email|
( gethash :password ningle:*session* ) )
( rails-to-caveman.model::administrator user )
( multiple-value-bind ( user errors )
( eq rails-to-caveman.model::+true+
( rails-to-caveman.model::validate-user user )
( zerop ( parse-integer
( if errors
|administrator|
` ( 400 ( )
:junk-allowed t ) ) ) )
( , ( 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 )
( mito:save-dao user )
( setf ( gethash
( setf ( gethash :notice ningle:*session* )
:notice ningle:*session* )
"Updated" )
"Updated" )
` ( 303 ( :location , ( format nil
' ( 303 ( :location "/account" ) ) ) ) ) ) ) ) ) )
"/users/~D"
id ) ) ) ) ) ) ) ) )
( 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" )
( t ` ( 400 ( :content-type "text/plain" )
( , ( format nil "Unsupported method ~S"
( , ( format nil "Unknown method ~S" method ) ) ) ) ) )
|_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" ( )
@ -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* ) ) ) )