git.fiddlerwoaroof.com
Browse code

Cleaning up cl-oid-connect

- Reducing duplication in the authentication callbacks

fiddlerwoaroof authored on 17/10/2015 20:30:41
Showing 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))
... ...
@@ -11,8 +11,8 @@
11 11
     #:cl-who
12 12
     #:drakma
13 13
     ;#:lack-middleware-session
14
+    #:iterate
14 15
     #:ningle
15
-    #:lass
16 16
     #:lquery
17 17
     #:plump
18 18
     #:sheeple