/src/core/request-adapter.lisp
Lisp | 103 lines | 78 code | 20 blank | 5 comment | 3 complexity | 62799fbc7579b6322c8725088e90b11d MD5 | raw file
1(in-package :oauth) 2 3;;; server-specific request abstraction layer 4;;; 5;;; defaults to Hunchentoot 6 7(export '(request-adapter 8 make-request-adapter 9 *request-adapter* 10 make-hunchentoot-request-adapter 11 init-default-request-adapter 12 *request* 13 request 14 request-method 15 request-uri 16 abort-request 17 auth-parameters 18 post-parameters 19 get-parameters)) ; TODO move to package.lisp 20 21 22#.`(defstruct request-adapter ; TODO: make this a standard-class, too 23 "An adapter for server-specific parts of OAuth. 24The return value of REQUEST-OBJECT-FN must be comparable with EQ." 25 ,@(loop for slotname in '(request-object-fn 26 request-method-fn 27 request-uri-fn 28 abort-request-fn 29 auth-parameters-fn 30 post-parameters-fn 31 get-parameters-fn) 32 collect `(,slotname nil :type (or function symbol null)))) 33 34(defun make-hunchentoot-request-adapter () 35 (make-request-adapter :request-object-fn (lambda () hunchentoot:*request*) 36 :request-uri-fn (lambda (request) 37 (let* ((http-host (split-sequence #\: (hunchentoot:host request))) 38 (hostname (first http-host)) 39 (port (second http-host))) 40 (make-instance 'puri:uri 41 :scheme (etypecase hunchentoot:*acceptor* 42 (hunchentoot:ssl-acceptor :https) 43 (hunchentoot:acceptor :http)) 44 :host hostname 45 :port port 46 :path (hunchentoot:script-name* request)))) 47 :request-method-fn 'hunchentoot:request-method* 48 :abort-request-fn 'hunchentoot:abort-request-handler 49 :auth-parameters-fn (lambda (request) (declare (ignore request)) nil) ; TODO 50 :post-parameters-fn 'hunchentoot:post-parameters* 51 :get-parameters-fn 'hunchentoot:get-parameters*)) 52 53 54(defvar *request-adapter* nil 55 "Set this variable to an instance of REQUEST-ADAPTER tailored to 56 your web server.") 57 58(defun init-default-request-adapter () 59 (setf *request-adapter* (make-hunchentoot-request-adapter))) 60 61(init-default-request-adapter) 62 63(defvar *request* nil 64 "User-supplied request override. Only if you know what you're doing.") 65 66(defun request () 67 (or *request* ; allow request object override 68 (funcall (request-adapter-request-object-fn *request-adapter*)))) 69 70(defun request-method (&optional (request (request))) 71 (let* ((result (funcall (request-adapter-request-method-fn *request-adapter*) request)) 72 (normalized-result (etypecase result 73 (keyword result) 74 (symbol (intern (symbol-name result) :keyword)) 75 (string (intern result :keyword))))) 76 (assert (member normalized-result '(:get :post :put :delete :head :trace :options :connect))) 77 result)) 78 79(defun request-uri (&optional (request (request))) 80 "Return the request uri including protocol, host, port 81and path. Other parts like the query string are optional and 82will be ignored. The result type is (or string puri:uri)." 83 ;; TODO: cache this 84 (let ((result (funcall (request-adapter-request-uri-fn *request-adapter*) request))) 85 (check-type result (or string puri:uri)) 86 result)) 87 88;; TODO: assertions/type checks for the following functions 89 90(defun auth-parameters (&optional (request (request))) 91 (funcall (request-adapter-auth-parameters-fn *request-adapter*) request)) 92 93(defun post-parameters (&optional (request (request))) 94 (funcall (request-adapter-post-parameters-fn *request-adapter*) request)) 95 96(defun get-parameters (&optional (request (request))) 97 (funcall (request-adapter-get-parameters-fn *request-adapter*) request)) 98 99 100(defun abort-request (result) 101 "Return the string RESULT immediately from the request handler." 102 (funcall (request-adapter-abort-request-fn *request-adapter*) result)) 103