Browse code
Cleaning up cl-oid-connect
- Reducing duplication in the authentication callbacks
fiddlerwoaroof authored on 17/10/2015 20:30:41Showing 2 changed files
... | ... |
@@ -93,7 +93,7 @@ |
93 | 93 |
(token-endpoint "https://graph.facebook.com/v2.3/oauth/access_token") |
94 | 94 |
(userinfo-endpoint "https://graph.facebook.com/v2.3/me") |
95 | 95 |
(auth-scope "email") |
96 |
- (redirect-uri "http://whitespace.elangley.org/oidc_callback/facebook"))) |
|
96 |
+ (redirect-uri "http://srv2.elangley.org:9090/oidc_callback/facebook"))) |
|
97 | 97 |
|
98 | 98 |
(sheeple:defreply get-access-token ((endpoint-schema *fbook-endpoint-schema*) (code sheeple:=string=)) |
99 | 99 |
(cl-json:decode-json-from-string |
... | ... |
@@ -169,6 +169,18 @@ |
169 | 169 |
(if (< rcode 400) `(302 (:location ,(format nil "~a" uri))) |
170 | 170 |
content)))))) |
171 | 171 |
|
172 |
+(flet ((get-code (params) (assoc-cdr "code" params #'equal))) |
|
173 |
+ (defun run-callback-function (endpoint-schema params get-login-data get-app-user-cb) |
|
174 |
+ (let ((a-t (get-access-token endpoint-schema (get-code params)))) |
|
175 |
+ (auth-callback-skeleton params (:endpoint-schema endpoint-schema |
|
176 |
+ :auth-session-vars (accesstoken userinfo idtoken app-user)) |
|
177 |
+ (multiple-value-bind (access-token user-info id-token) (funcall get-login-data a-t) |
|
178 |
+ (setf accesstoken access-token |
|
179 |
+ userinfo user-info |
|
180 |
+ idtoken id-token |
|
181 |
+ app-user (funcall get-app-user-cb user-info id-token access-token))) |
|
182 |
+ '(302 (:location "/")))))) |
|
183 |
+ |
|
172 | 184 |
(defmacro def-callback-generator (name generator-args callback-args &body body) |
173 | 185 |
`(defun ,name ,generator-args |
174 | 186 |
(lambda ,callback-args |
... | ... |
@@ -188,8 +200,11 @@ |
188 | 200 |
`(reject-when-state-invalid ,params |
189 | 201 |
(with-endpoints ,endpoint-schema |
190 | 202 |
(my-with-context-variables ((,session session)) |
191 |
- (with-session-values ,auth-session-vars ,session |
|
192 |
- ,@body))))))) |
|
203 |
+ ,(if (null auth-session-vars) |
|
204 |
+ `(progn |
|
205 |
+ ,@body) |
|
206 |
+ `(with-session-values ,auth-session-vars ,session |
|
207 |
+ ,@body)))))))) |
|
193 | 208 |
|
194 | 209 |
(define-condition user-not-logged-in (error) ()) |
195 | 210 |
|
... | ... |
@@ -261,7 +276,7 @@ |
261 | 276 |
(discover-endpoints *goog-endpoint-schema* |
262 | 277 |
"https://accounts.google.com/.well-known/openid-configuration" |
263 | 278 |
:gat #'goog-get-access-token) |
264 |
- (setf (redirect-uri *goog-endpoint-schema*) "http://whitespace.elangley.org/oidc_callback/google")) |
|
279 |
+ (setf (redirect-uri *goog-endpoint-schema*) "http://srv2.elangley.org:9090/oidc_callback/google")) |
|
265 | 280 |
|
266 | 281 |
(sheeple:defreply get-user-info ((endpoint-schema *goog-endpoint-schema*) (access-token sheeple:=string=)) |
267 | 282 |
(format t "getting user data: ~a~%" "blarg") |
... | ... |
@@ -274,42 +289,24 @@ |
274 | 289 |
(auth-entry-point google-login-entry *goog-endpoint-schema*) |
275 | 290 |
(auth-entry-point facebook-login-entry *fbook-endpoint-schema*) |
276 | 291 |
|
277 |
-(flet ((get-code (params) (assoc-cdr "code" params #'equal))) |
|
292 |
+(labels ((get-real-access-token (a-t) (assoc-cdr :access--token a-t)) |
|
293 |
+ (get-id-token (a-t) (cljwt:decode (assoc-cdr :id--token a-t) :fail-if-unsupported nil)) |
|
294 |
+ (get-login-data (a-t) |
|
295 |
+ (let ((access-token (get-real-access-token a-t))) |
|
296 |
+ (values access-token |
|
297 |
+ (get-user-info *goog-endpoint-schema* access-token) |
|
298 |
+ (get-id-token a-t))))) |
|
278 | 299 |
|
279 | 300 |
(def-callback-generator google-callback (get-app-user-cb) (params) |
301 |
+ (run-callback-function *goog-endpoint-schema* params #'get-login-data get-app-user-cb))) |
|
280 | 302 |
|
281 |
- (labels ((get-real-access-token (a-t) (assoc-cdr :access--token a-t)) |
|
282 |
- (get-id-token (a-t) (cljwt:decode (assoc-cdr :id--token a-t) :fail-if-unsupported nil)) |
|
283 |
- (get-login-data (a-t) |
|
284 |
- (let ((access-token (get-real-access-token a-t))) |
|
285 |
- (values access-token |
|
286 |
- (get-user-info *goog-endpoint-schema* access-token) |
|
287 |
- (get-id-token a-t))))) |
|
288 |
- |
|
289 |
- (let ((a-t (get-access-token *goog-endpoint-schema* (get-code params)))) |
|
290 |
- (auth-callback-skeleton params (:endpoint-schema *goog-endpoint-schema* |
|
291 |
- :auth-session-vars (accesstoken userinfo idtoken app-user)) |
|
292 |
- (multiple-value-bind (access-token user-info id-token) (get-login-data a-t) |
|
293 |
- (setf |
|
294 |
- accesstoken access-token |
|
295 |
- userinfo user-info |
|
296 |
- idtoken id-token |
|
297 |
- app-user (funcall get-app-user-cb user-info id-token access-token))) |
|
298 |
- '(302 (:location "/")))))) |
|
303 |
+(labels ((get-id-token (a-t) (assoc-cdr :access--token a-t)) ; <-- access--token is not a mistake |
|
304 |
+ (get-login-data (a-t) |
|
305 |
+ (let ((id-token (get-id-token a-t))) |
|
306 |
+ (values a-t (get-user-info *fbook-endpoint-schema* id-token) id-token)))) |
|
299 | 307 |
|
300 | 308 |
(def-callback-generator facebook-callback (get-app-user-cb) (params) |
301 |
- (auth-callback-skeleton params (:endpoint-schema *fbook-endpoint-schema* |
|
302 |
- :auth-session-vars (accesstoken userinfo idtoken app-user)) |
|
303 |
- (flet ((get-id-token (a-t) (assoc-cdr :access--token a-t))) ; <-- access--token is not a mistake |
|
304 |
- (let* ((a-t (get-access-token *fbook-endpoint-schema* (get-code params))) |
|
305 |
- (id-token (get-id-token a-t)) |
|
306 |
- (user-info (get-user-info *fbook-endpoint-schema* id-token))) |
|
307 |
- (setf |
|
308 |
- accesstoken a-t |
|
309 |
- app-user (funcall get-app-user-cb user-info id-token a-t) |
|
310 |
- idtoken id-token |
|
311 |
- userinfo user-info) |
|
312 |
- '(302 (:location "/"))))))) |
|
309 |
+ (run-callback-function *fbook-endpoint-schema* params #'get-login-data get-app-user-cb))) |
|
313 | 310 |
|
314 | 311 |
(defun userinfo-route (params) |
315 | 312 |
(declare (ignore params)) |