;;;; Copyright (C) 2006 ZOMGROFLCOPTER
;;;;
;;;; This file is part of WALT.
;;;;
;;;; WALT is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; WALT 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 General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with WALT; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

(in-package :kira)

(defmethod handle-request-response ((action (eql 'login)) (method (eql :get)))
  (with-query (return-uri name (error keyword))
    (with-standard-page ("Log in")
      (:standard-form
       (when return-uri
	 (html (:hidden-field "return-uri" (:string return-uri))))
       (:field text "name" name :label "Name"
	       (:errors error (:name "name not found")))
       (:field password "password" nil :label "Password"
	       (:errors error (:password "need correct password")))
       (:submit "Log in")))))

(defmethod handle-request-response ((action (eql 'login)) (method (eql :post)))
  (with-query (return-uri name password)
    (let ((person (get-value (uri-style-name name) (next-in-uri *root*))))
      (if (and (typep person 'person) (string-equal (password person) password))
          (progn
            (set-cookie "id" (id person) "password" password)
            (redirect (or return-uri :home)))
          (redirect 'login :return-uri return-uri :name name :error (if person :password :name))))))

(defmethod handle-request-response ((action (eql 'logout)) (method (eql :get)))
  (with-query (return-uri)
    (set-cookie "id" nil "password" nil)
    (redirect (or return-uri :home))))

(defmethod handle-request-response ((action (eql 'register)) (method (eql :get)))
  (with-query (return-uri name date-joined (error keyword))
    (with-standard-page ("Create Account")
      (:standard-form
       (:when return-uri
	 (:hidden-field "return-uri" (:string return-uri)))
       (:field text "name" name :label "Name"
	       (:errors error (:name "name already in use")))
       (:field password "password" nil :label "Password"
	       (:errors error (:password "passwords must match")))
       (:field password "password-1" nil :label "Confirm password"
	       (:errors error (:password "passwords must match")))
       (:field date "date-joined" date-joined :label "Date joined")
       (:submit "Create")))))

(defmethod handle-request-response ((action (eql 'register)) (method (eql :post)))
  (with-query (return-uri name password password-1 (date-joined date))
    (if (string-equal password password-1)
        (progn
	  (setf name (uri-style-name name))
          (if (get-value name (next-in-uri *root*))
              (redirect 'register :return-uri return-uri :name name :date-joined date-joined :error :name)
              (let (person)
                (with-transaction ()
		  (setf person
			(make-instance
			 'person
			 :name name
			 :password password
                         :guild *guild*
			 :date-joined date-joined))
                  (add-kv (next-in-uri *root*) name person)
                  (add-to (people *root*) person))
                (redirect (or return-uri :home)))))
        (redirect 'register :return-uri return-uri :name name :date-joined date-joined :error :password))))