64 lines
1.9 KiB
Racket
64 lines
1.9 KiB
Racket
#lang racket/base
|
|
|
|
(provide current-session
|
|
current-email
|
|
session-lifetime
|
|
(struct-out session)
|
|
create-session!
|
|
destroy-session!
|
|
lookup-session/touch!
|
|
lookup-session)
|
|
|
|
(require "randomness.rkt")
|
|
(require "config.rkt")
|
|
(require "hash-utils.rkt")
|
|
(require reloadable)
|
|
|
|
(define current-session (make-parameter #f))
|
|
(define session-lifetime
|
|
(* (or (@ (config) session-lifetime-seconds)
|
|
(* 7 24 60 60)) ;; one week in seconds
|
|
1000)) ;; convert to milliseconds
|
|
|
|
(struct session (key expiry email password curator?) #:prefab)
|
|
|
|
(define sessions (make-persistent-state 'session-store (lambda () (make-hash))))
|
|
|
|
(define (current-email)
|
|
(define s (current-session))
|
|
(and s (session-email s)))
|
|
|
|
(define (expire-sessions!)
|
|
(define now (current-inexact-milliseconds))
|
|
(define ss (sessions))
|
|
(for ((session-key (hash-keys ss)))
|
|
(define s (hash-ref ss session-key (lambda () #f)))
|
|
(when (and s (<= (session-expiry s) now))
|
|
(hash-remove! ss session-key))))
|
|
|
|
(define (create-session! email password #:curator? [curator? #f])
|
|
(expire-sessions!)
|
|
(define session-key (bytes->string/utf-8 (random-bytes/base64 32)))
|
|
(hash-set! (sessions)
|
|
session-key
|
|
(session session-key
|
|
(+ (current-inexact-milliseconds) session-lifetime)
|
|
email
|
|
password
|
|
curator?))
|
|
session-key)
|
|
|
|
(define (destroy-session! session-key)
|
|
(hash-remove! (sessions) session-key))
|
|
|
|
(define (lookup-session/touch! session-key)
|
|
(define s (hash-ref (sessions) session-key (lambda () #f)))
|
|
(and s
|
|
(let ((s1 (struct-copy session s [expiry (+ (current-inexact-milliseconds)
|
|
session-lifetime)])))
|
|
(hash-set! (sessions) session-key s1)
|
|
s1)))
|
|
|
|
(define (lookup-session session-key)
|
|
(hash-ref (sessions) session-key (lambda () #f)))
|