Revision: 3650 Author: hans URL: http://bknr.net/trac/changeset/3650 Add beginnings of round-trip test environment for Paypal Express Checkout. U trunk/projects/quickhoney/src/packages.lisp A trunk/projects/quickhoney/src/paypal-test.lisp U trunk/projects/quickhoney/src/paypal.lisp Modified: trunk/projects/quickhoney/src/packages.lisp =================================================================== --- trunk/projects/quickhoney/src/packages.lisp 2008-07-26 22:06:44 UTC (rev 3649) +++ trunk/projects/quickhoney/src/packages.lisp 2008-07-27 10:07:06 UTC (rev 3650) @@ -54,4 +54,9 @@ (:export #:client-selectbox)) (defpackage :paypal + (:use :cl) + (:export #:request + #:make-express-checkout-url)) + +(defpackage :paypal-test (:use :cl)) \ No newline at end of file Added: trunk/projects/quickhoney/src/paypal-test.lisp =================================================================== --- trunk/projects/quickhoney/src/paypal-test.lisp (rev 0) +++ trunk/projects/quickhoney/src/paypal-test.lisp 2008-07-27 10:07:06 UTC (rev 3650) @@ -0,0 +1,43 @@ +(in-package :paypal-test) + +(defgeneric dispatch-request (request-type request) + (:documentation "dispatch incoming http request")) + +(defmethod no-applicable-method ((function (eql #'dispatch-request)) &rest args) + (declare (ignore args)) + nil) + +(defmacro define-handler (type (request) &body body) + (let ((request-type-var (gensym))) + `(defmethod dispatch-request ((,request-type-var (eql ,type)) ,request) + (declare (ignore ,request-type-var)) + (lambda () ,@body)))) + +(defvar *response-host* nil) +(defvar *response-port* nil) + +(define-handler :checkout (request) + (tbnl:redirect (paypal:make-express-checkout-url 10 :eur + :returnurl (format nil "http://~A:~A/return-paypal" response-host response-port) + :cancelurl (format nil "http://~A:~A/cancel-paypal" response-host response-port)))) + +(define-handler :stop (request) + (throw 'stop-server nil)) + +(define-handler :return-paypal (request) + "Returned from paypal") + +(define-handler :cancel-paypal (request) + "Cancelled") + +(defun dispatch-request% (request) + (let* ((type-string (cl-ppcre:scan-to-strings "[^/]+" (tbnl:script-name request))) + (request-type (and type-string (find-symbol (string-upcase type-string) :keyword)))) + (dispatch-request request-type request))) + +(defun test-express-checkout (&key (response-port 2993) (response-host "127.0.0.1")) + (setf *response-host* response-host + *response-port* response-port) + (catch 'stop-server + (tbnl:start-server :port response-port + :dispatch-table (list #'dispatch-request%)))) Modified: trunk/projects/quickhoney/src/paypal.lisp =================================================================== --- trunk/projects/quickhoney/src/paypal.lisp 2008-07-26 22:06:44 UTC (rev 3649) +++ trunk/projects/quickhoney/src/paypal.lisp 2008-07-27 10:07:06 UTC (rev 3650) @@ -57,21 +57,20 @@ (error 'request-error :response response)) response))) -(defun test-express-checkout () - (let* ((amt "50.00") - (currencycode "EUR") - (returnurl "http://test.createrainforest.org/return-paypal") - (cancelurl "http://test.createrainforest.org/cancel-paypal") +(defun make-express-checkout-url (amount currencycode returnurl cancelurl) + (let* ((amt (format nil "~,2F" amount)) + (currencycode (symbol-name currencycode)) (token (getf (request "SetExpressCheckout" - :amt amt - :currencycode currencycode - :returnurl returnurl - :cancelurl cancelurl - :paymentaction "Sale") - :token))) - (format *trace-output* "url: https://www.sandbox.paypal.com/webscr?cmd=_express-checkout&token=~A~ - &AMT=~A&CURRENCYCODE=~A&RETURNURL=~A&CANCELURL=~A" + :amt amt + :currencycode currencycode + :returnurl returnurl + :cancelurl cancelurl + :paymentaction "Sale") + :token))) + (format nil "https://www.sandbox.paypal.com/webscr?cmd=_express-checkout&token=~A~ + &AMT=~A&CURRENCYCODE=~A&RETURNURL=~A&CANCELURL=~A" (hunchentoot:url-encode token) amt currencycode (hunchentoot:url-encode returnurl) - (hunchentoot:url-encode cancelurl)))) \ No newline at end of file + (hunchentoot:url-encode cancelurl)))) +