Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 267 lines (206 sloc) 10.474 kb
d93ecd86 »
2011-10-08 An (untested, toy) implementation of the cl-stripe API for Common Lisp.
1 ;;;; cl-stripe.lisp
2
98816b5c »
2011-10-12 Some renamings: api keys and the "stripe" package.
3 (in-package #:stripe)
d93ecd86 »
2011-10-08 An (untested, toy) implementation of the cl-stripe API for Common Lisp.
4
5 ;;; The basics:
6
98816b5c »
2011-10-12 Some renamings: api keys and the "stripe" package.
7 (defun set-default-api-key (key)
8 (setf *default-api-key* key))
d93ecd86 »
2011-10-08 An (untested, toy) implementation of the cl-stripe API for Common Lisp.
9
10 ;;; Resource access
11
12 (defparameter *resource-url-patterns*
13 '((:charges . "/v1/charges")
14 (:charge . "/v1/charges/~a")
15 (:refund . "/v1/charges/~a/refund")
16 (:customers . "/v1/customers")
17 (:customer . "/v1/customers/~a")
18 (:subscription . "/v1/customers/~a/subscription")
19 (:invoices . "/v1/invoices")
20 (:upcoming-invoice . "/v1/invoices/upcoming")
21 (:invoice . "/v1/invoices/~a")
22 (:invoice-items . "/v1/invoiceitems")
23 (:invoice-item . "/v1/invoiceitems/~a")
24 (:tokens . "/v1/tokens")
25 (:token . "/v1/tokens/~a")
26 (:plans . "/v1/plans")
27 (:plan . "/v1/plans/~a")))
28
29 (defun make-resource-url (name &optional id)
30 (alexandria:when-let ((path (cdr (assoc name *resource-url-patterns*))))
31 (if id
32 (format nil "~a~@?" *endpoint* path id)
33 (concatenate 'string *endpoint* path))))
34
35 (define-condition stripe-error (error)
36 ((url :initarg :url :reader stripe-error-request-url)
37 (method :initarg :method :reader stripe-error-request-method)
38 (request-body :initarg :body :reader stripe-error-request-body)
39
40 (code :initarg :code :reader stripe-error-code)
41 (reply :initarg :reply :reader stripe-error-reply)))
42
43 (defmethod print-object ((o stripe-error) stream)
44 (print-unreadable-object (o stream :type t)
45 (format stream "while ~aing ~a: ~a"
46 (stripe-error-request-method o) (stripe-error-request-url o)
47 (sstruct-get (stripe-error-reply o) :error :message))))
48
49 (define-condition unknown-stripe-error (stripe-error) ())
50
51 (macrolet ((deferror (name code)
52 `(progn (define-condition ,name (stripe-error) ())
53 (defmethod translate-stripe-http-code ((code (eql ,code)) reply method url body)
54 (error ',name :code code :reply reply :method method :url url :body body)))))
55
56 (defgeneric translate-stripe-http-code (code structure method url body)
57 (:method ((code (eql 200)) reply method url body)
58 "Everything went according to plan."
59 (declare (ignore method url body))
60 reply)
61 (:method (code reply method url body)
62 "Unknown HTTP status code - something went wrong, and we don't know what."
63 (error 'unknown-stripe-error :code code :reply reply :method method :url url :body body)))
64
65 (deferror stripe-bad-request 400)
66 (deferror stripe-unauthorized 401)
67 (deferror stripe-request-failed 402)
68 (deferror stripe-not-found 404)
69 (deferror stripe-internal-error-500 500)
70 (deferror stripe-internal-error-502 502)
71 (deferror stripe-internal-error-503 503)
72 (deferror stripe-internal-error-504 504))
73
98816b5c »
2011-10-12 Some renamings: api keys and the "stripe" package.
74 (defun issue-query (resource-name &key (api-key *default-api-key*) (method :get) id parameters)
d93ecd86 »
2011-10-08 An (untested, toy) implementation of the cl-stripe API for Common Lisp.
75 (multiple-value-bind (response-stream code headers url)
76 (drakma:http-request (make-resource-url resource-name id)
77 :method method
78 :parameters parameters
98816b5c »
2011-10-12 Some renamings: api keys and the "stripe" package.
79 :basic-authorization (list api-key "")
d93ecd86 »
2011-10-08 An (untested, toy) implementation of the cl-stripe API for Common Lisp.
80 :content-length t
81 :want-stream t)
82 (declare (ignore headers))
83 (let ((json-reply (jso->sstruct (st-json:read-json response-stream))))
84 (translate-stripe-http-code code json-reply method url parameters))))
85
86 (let ((card-valid-keys '("number" "exp_month" "exp_year" "cvc" "name"
87 "address_line1" "address_line2" "address_zip"
88 "address_state" "address_country")))
89 (defgeneric translate-request-parameter (name value)
90 (:method ((name (eql :card)) (value string))
91 (list (cons "card" value)))
92
93 (:method ((name (eql :card)) (key-values cons))
94 "Transform a PLIST into a card[] dictionary-style URL parameter list for drakma."
95 (loop for (key value) on key-values by #'cddr
96 for normalized-key = (find key card-valid-keys :test #'string-equal/underscore)
97 unless key
98 do (cerror "Card subkey ~s is not a valid name. Expected one of ~s"
99 key card-valid-keys)
100 collect (cons (format nil "card[~a]" normalized-key) value)))
101
102 (:method ((name (eql :card)) (key-values st-json:jso))
103 (loop for key in card-valid-keys
104 for value = (case-insensitive-getjso key key-values)
105 when value
106 collect (cons (format nil "card[~a]" key) value)))
107
108 (:method ((name (eql :card)) (key-values sstruct))
109 (translate-request-parameter name (sstruct->jso key-values)))
110
111 (:method ((name (eql :card)) (key-values t))
112 (error "Don't know how to translate ~s to a card spec dictionary"
113 key-values))
114
115 (:method ((name symbol) (value string))
116 (list (cons (substitute #\_ #\- (string-downcase (string name))) value)))
117
118 (:method (name (value integer))
119 (translate-request-parameter name (write-to-string value)))
120
121 (:method ((name string) (value string))
122 (list (cons name value)))))
123
124 (defun translate-request-parameters (parameters)
125 "Translate PLIST parameters into an ALIST that drakma likes."
126 (loop for (key value) on parameters by #'cddr
127 for translated-alist = (translate-request-parameter key value)
128 when translated-alist
129 nconc translated-alist))
130
131 (eval-when (:compile-toplevel :load-toplevel :execute)
132 (defparameter *verb-http-methods* '((:retrieve . :get)
133 (:list . :get)
134 (:create . :post)
135 (:update . :post)
136 (:delete . :delete)
137 (:refund . :post))))
138
139 (eval-when (:compile-toplevel :load-toplevel :execute)
140 (defun external-symbol-p (find-symbol package)
141 (do-external-symbols (sym package)
142 (when (eql sym find-symbol)
143 (return-from external-symbol-p t)))
144 nil))
145
146 (defmacro def-api-call (verb object-and-args (&rest parameters)
147 url)
148 (let* ((object (if (consp object-and-args)
149 (car object-and-args)
150 object-and-args))
151 (args (when (consp object-and-args)
152 (cdr object-and-args))))
153 (destructuring-bind (&key (http-resource object) id (return-id id)) args
98816b5c »
2011-10-12 Some renamings: api keys and the "stripe" package.
154 (let ((function-name (format-symbol :stripe '#:~a-~a verb object)))
d93ecd86 »
2011-10-08 An (untested, toy) implementation of the cl-stripe API for Common Lisp.
155 (assert (external-symbol-p function-name *package*))
156 `(defun ,function-name
157 (,@(when id `(id))
98816b5c »
2011-10-12 Some renamings: api keys and the "stripe" package.
158 ,@(when parameters `(&rest parameters))
159 &key ,@parameters
160 (api-key *default-api-key*))
d93ecd86 »
2011-10-08 An (untested, toy) implementation of the cl-stripe API for Common Lisp.
161 ,url
162 (declare (ignore ,@parameters))
163 (let ((result
98816b5c »
2011-10-12 Some renamings: api keys and the "stripe" package.
164 (issue-query ,http-resource :api-key api-key ,@(when id `(:id id))
d93ecd86 »
2011-10-08 An (untested, toy) implementation of the cl-stripe API for Common Lisp.
165 :method ,(cdr (assoc verb *verb-http-methods*))
166 ,@(when parameters
167 `(:parameters (translate-request-parameters parameters))))))
168 ,(if return-id
169 `(values result (sstruct-get result :id))
170 `result)))))))
171
172 ;;; The API implementation:
173
174
175 ;;; Charges
1fe6bfff »
2011-10-12 Add a few tests using clucumber and fix bugs exposed.
176 (def-api-call :create (:charge :http-resource :charges :return-id t)
d93ecd86 »
2011-10-08 An (untested, toy) implementation of the cl-stripe API for Common Lisp.
177 (amount currency customer card description)
178 "https://stripe.com/api/docs#create_charge")
179
180 (def-api-call :retrieve (:charge :id t) ()
181 "https://stripe.com/api/docs#retrieve_charge")
182
183 (def-api-call :refund (:charge :http-resource :refund :id t) (amount)
184 "https://stripe.com/api/docs#refund_charge")
185
186 (def-api-call :list :charges (customer count offset)
187 "https://stripe.com/api/docs#list_charges")
188
189
190 ;;; Customers
1fe6bfff »
2011-10-12 Add a few tests using clucumber and fix bugs exposed.
191 (def-api-call :create (:customer :http-resource :customers :return-id t)
d93ecd86 »
2011-10-08 An (untested, toy) implementation of the cl-stripe API for Common Lisp.
192 (card coupon email description plan trial-end)
193 "https://stripe.com/api/docs#create_customer")
194
195 (def-api-call :retrieve (:customer :id t) ()
196 "https://stripe.com/api/docs#retrieve_customer")
197
198 (def-api-call :update (:customer :id t) (card coupon email description)
199 "https://stripe.com/api/docs#update_customer")
200
201 (def-api-call :delete (:customer :id t) ()
202 "https://stripe.com/api/docs#delete_customer")
203
204 (def-api-call :list :customers (count offset)
205 "https://stripe.com/api/docs#list_customers")
206
207
208 ;;; Card Tokens
1fe6bfff »
2011-10-12 Add a few tests using clucumber and fix bugs exposed.
209 (def-api-call :create (:token :http-resource :tokens :return-id t) (card amount currency)
d93ecd86 »
2011-10-08 An (untested, toy) implementation of the cl-stripe API for Common Lisp.
210 "https://stripe.com/api/docs#create_token")
211
212 (def-api-call :retrieve (:token :id t) ()
213 "https://stripe.com/api/docs#retrieve_token")
214
215
216
217 ;;; Subscriptions
218 (def-api-call :update (:subscription :id t) (plan coupon prorate trial-end card)
219 "https://stripe.com/api/docs#update_subscription")
220
221 (def-api-call :delete (:subscription :id t) (at-period-end)
222 "https://stripe.com/api/docs#cancel_subscription")
223
224
225 ;;; Plans
226 (def-api-call :create (:plan :http-resource :plans :return-id t)
227 (id amount currency interval name trial-period-days)
228 "https://stripe.com/api/docs#create_plan")
229
230 (def-api-call :retrieve (:plan :id t) ()
231 "https://stripe.com/api/docs#retrieve_plan")
232
233 (def-api-call :delete (:plan :id t) ()
234 "https://stripe.com/api/docs#delete_plan")
235
236 (def-api-call :list :plans (count offset)
237 "https://stripe.com/api/docs#list_plans")
238
239
240
241 ;;; Invoices
242 (def-api-call :retrieve (:invoice :id t) ()
243 "https://stripe.com/api/docs#list_plans")
244
245 (def-api-call :retrieve :upcoming-invoice (customer)
246 "https://stripe.com/api/docs#retrieve_customer_invoice")
247
248 (def-api-call :list :invoices (customer count offset)
249 "https://stripe.com/api/docs#list_customer_invoices")
250
251
252 ;;; Invoice items
1fe6bfff »
2011-10-12 Add a few tests using clucumber and fix bugs exposed.
253 (def-api-call :create (:invoice-item :http-resource :invoice-items :return-id t)
d93ecd86 »
2011-10-08 An (untested, toy) implementation of the cl-stripe API for Common Lisp.
254 (customer amount currency description)
255 "https://stripe.com/api/docs#create_invoiceitem")
256
257 (def-api-call :retrieve (:invoice-item :id t) ()
258 "https://stripe.com/api/docs#retrieve_invoiceitem")
259
260 (def-api-call :update (:invoice-item :id t) (amount currency description)
261 "https://stripe.com/api/docs#update_invoiceitem")
262
263 (def-api-call :delete (:invoice-item :id t) ()
264 "https://stripe.com/api/docs#delete_invoiceitem")
265
266 (def-api-call :list :invoice-items (customer count offset)
1fe6bfff »
2011-10-12 Add a few tests using clucumber and fix bugs exposed.
267 "https://stripe.com/api/docs#list_invoiceitems")
Something went wrong with that request. Please try again.