#! /bin/sh

#|
# echo Content-type: text/plain
# echo
echo Content-type: text/html
 ":";exec /usr/local/bin/mzscheme -r "$0" "$@"
|#

; Copyright 2008 Christopher Michael Rasch
;
; This file is part of Wishforge.

; Wishforge is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.

; Wishforge is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU Affero General Public License for more details.

; You should have received a copy of the GNU Affero General Public License
; along with Wishforge.  If not, see <http://www.gnu.org/licenses/>.

(require (lib "md5.ss"))
(require (lib "etc.ss"))
(require (lib "cgi.ss" "net"))
(require (lib "cookie.ss" "net"))
(require (lib "xml.ss" "xml"))
(require (planet "spgsql.ss" ("schematics" "spgsql.plt" 1)))
(require (lib "1.ss" "srfi"))
(require (file "util.ss"))
(require (file "html.ss"))
(require (file "db.ss"))
(require (file "cookies.ss"))
(require (file "bindings.ss"))
(require (file "timestamp.ss"))

(define-values (login curr-passhash)
   (if (and (exists-binding? 'login) (exists-binding? 'password))
       (values (ebs 'login)
	       (let ([password (ebs 'password)])
		 (bytes->string/latin-1 (md5 (string->bytes/latin-1 password)))))
       (if cookies
	   (values (get-one-cookie "login")
		   (get-one-cookie "passhash"))
	   (values "" ""))))
       
(define passhash (get-user-passhash login))

(define (bad-passwd-page)
  (apply-html-template
    `((TITLE "Bad WishForge password")
      (META ((http-equiv "Content-Type")
	     (content "text/html; charset=iso-8859-1")))
      (META ((NAME "description")
	       (CONTENT "WishForge: The Software Completion Bond Market"))))
    `((DIV
       (P)
       (H3 "Bad Wishforge login and/or password")
       (P)
       (H3 "Back to Wishforge " (A ((HREF "http:/wishforge.html"))
				   "login page") ".")))))

(unless (equal? passhash curr-passhash)
        (newline)
	(write-xml/content 
	 (xexpr->xml (bad-passwd-page)))
	(exit))

(define user-data (get-user-data login))

(define name (get-user-name login))

(define mk-user-tr
  (lambda (w)
    `(TR 
      ,@(map (lambda (item)
	       (let ([s (if (sql-null? item)
			    ""
			    item)])
		 `(TD ,s))) w))))

(define tbl-attributes `((BORDER "1") (CELLSPACING "2") (CELLPADDING "2")))

(define mk-tbl-headers
  (lambda (s)
    `(TD ((CLASS "HEADER") (BGCOLOR "lightblue")) ,s)))

(define expired?
  (lambda (ts)
    (and (string? ts) ; could be NULL 
	; (printf "curr: ~a stamp: ~a~n" curr-date-string (timestamp->string ts))
	(string>=?
	    curr-date-string
	    (timestamp->string ts)))))

(define wishes-tbl 
  (let* ([wishes (get-wishes login)]
	 [is-current? (lambda (w) 
			(let ([expiration (car (reverse w))])
			  (not (expired? expiration))))]
	 [raw-exprs (map (lambda (w) (car (reverse w))) wishes)]
	 [exprs (format "~a" raw-exprs)]
	 [current-wishes (filter is-current? wishes)])
      (if (null? current-wishes)
	  `(H3 'nbsp (I "No wishes"))
	  `(TABLE ,tbl-attributes
		  (TR ,@(map mk-tbl-headers 
			     '("symbol" "summary" "expiration")))
		  ,@(map mk-user-tr current-wishes)))))

(define mk-pledges-tbl
  (lambda (pledges)
    (if (null? pledges)
	`(H3 'nbsp (I "No pledges"))
	`(TABLE ,tbl-attributes
		(TR ,@(map mk-tbl-headers
			   '("pledger" "login" "symbol" "summary"
			     "number_pledges" "pledge_amount")))
		,@(map mk-user-tr pledges)))))

(define my-pledges-tbl
    (mk-pledges-tbl (get-pledges login)))

(define others-pledges-tbl
  (mk-pledges-tbl (get-others-pledges login)))

(define account-page
  (apply-html-template
    `((TITLE "WishForge account for " ,name)
      (META ((http-equiv "Content-Type")
	     (content "text/html; charset=iso-8859-1")))
      (META ((NAME "description")
	       (CONTENT "WishForge: The Software Completion Bond Market"))))
    `((DIV
       (P)
       (H3 "Wishforge account of " ,name)
       (P)
       (H2 "Actions") 
       'nbsp (A ((HREF "/cgi-bin/create-wish.sh")) "Create a wish") (BR)
       'nbsp (A ((HREF "/cgi-bin/create-pledge.sh")) "Back a wish with a pledge") (BR)
       'nbsp (A ((HREF "/cgi-bin/create-bid.sh")) "Bid on a pledge") (BR)
       'nbsp (A ((HREF "/cgi-bin/sell-pledge.sh")) "Sell a pledge") (BR)
       'nbsp (A ((HREF "foo")) "Edit profile") (BR)
       'nbsp (A ((HREF "foo")) "View expired wishes") 
       (P)
       (H3 "Wishes that I've created")
       ,wishes-tbl
       (P)
       (H3 "All pledges on my wishes")
       ,my-pledges-tbl
       (H3 "Pledges I've made on others' wishes")
       ,others-pledges-tbl
))))

(define login-cookie (set-cookie "login" login))
(define passhash-cookie (set-cookie "passhash" passhash))

; TODO -- create session id for user, store on server
; for now, just pass login/password
(for-each
 (lambda (c)
   (cookie:add-max-age c 3600)
   (display (format "Set-Cookie: ~a~n" (print-cookie c))))
 (list login-cookie passhash-cookie))

(newline)

(write-xml/content 
 (xexpr->xml account-page))