Revision: 3664 Author: hans URL: http://bknr.net/trac/changeset/3664
Further testing with PayPal EC API
U trunk/projects/quickhoney/src/packages.lisp U 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-28 14:39:46 UTC (rev 3663) +++ trunk/projects/quickhoney/src/packages.lisp 2008-07-28 14:44:00 UTC (rev 3664) @@ -56,7 +56,11 @@ (defpackage :paypal (:use :cl) (:export #:request - #:make-express-checkout-url)) + #:make-express-checkout-url + #:paypal-error + #:request-error + #:http-request-error + #:response-error))
(defpackage :paypal-test (:use :cl)) \ No newline at end of file
Modified: trunk/projects/quickhoney/src/paypal-test.lisp =================================================================== --- trunk/projects/quickhoney/src/paypal-test.lisp 2008-07-28 14:39:46 UTC (rev 3663) +++ trunk/projects/quickhoney/src/paypal-test.lisp 2008-07-28 14:44:00 UTC (rev 3664) @@ -1,5 +1,4 @@ (in-package :paypal-test) - (defgeneric dispatch-request (request-type request) (:documentation "dispatch incoming http request"))
@@ -18,14 +17,25 @@
(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)))) + (format nil "http://~A:~A/return-paypal" *response-host* *response-port*) + (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") + (with-output-to-string (*standard-output*) + (let* ((token (tbnl:get-parameter "token")) + (response (paypal:request "GetExpressCheckoutDetails" :token token)) + (payerid (getf response :payerid)) + (amt (getf response :amt)) + (currencycode (getf response :currencycode))) + (print (paypal:request "DoExpressCheckoutPayment" + :token token + :payerid payerid + :amt amt + :currencycode currencycode + :paymentaction "Sale")))))
(define-handler :cancel-paypal (request) "Cancelled")
Modified: trunk/projects/quickhoney/src/paypal.lisp =================================================================== --- trunk/projects/quickhoney/src/paypal.lisp 2008-07-28 14:39:46 UTC (rev 3663) +++ trunk/projects/quickhoney/src/paypal.lisp 2008-07-28 14:44:00 UTC (rev 3664) @@ -2,20 +2,27 @@
(defparameter *paypal-url* "https://api-3t.sandbox.paypal.com/nvp" "NVP URL of the Paypal server") -(defparameter *paypal-user* "sdk-three_api1.sdk.com" +(defparameter *paypal-user* "hans.huebner_api1.gmail.com" "Username to use to authenticate at the Paypal server") -(defparameter *paypal-password* "QFZCWN5HZM8VBG7Q" +(defparameter *paypal-password* "62QFQPLEMM6P3M25" "Password to use to authenticate at the Paypal server") -(defparameter *paypal-signature* "A-IzJhZZjhg29XQ2qnhapuwxIDzyAZQ92FRP5dqBzVesOkzbdUONzmOU" +(defparameter *paypal-signature* "AFcWxV21C7fd0v3bYYYRCpSSRl31Ac-RAs1SuG20a1IoPMJ0WKbx0fdG" "Signature to use to authenticate at the Paypal server")
-(define-condition request-error (error) +(define-condition paypal-error (error) + ()) + +(define-condition request-error (paypal-error) ((response :initarg :response)))
-(define-condition http-request-error (error) +(define-condition http-request-error (paypal-error) ((http-status :initarg :http-status) (response-string :initarg :response-string)))
+(define-condition response-error (paypal-error) + ((response :initarg :response) + (invalid-parameter :initarg :invalid-parameter))) + (defun decode-response (response) "Decode a paypal response string, which is URL encoded and follow list encoding rules. Returns the parameters as a plist." @@ -28,9 +35,9 @@ (index (parse-integer (aref registers 1))) (previous-value (gethash parameter hash))) (unless (= (length previous-value) index) - (error "unexpected list value ~A in Paypal response ~S" parameter-string response)) - (setf (gethash parameter hash) (append previous-value (list (hunchentoot:url-decode value))))) - (setf (gethash (intern parameter-string :keyword) hash) (hunchentoot:url-decode value)))))) + (error 'response-error :invalid-parameter parameter-string :response response)) + (setf (gethash parameter hash) (append previous-value (list (hunchentoot:url-decode value :utf-8))))) + (setf (gethash (intern parameter-string :keyword) hash) (hunchentoot:url-decode value :utf-8)))))) (loop for key being the hash-keys of hash collect key collect (gethash key hash)))) @@ -49,7 +56,9 @@ (cons "SIGNATURE" *paypal-signature*)) (loop for (param value) on args by #'cddr collect (cons (symbol-name param) - (if (stringp value) value (princ-to-string value)))))) + (if (stringp value) + value + (princ-to-string value)))))) (unless (= 200 http-status) (error 'http-request-error :http-status http-status :response-string response-string)) (let ((response (decode-response response-string)))