Schematra-Session

Cookie-based session management middleware for CHICKEN Scheme web applications.

Schematra-Session provides secure, cookie-based session management for web applications built with Schematra. It automatically handles session creation, loading, and persistence using HTTP cookies with HMAC-based integrity protection. Sessions are stored client-side as serialized Scheme data, making the system stateless and scalable.

Requirements

CHICKEN Scheme 5.0 or later
Dependencies: srfi-69, message-digest, hmac, sha2, base64, schematra

Installation

chicken-install schematra-session

Basic Usage

(import schematra schematra-session chiccup)

;; Install session middleware
(use-middleware! (session-middleware "your-secret-key-here"))

;; Use sessions in route handlers
(get ("/login")
     (ccup->html 
      `[form (@ (method "POST") (action "/login"))
        [input (@ (type "text") (name "username") (placeholder "Username"))]
        [button "Login"]]))

(post ("/login")
      (let ((username (alist-ref 'username (current-params))))
        (session-set! "user-id" "12345")
        (session-set! "username" username)
        (redirect "/")))

(get ("/")
     (let ((username (session-get "username")))
       (if username
           (ccup->html `[h1 ,(format "Welcome back, ~a!" username)])
           (redirect "/login"))))

(get ("/logout")
     (session-destroy!)
     (redirect "/login"))

(schematra-install)
(schematra-start)

API

[procedure] (session-middleware secret-key)

Creates session middleware for managing HTTP sessions.

Parameters:

secret-key: string - Secret key used for session serialization and integrity verification. This key should be kept secret and consistent across server restarts.

Returns: A middleware function for use with use-middleware!

;; Basic setup
(use-middleware! (session-middleware "my-secret-key-12345"))

;; Use environment variable for production
(use-middleware! (session-middleware (get-environment-variable "SESSION_SECRET")))

Session Management Functions

[procedure] (session-get key [default])

Retrieve a value from the current session.

Parameters:

key: string - The session key to look up
default: any - Value to return if key is not found (default: #f)

Returns: The value associated with the key, or the default value

;; Get user ID from session
(let ((user-id (session-get "user-id")))
  (if user-id
      (format "Welcome user ~A" user-id)
      "Please log in"))

;; Get with custom default
(session-get "theme" "light")  ; Returns "light" if theme not set

[procedure] (session-set! key value)

Store a value in the current session.

Parameters:

key: string - The session key to set
value: any - The value to store (must be serializable as Scheme data)

;; Store user information
(session-set! "user-id" "12345")
(session-set! "username" "alice")
(session-set! "preferences" '((theme . "dark") (lang . "en")))

;; Store complex data structures
(session-set! "cart" `((items . ,(list "item1" "item2"))
                       (total . 29.99)
                       (currency . "USD")))

[procedure] (session-delete! key)

Remove a key-value pair from the current session.

Parameters:

key: string - The session key to remove

;; Remove specific session data
(session-delete! "temp-data")
(session-delete! "form-errors")

;; Remove user data on logout (but keep some session data)
(session-delete! "user-id")
(session-delete! "username")

[procedure] (session-destroy!)

Clear all data from the current session.

;; Complete logout - clear all session data
(post ("/logout")
      (session-destroy!)
      (redirect "/"))

Configuration Parameters

[parameter] (session-max-age [seconds])

Controls how long session cookies remain valid in the client's browser (default: 86400 seconds = 24 hours).

;; Set sessions to expire after 2 hours
(session-max-age (* 2 60 60))

;; Set sessions to expire after 1 week
(session-max-age (* 7 24 60 60))

;; Common values:
;; 3600: 1 hour
;; 86400: 1 day (default)
;; 604800: 1 week
;; 2592000: 30 days

[parameter] (session-key [name])

Defines the cookie name used to store session data (default: "schematra.session_id").

;; Use a custom session cookie name
(session-key "myapp_session")

;; Environment-specific names
(session-key (if (development-mode?) "myapp_dev_session" "myapp_prod_session"))

[parameter] (session-dirty-key)

Internal symbol used to track session modifications (default: '__dirty). This is an implementation detail and should not be used directly in application code.

Session Lifecycle

1. Request Processing: On incoming requests, the middleware checks for existing session cookie
2. Deserialization: If cookie exists, deserializes session data into hash table with integrity verification
3. New Session: If no cookie or verification fails, creates new empty session hash table
4. Availability: Session data becomes available via session-get/session-set!/session-delete!
5. Modification Tracking: Calls to session-set! and session-delete! mark session as modified
6. Persistence: After request processing, saves modified sessions back to cookie
7. Optimization: Only saves cookie if session was modified (dirty flag)

Security Features

HMAC Integrity: Session data is protected with HMAC-SHA256 to prevent tampering
HTTP-Only Cookies: Cookies are marked HTTP-only to prevent JavaScript access
Automatic Escaping: Session data is safely serialized as Scheme s-expressions
Secure Serialization: Uses base64 encoding with cryptographic signatures

;; Session cookie format: {hmac-signature}.{base64-encoded-data}
;; Example: "a1b2c3d4e5f6...xyz.eyJrZXkiOiJ2YWx1ZSJ9"

Complete Examples

User Authentication System

(import schematra schematra-session chiccup)

;; Configure session
(session-max-age (* 7 24 60 60))  ; 1 week
(session-key "myapp_session")

;; Install middleware
(use-middleware! (session-middleware (get-environment-variable "SESSION_SECRET")))

;; Helper function to check authentication
(define (authenticated?)
  (session-get "user-id"))

(define (require-auth!)
  (unless (authenticated?)
    (halt 'unauthorized "Please log in")))

;; Home page
(get ("/")
     (let ((user-id (authenticated?)))
       (ccup->html
        `[.container
          ,(if user-id
               `[div
                 [h1 ,(format "Welcome back, user ~A!" user-id)]
                 [a (@ (href "/profile")) "View Profile"]
                 [a (@ (href "/logout")) "Logout"]]
               `[div
                 [h1 "Welcome"]
                 [a (@ (href "/login")) "Login"]
                 [a (@ (href "/register")) "Register"]])])))

