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

Take note of backend telling us whether current user is a curator or not

Browse Source
This commit is contained in:
Tony Garnock-Jones 2015-10-02 20:46:02 -04:00
parent c9384e4cf9
commit d7125de883
2 changed files with 15 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/sessions.rkt
View File

@ -20,7 +20,7 @@
(* 7 24 60 60)) ;; one week in seconds (* 7 24 60 60)) ;; one week in seconds
1000)) ;; convert to milliseconds 1000)) ;; convert to milliseconds
(struct session (key expiry email password) #:prefab) (struct session (key expiry email password curator?) #:prefab)
(define sessions (make-persistent-state 'session-store (lambda () (make-hash)))) (define sessions (make-persistent-state 'session-store (lambda () (make-hash))))
@ -36,7 +36,7 @@
(when (and s (<= (session-expiry s) now)) (when (and s (<= (session-expiry s) now))
(hash-remove! ss session-key)))) (hash-remove! ss session-key))))
(define (create-session! email password) (define (create-session! email password #:curator? [curator? #f])
(expire-sessions!) (expire-sessions!)
(define session-key (bytes->string/utf-8 (random-bytes/base64 32))) (define session-key (bytes->string/utf-8 (random-bytes/base64 32)))
(hash-set! (sessions) (hash-set! (sessions)
@ -44,7 +44,8 @@
(session session-key (session session-key
(+ (current-inexact-milliseconds) session-lifetime) (+ (current-inexact-milliseconds) session-lifetime)
email email
password)) password
curator?))
session-key) session-key)
(define (destroy-session! session-key) (define (destroy-session! session-key)

15
src/site.rkt
View File

@ -331,6 +331,11 @@
'passwd password 'passwd password
'code code))) 'code code)))
(define (authentication-success->curator? success)
(match success
[#t #f] ;; new user -- we can only assume they are *not* curators
[(hash-table ('curation curator?) _ ...) (if curator? #t #f)]))
(define (process-login-credentials request) (define (process-login-credentials request)
(define-form-bindings request (email password)) (define-form-bindings request (email password))
(if (or (equal? (string-trim email) "") (if (or (equal? (string-trim email) "")
@ -341,8 +346,9 @@
(login-form "Something went awry; please try again.")] (login-form "Something went awry; please try again.")]
[(or "emailed" #f) [(or "emailed" #f)
(summarise-code-emailing "Incorrect password, or nonexistent user." email)] (summarise-code-emailing "Incorrect password, or nonexistent user." email)]
[else [success
(create-session! email password)]))) (create-session! email password
#:curator? (authentication-success->curator? success))])))
(define (register-form #:email [email ""] (define (register-form #:email [email ""]
#:code [code ""] #:code [code ""]
@ -415,10 +421,11 @@
(retry "The code you entered was incorrect. Please try again.")] (retry "The code you entered was incorrect. Please try again.")]
[(or "emailed" #f) [(or "emailed" #f)
(retry "Something went awry; you have been emailed another code. Please check your email.")] (retry "Something went awry; you have been emailed another code. Please check your email.")]
[else [success
;; The email and password combo we have been given is good to go. ;; The email and password combo we have been given is good to go.
;; Set a cookie and consider ourselves logged in. ;; Set a cookie and consider ourselves logged in.
(create-session! email password)])])) (create-session! email password
#:curator? (authentication-success->curator? success))])]))
(define (notify-of-emailing request) (define (notify-of-emailing request)
(define-form-bindings request (email_for_code)) (define-form-bindings request (email_for_code))