#|
  |Copyright (c) 2015 Edward Langley
  |All rights reserved.
  |
  |Redistribution and use in source and binary forms, with or without
  |modification, are permitted provided that the following conditions
  |are met:
  |
  |Redistributions of source code must retain the above copyright notice,
  |this list of conditions and the following disclaimer.
  |
  |Redistributions in binary form must reproduce the above copyright
  |notice, this list of conditions and the following disclaimer in the
  |documentation and/or other materials provided with the distribution.
  |
  |Neither the name of the project's author nor the names of its
  |contributors may be used to endorse or promote products derived from
  |this software without specific prior written permission.
  |
  |THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  |"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  |LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  |FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  |HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  |SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES  INCLUDING, BUT NOT LIMITED
  |TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  |PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  |LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  |NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  |SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  |
  |#
 
 (in-package :cl-oid-connect.utils)

 (defparameter *oid* (make-instance '<app>))
 (define-condition user-not-logged-in (error) ())
 

 (eval-when (:compile-toplevel :execute :load-toplevel)
   (defun vars-to-symbol-macrolets (vars obj)
     (iterate:iterate (iterate:for (store key) in (ensure-mapping vars))
                      (iterate:collect `(,store (gethash ,(alexandria:make-keyword key) ,obj))))))
 
 (defmacro with-session-values (vars session &body body)
   (alexandria:once-only (session)
     `(symbol-macrolet ,(vars-to-symbol-macrolets vars session)
        ,@body)))
 
 ; This probably should eventually go?
 (defmacro with-endpoints (endpoint-schema  &body body)

   `(let* ((cl-oid-connect.objects::*endpoint-schema* ,endpoint-schema))

      ,@body))
 
 (defmacro with-session ((var) &body body)
   `(progn
      (format t "The session var is: ~a it contains: ~a~%"  ,(symbol-name var) ,var)
      (let ((,var (context :session)))
        (format t "The session var is: ~a it now contains: ~a~%"  ,(symbol-name var) ,var)
        ,@body)))
 
 (defmacro def-route ((url args &key (app *oid*) (method :GET)) &body body)

   `(setf (route ,app ,url :method ,method)

          (lambda ,args
            (declare (ignorable ,@args))
            ,@body)))

 (defun gen-state (len)
   (with-output-to-string (stream)
     (let ((*print-base* 36))
       (loop repeat len
             do (princ (random 36) stream)))))
 
 (defun valid-state (received-state)
   (let* ((session (context :session))
          (saved-state (gethash :state session)))
     (equal saved-state received-state)))
 
 (defmacro my-with-context-variables ((&rest vars) &body body)
   "This improves fukamachi's version by permitting the variable to be stored somewhere
    besides the symbol corresponding to the keyword."
   `(symbol-macrolet
        ,(loop for (var key) in (ensure-mapping vars)
               for form = `(context ,(intern (string key) :keyword))
               collect `(,var ,form))
      ,@body))
 
 (defmacro string-assoc (key alist) `(assoc ,key ,alist :test #'equal))
 (defmacro assoc-cdr (key alist &optional (test '#'eql)) `(cdr (assoc ,key ,alist :test ,test)))
 
 (defmacro define-auth-entry-point (name endpoint-schema)
   `(defun ,name (params)
      (declare (ignore params))
      (with-session-values (state endpoint-schema) (context :session)
        (setf state (gen-state 36)
              endpoint-schema ,endpoint-schema)
        (with-endpoints ,endpoint-schema

          (multiple-value-bind (content rcode headers uri) (cl-oid-connect.objects:do-auth-request ,endpoint-schema state)

            (declare (ignore headers))
            (if (< rcode 400) `(302 (:location ,(format nil "~a" uri)))
              content))))))
 
 (defmacro define-auth-callback (name endpoint-schema params &body body)
   (with-gensyms (get-app-user-cb cb-params)
     `(defun ,name (,get-app-user-cb)
        (lambda (,cb-params)

          (cl-oid-connect:run-callback-function

            ,endpoint-schema ,cb-params ,get-app-user-cb
            (lambda ,params
              ,@body))))))
 
 (defmacro reject-when-state-invalid (params &body body)
   (alexandria:with-gensyms (received-state)
     (alexandria:once-only (params)
       `(let ((,received-state (cdr (string-assoc "state" ,params))))
          (if (not (valid-state ,received-state))
            '(403 '() "Out, vile imposter!")
         ,@body)))))
 
 (defmacro auth-callback-skeleton (params (&key endpoint-schema auth-session-vars) &body body)
   (alexandria:with-gensyms (session)
     (alexandria:once-only (params endpoint-schema)
       `(reject-when-state-invalid ,params
          (with-endpoints ,endpoint-schema
            (my-with-context-variables ((,session session))
              ,(if (null auth-session-vars)
                 `(progn
                    ,@body)
                 `(with-session-values ,auth-session-vars ,session
                    ,@body))))))))
 
 (defmacro ensure-logged-in (&body body)
   "Ensure that the user is logged in: otherwise throw the condition user-not-logged-in"
   (alexandria:with-gensyms (session userinfo)
     `(my-with-context-variables ((,session session))
        (with-session-values ((,userinfo userinfo)) ,session

          (if ,userinfo
            (progn ,@body) 
            (progn

              (setf ,userinfo nil)

              (format t "Clearing all the infos")
              (error 'user-not-logged-in)))))))

 
 (defmacro setup-oid-connect (app args &body callback)

   `(cl-oid-connect::bind-oid-connect-routes ,app (lambda ,args ,@callback)))

 (defun save-redirect (path)
   (with-session-values (next-page) (context :session)
     (setf next-page path)))
 
 (defun call-with-login (authorized-cb unauthorized-cb)
   (handler-case
     (ensure-logged-in
       (funcall authorized-cb))
     (user-not-logged-in (c)
                         (funcall unauthorized-cb c))))
 
 (defmacro with-login (handler (sub (sym) &body unauthorized-action))
   (unless (eq sub :unauthorized)
     (error 'error "unauthorized clause must start with \"unauthorized\""))
   `(call-with-login
      (lambda ()
        ,handler)
      (lambda (,sym)
        ,@unauthorized-action)))
 

 (flet ((handle-no-user (main-body handler-body)
          `(handler-case (ensure-logged-in ,@main-body)
             (user-not-logged-in (e) (declare (ignorable e))
                                 ,@handler-body))))
 
   (defmacro check-login (&body body)
     "Returns an HTTP 401 Error if not logged in."
     (handle-no-user body `('(401 () "Unauthorized"))))
 
   (defmacro require-login (&body body)
     "Redirects to /login if not logged in."

     (handle-no-user
       body
       `((save-redirect (lack.request:request-path-info *request*))
         '(302 (:location "/login"))))))

 
 (defmacro redirect-if-necessary (sessionvar &body body)
   (with-gensyms (session)
     `(let* ((,session ,sessionvar)
             (next-page (gethash :next-page ,session)))
        (if (and (not (null next-page))
                 (not (string= next-page (lack.request:request-path-info *request*))))
          (progn
            (setf (gethash :next-page ,session) nil)

            `(302 (:location ,next-page)))
          (progn
            ,@body)))))