;; (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 "/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 )
( &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 ( 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)))))