suzanne.soy/racket-pkg-website
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Make login/logout flows redirect to original page cleanly.

Browse Source
This commit is contained in:
Tony Garnock-Jones 2014-11-09 09:02:31 -05:00
parent 8c7073de73
commit 6e0a53fedf
1 changed files with 22 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/main.rkt
View File

@ -11,6 +11,7 @@
(require web-server/servlet) (require web-server/servlet)
(require web-server/http/id-cookie) (require web-server/http/id-cookie)
(require web-server/http/cookie-parse) (require web-server/http/cookie-parse)
(require web-server/http/request-structs)
(require "bootstrap.rkt") (require "bootstrap.rkt")
(require "html-utils.rkt") (require "html-utils.rkt")
(require "packages.rkt") (require "packages.rkt")
@ -82,20 +83,36 @@
(let redo ((session-keys original-session-keys)) (let redo ((session-keys original-session-keys))
(define session (for/or ((k session-keys)) (lookup-session/touch! k))) (define session (for/or ((k session-keys)) (lookup-session/touch! k)))
;; (log-info "session: ~a" session) ;; (log-info "session: ~a" session)
;; If needed in future, we can change this to preserve *all* of
;; the original request by simply calling redo with the new
;; session key, (redo (list new-session-key)).
;;
;; For now, we need to redirect to a clean URL in every case, so
;; just do that.
(define (after-login new-session-key)
(parameterize ((bootstrap-cookies
(if new-session-key
(list (make-cookie COOKIE new-session-key #:path "/" #:secure? #t))
(list clear-session-cookie))))
(bootstrap-redirect (url->string (request-uri request)))))
(send/suspend/dispatch (send/suspend/dispatch
(lambda (embed-url) (lambda (embed-url)
(if (and require-login? (not session)) (if (and require-login? (not session))
(redo (list (login-page))) (after-login (login-page))
(parameterize ((bootstrap-navbar-extension (parameterize ((bootstrap-navbar-extension
(cond (cond
[(not session) [(not session)
`((a ((id "register-button") `((a ((id "register-button")
(class "btn btn-default navbar-btn navbar-right") (class "btn btn-default navbar-btn navbar-right")
(href ,(embed-url (lambda (req) (redo (list (register-page))))))) (href ,(embed-url
(lambda (req) (after-login (register-page))))))
"Register") "Register")
(a ((id "sign-in-button") (a ((id "sign-in-button")
(class "btn btn-success navbar-btn navbar-right") (class "btn btn-success navbar-btn navbar-right")
(href ,(embed-url (lambda (req) (redo (list (login-page))))))) (href ,(embed-url
(lambda (req) (after-login (login-page))))))
"Sign in"))] "Sign in"))]
[else [else
`((ul ((class "nav navbar-nav navbar-right")) `((ul ((class "nav navbar-nav navbar-right"))
@ -114,7 +131,8 @@
(session-email session)))))) (session-email session))))))
,(glyphicon 'user) " My packages")) ,(glyphicon 'user) " My packages"))
(li ((class "divider")) (li ((class "divider"))
(li (a ((href ,(named-url logout-page))) (li (a ((href ,(embed-url
(lambda (req) (after-login #f)))))
,(glyphicon 'log-out) " Log out")))))))])) ,(glyphicon 'log-out) " Log out")))))))]))
(current-session session) (current-session session)
(bootstrap-cookies (bootstrap-cookies