(module user mzscheme
  (require "util.ss"
           (lib "contract.ss")
           (lib "etc.ss")
           (lib "plt-match.ss")
           (rename (lib "request-parsing.ss" "web-server") request? request?))
  
  (provide/contract
   [login (string? string? . -> . (union string? not))]
   [request->uid (request? . -> . (union number? not))]
   ;[sid->uid (string? . -> . (union number? not))]
   [logout (string? number? . -> . void?)])
  
  (define (login user pw)
    (define uid (lookup-uid user))
    (and uid
         (string=? pw (lookup-pw uid))
         (generate-session-id uid)))
  
  (define (logout sid uid)
    (save-sid! uid #f))
  
  (define (lookup-uid username)
    (define uname (string->symbol username))
    (let loop ([users (get-users)])
      (match users
        ['() #f]
        [(list-rest (list id name pw) more)
         (if (eq? uname name)
             id
             (loop more))])))
  
  (define (lookup-pw uid)
    (match (assq uid (get-users))
      [(list id name pw sid) pw]))
  
  (define (lookup-username uid)
    (match (assq uid (get-users))
      [(list id name pw sid) name]))
  
  (define users-table-path (build-path (this-expression-source-directory) "users-table"))
  
  (define (get-users)
    (with-input-from-file users-table-path read))
  ;  (define users
  ;    '([0 invalid "foo"]
  ;      [1 daniel "pwpw"]))
  
  ;  (define sessions (make-hash-table 'equal))
  ;  (define (get-sessions)
  ;    (with-input-from-file (build-path (this-expression-source-directory) "sessions-table") read))
  
  (define (generate-session-id uid)
    (define sid (format "~a~a" (gensym (lookup-username uid)) (random 3000)))
    (save-sid! uid sid)
    sid)
  
  (define (save-sid! uid new-sid)
    ;(hash-table-put! sessions sid uid)
    (with-output-to-file users-table-path
      (lambda ()
        (write (let loop ([users (get-users)])
                 (match users
                   ['() (warn 'save-sid!
                              (format "Tried to save sid (~a) for an inexistant uid (~a)."
                                      new-sid uid))]
                   [(list-rest (list id name pw old-sid) more)
                    (if (eq? id uid)
                        (cons (list id name pw new-sid) more)
                        (cons (list id name pw old-sid)
                              (loop more)))]))))
      'replace))
  
  (printf "USER.SS INSTANTIATED!!!!!!!~n~n~n")
  
  ;  (define (session-id->uid sid)
  ;    (hash-table-get sessions sid (lambda () #f)))
  
  ;; if the request has a valid UID and SID, then return the UID
  ;; else return false
  (define (request->uid request)
    (define-values (uid sid) (request->uid&sid request))
    (define saved-sid (uid->sid uid))
    (and saved-sid
         (string=? sid saved-sid)
         uid))
  
  
  (define (uid->sid uid)
    (match (assq uid (get-users))
      [(list id name pw sid) sid]))
  
 ;(require-for-syntax (lib "mred.ss" "mred"))
 ; (require (lib "mred.ss" "mred"))
  
  (require-for-syntax (lib "class.ss"))
  
  (define-syntax (warn stx)
    (syntax-case stx ()
      [(_ src msg)
       #`(printf #,(string-append "~a ("
                                  (format "~a"
                                          (let ([src (syntax-source stx)]
                                                [src-module (syntax-source-module stx)])
                                            (cond
                                              [(symbol? src-module) src-module]
                                              ;[(module-path-index? src-module)
                                              ; (let-values ([(path base) (module-path-index-split src-module)])
                                              ;   (list path base))]
                                              ;[(is-a? src text%) "some text"]
                                              [(string? src) src]
                                              [src (send src get-position)]
                                              [else src])))
                                  " line "
                                  (number->string (syntax-line stx))
                                  "): ~a~n")
                 src msg)]))
  
  (warn 'foo "barrr")
  (provide warn)
  )