#|
 |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)))))