Browse code
Minor tweaks to make the package work post-split
fiddlerwoaroof authored on 06/11/2015 06:50:14
Showing 4 changed files
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 |
|