#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SESSION.plt - a session store built on top of bzlib/dbi
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; session.ss - the main functionalities
;; yc 11/15/2009 - first version
(require "depend.ss")

(define-struct (session active-record) (expiration store) #:mutable) 

(define current-session (make-parameter #f))

(define session-expiration-interval (make-parameter 14))

(define (expiration-helper (date (current-date)))
  (exact->inexact (date->julian-day (date+ date (session-expiration-interval)))))

(define (uuid-helper u)
  (uuid->string (make-uuid u)))

(define (build-session handle 
                       (uuid (make-uuid))
                       (store (make-immutable-hash-registry))) 
  (define (helper expiration store)
    (make-session handle uuid expiration 
                  (call-with-input-string store in->registry)))
  (with-handlers ((identity 
                   (lambda (e)
                     ((current-log) 'build-session! e)
                     (void))))
    (exec handle 'make-session! `((uuid . ,(uuid-helper uuid))
                                  (expiration . ,(expiration-helper))
                                  (store . ,(call-with-output-string 
                                             (lambda (out) 
                                               (registry->out store out)))))))
  (apply helper (row handle 'load-session `((uuid . ,(uuid-helper uuid))))))

(define (save-session! session) 
  (exec (active-record-handle session) 
        'save-session!
        `((uuid . ,(uuid-helper (active-record-id session)))
          (expiration . ,(expiration-helper))
          (store . ,(call-with-output-string 
                     (lambda (out) 
                       (registry->out (session-store session) out)))))))

(define (refresh-session! session) 
  (define (helper new-session) 
    (set-session-expiration! session (session-expiration new-session))
    (set-session-store! session (session-store new-session)))
  (helper (build-session (active-record-handle session)
                         (active-record-id session)
                         (session-expiration session)
                         (session-store session))))

(define (session-ref session key (default #f)) 
  (registry-ref (session-store session) key default))

(define (session-set! session key val) 
  (registry-set! (session-store session) key val))

(define (session-del! session key) 
  (registry-del! (session-store session) key))

(define (destroy-session! session) 
  (exec (active-record-handle session)
        'destroy-session! 
        `((uuid . ,(uuid-helper (active-record-id session)))))) 

(define (session-expired? session) 
  (< (session-expiration session) (date->julian-day (current-date))))

(define (call-with-session session proc) 
  (dynamic-wind void 
                (lambda () 
                  (proc session)) 
                (lambda ()
                  (save-session! session))))

(define (with-session session proc) 
  (call-with-session session 
                     (lambda (session)
                       (parameterize ((current-session session)) 
                         (proc)))))

(provide/contract 
 (session-ref (->* (session? any/c)
                   (any/c)
                   any))
 (session-set! (-> session? any/c any/c any))
 (session-del! (-> session? any/c any))
 (session-expired? (-> session? any)) 
 (call-with-session (-> session? 
                        (-> session? any) 
                        any))
 (with-session (-> session? (-> any) any))
 (build-session (->* (handle?)
                     (uuid? registry?)
                     session?))
 (save-session! (-> session? any))
 (refresh-session! (-> session? any))
 (destroy-session! (-> session? any))
 (current-session (parameter/c (or/c false/c session?)))
 (session-expiration-interval (parameter/c number?))
 (session? (-> any/c any))
 )