git.fiddlerwoaroof.com
Browse code

Minor tweaks to make the package work post-split

fiddlerwoaroof authored on 06/11/2015 06:50:14
Showing 4 changed files
... ...
@@ -49,11 +49,6 @@
49 49
                 app-user (funcall get-app-user-cb user-info id-token access-token)))
50 50
         '(302 (:location "/"))))))
51 51
 
52
-(define-condition user-not-logged-in (error) ())
53
-
54
-
55
-
56
-
57 52
 
58 53
 (defun load-provider-secrets (provider-info secrets)
59 54
   (setf (client-id provider-info) (assoc-cdr :client-id secrets)
... ...
@@ -33,23 +33,24 @@
33 33
 
34 34
 (in-package :cl-oid-connect.objects)
35 35
 
36
-(defparameter *oid* (make-instance 'ningle:<app>))
37 36
 (setf drakma:*text-content-types* (cons '("application" . "json") drakma:*text-content-types*))
38 37
 
39
-(setf =service-info= (object :parents '()
40
-                             :properties '((client-id nil :accessor client-id)
41
-                                           (secret nil :accessor secret))))
38
+(defparameter =service-info=
39
+  (object :parents '()
40
+          :properties '((client-id nil :accessor client-id)
41
+                        (secret nil :accessor secret))))
42 42
 (defparameter *fbook-info* (clone =service-info=))
43 43
 (defparameter *goog-info* (clone =service-info=))
44
-
45
-(setf =endpoint-schema= (object :parents '()
46
-                                :properties '((auth-endpoint nil :accessor auth-endpoint)
47
-                                              (token-endpoint nil :accessor token-endpoint)
48
-                                              (userinfo-endpoint nil :accessor t)
49
-                                              (auth-scope "openid profile email" :accessor t)
50
-                                              (redirect-uri nil :accessor t))))
51 44
 (defparameter *endpoint-schema* nil)
52 45
 
46
+(defparameter =endpoint-schema=
47
+  (object :parents '()
48
+          :properties '((auth-endpoint nil :accessor auth-endpoint)
49
+                        (token-endpoint nil :accessor token-endpoint)
50
+                        (userinfo-endpoint nil :accessor t)
51
+                        (auth-scope "openid profile email" :accessor t)
52
+                        (redirect-uri nil :accessor t))))
53
+
53 54
 (defmessage get-user-info (a b))
54 55
 (defmessage get-access-token (a b))
55 56
 (defmessage discover-endpoints (a b c))
... ...
@@ -1,15 +1,19 @@
1 1
 ;;;; package.lisp
2 2
 
3 3
 (defpackage #:cl-oid-connect.utils
4
-  (:use #:cl #:alexandria #:anaphora #:fwoar.lisputils)
4
+  (:use #:cl #:alexandria #:anaphora #:fwoar.lisputils #:ningle)
5 5
   (:export #:vars-to-symbol-macrolets #:with-session-values #:with-endpoints
6 6
            #:with-session #:def-route #:gen-state #:valid-state #:my-with-context-variables
7 7
            #:string-assoc #:assoc-cdr #:define-auth-entry-point #:define-auth-callback
8 8
            #:reject-when-state-invalid #:auth-callback-skeleton #:ensure-logged-in
9
-           #:setup-oid-connect #:check-login #:require-login #:redirect-if-necessary))
9
+           #:setup-oid-connect #:check-login #:require-login #:redirect-if-necessary
10
+           #:*oid* #:user-not-logged-in))
10 11
 
11 12
 (defpackage #:cl-oid-connect.objects
12
-  (:use #:cl #:alexandria #:anaphora #:fwoar.lisputils #:cl-oid-connect.utils #:sheeple))
13
+  (:use #:cl #:alexandria #:anaphora #:fwoar.lisputils #:cl-oid-connect.utils #:sheeple)
14
+  (:export #:*fbook-info* #:*goog-info* #:*fbook-endpoint-schema* #:*goog-endpoint-schema*
15
+           #:get-user-info #:get-access-token #:client-id #:secret #:redirect-uri
16
+           #:token-endpoint #:discover-endpoints #:do-auth-request))
13 17
 
14 18
 (defpackage #:cl-oid-connect
15 19
   (:use
... ...
@@ -19,5 +23,11 @@
19 23
     #:cl-oid-connect.objects #:cl-oid-connect.utils)
20 24
   (:export
21 25
     #:redirect-if-necessary #:def-route #:require-login #:oauth2-login-middleware #:with-session
22
-    #:assoc-cdr #:session #| private!! |# #:vars-to-symbol-macrolets #:initialize-oid-connect))
26
+    #:assoc-cdr #:session #| private!! |# #:vars-to-symbol-macrolets #:initialize-oid-connect
27
+    #:run-callback-function))
23 28
 
29
+(in-package :cl-oid-connect.objects)
30
+
31
+(defvar *fbook-info*)
32
+(defvar *goog-info*)
33
+(defvar *endpoint-schema*)
... ...
@@ -32,6 +32,9 @@
32 32
  |#
33 33
 
34 34
 (in-package :cl-oid-connect.utils)
35
+(defparameter *oid* (make-instance '<app>))
36
+(define-condition user-not-logged-in (error) ())
37
+
35 38
 (eval-when (:compile-toplevel :execute :load-toplevel)
36 39
   (defun vars-to-symbol-macrolets (vars obj)
37 40
     (iterate:iterate (iterate:for (store key) in (ensure-mapping vars))
... ...
@@ -44,7 +47,7 @@
44 47
 
45 48
 ; This probably should eventually go?
46 49
 (defmacro with-endpoints (endpoint-schema  &body body)
47
-  `(let* ((*endpoint-schema* ,endpoint-schema))
50
+  `(let* ((cl-oid-connect.objects::*endpoint-schema* ,endpoint-schema))
48 51
      ,@body))
49 52
 
50 53
 (defmacro with-session ((var) &body body)
... ...
@@ -55,7 +58,7 @@
55 58
        ,@body)))
56 59
 
57 60
 (defmacro def-route ((url args &key (app *oid*) (method :GET)) &body body)
58
-  `(setf (ningle:route ,app ,url :method ,method)
61
+  `(setf (route ,app ,url :method ,method)
59 62
          (lambda ,args
60 63
            (declare (ignorable ,@args))
61 64
            ,@body)))
... ...
@@ -89,7 +92,7 @@
89 92
        (setf state (gen-state 36)
90 93
              endpoint-schema ,endpoint-schema)
91 94
        (with-endpoints ,endpoint-schema
92
-         (multiple-value-bind (content rcode headers uri) (do-auth-request ,endpoint-schema state)
95
+         (multiple-value-bind (content rcode headers uri) (cl-oid-connect.objects:do-auth-request ,endpoint-schema state)
93 96
            (declare (ignore headers))
94 97
            (if (< rcode 400) `(302 (:location ,(format nil "~a" uri)))
95 98
              content))))))
... ...
@@ -98,7 +101,7 @@
98 101
   (with-gensyms (get-app-user-cb cb-params)
99 102
     `(defun ,name (,get-app-user-cb)
100 103
        (lambda (,cb-params)
101
-         (run-callback-function
104
+         (cl-oid-connect:run-callback-function
102 105
            ,endpoint-schema ,cb-params ,get-app-user-cb
103 106
            (lambda ,params
104 107
              ,@body))))))
... ...
@@ -137,7 +140,7 @@
137 140
              (error c)))))))
138 141
 
139 142
 (defmacro setup-oid-connect (app args &body callback)
140
-  `(bind-oid-connect-routes ,app (lambda ,args ,@callback)))
143
+  `(cl-oid-connect::bind-oid-connect-routes ,app (lambda ,args ,@callback)))
141 144
 
142 145
 (flet ((handle-no-user (main-body handler-body)
143 146
          `(handler-case (ensure-logged-in ,@main-body)
... ...
@@ -163,5 +166,7 @@
163 166
                 (not (string= next-page (lack.request:request-path-info *request*))))
164 167
          (progn
165 168
            (setf (gethash :next-page ,session) nil)
166
-           `(302 (:location ,next-page)))))))
169
+           `(302 (:location ,next-page)))
170
+         (progn
171
+           ,@body)))))
167 172