;; Login form
(get ("/login")
     (ccup->html
      `[.login-form
        [h2 "Login"]
        [form (@ (method "POST") (action "/login"))
         [.form-group
          [label (@ (for "username")) "Username:"]
          [input (@ (type "text") (name "username") (id "username") (required))]]
         [.form-group
          [label (@ (for "password")) "Password:"]
          [input (@ (type "password") (name "password") (id "password") (required))]]
         [button.btn-primary (@ (type "submit")) "Login"]]]))

;; Login handler
(post ("/login")
      (let ((username (alist-ref 'username (current-params)))
            (password (alist-ref 'password (current-params))))
        ;; Validate credentials (implement your own logic)
        (if (valid-credentials? username password)
            (begin
              (session-set! "user-id" (get-user-id username))
              (session-set! "username" username)
              (session-set! "login-time" (current-seconds))
              (redirect "/"))
            (ccup->html
             `[.error
               [p "Invalid credentials"]
               [a (@ (href "/login")) "Try again"]]))))

;; Protected profile page
(get ("/profile")
     (require-auth!)
     (let ((username (session-get "username"))
           (login-time (session-get "login-time")))
       (ccup->html
        `[.profile
          [h2 "User Profile"]
          [p ,(format "Username: ~A" username)]
          [p ,(format "Logged in: ~A" (format-timestamp login-time))]
          [a (@ (href "/")) "Home"]
          [a (@ (href "/logout")) "Logout"]])))

;; Logout
(get ("/logout")
     (session-destroy!)
     (redirect "/login"))

Shopping Cart Session

(import schematra schematra-session chiccup)

(use-middleware! (session-middleware "cart-secret-key"))

;; Helper functions
(define (get-cart)
  (session-get "cart" '()))

(define (add-to-cart! item-id quantity)
  (let* ((cart (get-cart))
         (existing (assoc item-id cart))
         (new-cart (if existing
                       (map (lambda (item)
                              (if (equal? (car item) item-id)
                                  `(,item-id . ,(+ (cdr item) quantity))
                                  item))
                            cart)
                       `((,item-id . ,quantity) ,@cart))))
    (session-set! "cart" new-cart)))

(define (remove-from-cart! item-id)
  (let ((new-cart (filter (lambda (item) (not (equal? (car item) item-id)))
                         (get-cart))))
    (session-set! "cart" new-cart)))

(define (cart-total)
  (fold + 0 (map (lambda (item)
                   (* (get-item-price (car item)) (cdr item)))
                 (get-cart))))

;; Routes
(get ("/products")
     (ccup->html
      `[.products
        [h2 "Products"]
        ,@(map (lambda (product)
                 `[.product
                   [h3 ,(car product)]
                   [p ,(format "$~A" (cadr product))]
                   [form (@ (method "POST") (action "/cart/add"))
                    [input (@ (type "hidden") (name "item-id") (value ,(caddr product)))]
                    [input (@ (type "number") (name "quantity") (value "1") (min "1"))]
                    [button "Add to Cart"]]])
               (get-all-products))]))

(post ("/cart/add")
      (let ((item-id (alist-ref 'item-id (current-params)))
            (quantity (string->number (alist-ref 'quantity (current-params)))))
        (add-to-cart! item-id quantity)
        (redirect "/cart")))

(get ("/cart")
     (let ((cart (get-cart))
           (total (cart-total)))
       (ccup->html
        `[.cart
          [h2 "Shopping Cart"]
          ,(if (null? cart)
               `[p "Your cart is empty"]
               `[div
                 [table
                  [thead [tr [th "Product"] [th "Quantity"] [th "Price"] [th "Actions"]]]
                  [tbody
                   ,@(map (lambda (item)
                            (let ((product-name (get-product-name (car item)))
                                  (quantity (cdr item))
                                  (price (* (get-item-price (car item)) (cdr item))))
                              `[tr
                                [td ,product-name]
                                [td ,quantity]
                                [td ,(format "$~A" price)]
                                [td
                                 [form (@ (method "POST") (action "/cart/remove"))
                                  [input (@ (type "hidden") (name "item-id") (value ,(car item)))]
                                  [button "Remove"]]]]))
                          cart)]]
                 [.cart-total
                  [h3 ,(format "Total: $~A" total)]
                  [a.btn (@ (href "/checkout")) "Checkout"]]])
          [a (@ (href "/products")) "Continue Shopping"]])))

Form Data Persistence

;; Persist form data across requests
(get ("/contact")
     (let ((form-data (session-get "contact-form" '()))
           (errors (session-get "form-errors" '())))
       ;; Clear form errors after displaying
       (session-delete! "form-errors")
       (ccup->html
        `[.contact-form
          ,(if (not (null? errors))
               `[.errors
                 [h3 "Please fix these errors:"]
                 [ul ,@(map (lambda (error) `[li ,error]) errors)]]
               '())
          [form (@ (method "POST") (action "/contact"))
           [.form-group
            [label "Name:"]
            [input (@ (type "text") (name "name") 
                     (value ,(alist-ref 'name form-data "")))]]
           [.form-group
            [label "Email:"]
            [input (@ (type "email") (name "email")
                     (value ,(alist-ref 'email form-data "")))]]
           [.form-group
            [label "Message:"]
            [textarea (@ (name "message"))
                      ,(alist-ref 'message form-data "")]]
           [button "Send Message"]]])))

(post ("/contact")
      (let ((name (alist-ref 'name (current-params)))
            (email (alist-ref 'email (current-params)))
            (message (alist-ref 'message (current-params))))
        ;; Store form data in session
        (session-set! "contact-form" `((name . ,name) (email . ,email) (message . ,message)))
        
        ;; Validate
        (let ((errors '()))
          (when (or (not name) (string=? name ""))
            (set! errors (cons "Name is required" errors)))
          (when (or (not email) (not (valid-email? email)))
            (set! errors (cons "Valid email is required" errors)))
          (when (or (not message) (string=? message ""))
            (set! errors (cons "Message is required" errors)))
          
          (if (null? errors)
              (begin
                ;; Success - clear form data
                (session-delete! "contact-form")
                (send-contact-message name email message)
                (redirect "/contact/success"))
              (begin
                ;; Errors - store and redirect back
                (session-set! "form-errors" errors)
                (redirect "/contact"))))))

Best Practices

Secret Key Security: Use a strong, random secret key and store it securely
Session Size: Keep session data small since it's stored in cookies
Sensitive Data: Avoid storing sensitive information in sessions
Expiration: Set appropriate session timeouts using session-max-age
HTTPS: Use HTTPS in production to protect cookie transmission
Session Cleanup: Regularly clean up unused session data

Size Limit: Browsers typically limit cookies to 4KB
Storage Location: Sessions are stored client-side, not server-side
Data Types: Only data that can be serialized as Scheme s-expressions
Security: Protected by HMAC but not encrypted (use HTTPS for transmission security)

License

Repository

GitHub Repository