@@ -1,2 +1,2 @@

-google-secrets.json

+*-secrets.json

 .*.sw?

@@ -35,12 +35,19 @@

 (in-package :cl-oid-connect)

 (setq drakma:*text-content-types* (cons '("application" . "json") drakma:*text-content-types*))

+(with-open-file (fbook-info #P"facebook-secrets.json")

+  (let* ((data (yason:parse fbook-info))

+         (client-id (gethash "client-id" data))

+         (secret (gethash "secret" data)))

+    (defvar *FBOOK-CLIENT-ID* client-id)

+    (defvar *FBOOK-CLIENT-SECRET* secret)))

+

 (with-open-file (goog-info #P"google-secrets.json")

   (let* ((data (yason:parse goog-info))

          (client-id (gethash "client-id" data))

          (secret (gethash "secret" data)))

-    (defconstant *GOOG-CLIENT-ID* client-id)

-    (defconstant *GOOG-CLIENT-SECRET* secret)))

+    (defvar *GOOG-CLIENT-ID* client-id)

+    (defvar *GOOG-CLIENT-SECRET* secret)))

 ;;; "cl-oid-connect" goes here. Hacks and glory await!

 (defvar *app* (make-instance 'ningle:<app>))

@@ -50,6 +57,11 @@

 ;; functions are wrapped with the "with-goog-endpoints" macro.

 (defvar *auth-endpoint* nil)

 (defvar *token-endpoint* nil)

+(defvar *client-id* nil)

+(defvar *client-secret* nil)

+(defvar *user-info-cb* (lambda ()))

+(defvar *get-access-token* (lambda ()))

+(defvar *redirect-uri* nil)

 (defmacro string-assoc (key alist) `(assoc ,key ,alist :test #'equal))

 (defmacro assoc-cdr (key alist) `(cdr (assoc ,key ,alist)))

@@ -60,9 +72,37 @@

               (cl-json:decode-json-from-string

                 (drakma:http-request "https://accounts.google.com/.well-known/openid-configuration")))

             (*auth-endpoint* (assoc-cdr :authorization--endpoint ,discovery-document))

-            (*token-endpoint* (assoc-cdr :token--endpoint ,discovery-document)))

+            (*token-endpoint* (assoc-cdr :token--endpoint ,discovery-document))

+            (*client-id* *GOOG-CLIENT-ID*)

+            (*client-secret* *GOOG-CLIENT-SECRET*)

+            (*redirect-uri* "http://srv2.elangley.org:9090/oidc_callback/google")

+            )

        ,@body)))     

+

+(defmacro with-fbook-endpoints (&body body)

+  `(let* ((*auth-endpoint* "https://www.facebook.com/dialog/oauth")

+          (*token-endpoint* "https://graph.facebook.com/v2.3/oauth/access_token")

+          (*client-id* *FBOOK-CLIENT-ID*)

+          (*client-secret* *FBOOK-CLIENT-SECRET*)

+          (*user-info-cb* #'fb-get-userinfo)

+          (*get-access-token* #'fb-get-access-token)

+          (*redirect-uri* "http://srv2.elangley.org:9090/oidc_callback/facebook"))

+     ,@body))     

+

+(defun fb-get-userinfo (access-token)

+  (let ((endpoint "https://graph.facebook.com/v2.3/me"))

+    (cl-json:decode-json-from-string

+      (drakma:http-request endpoint

+                           :parameters `(("access_token" . ,access-token))))))

+

+(defvar *fbook-mw*

+  (lambda (app)

+    (lambda (env)

+      (with-fbook-endpoints

+        (format t "~a" *client-id*)

+        (funcall app env)))))

+

 (defvar *goog-mw*

   (lambda (app)

     (lambda (env)

@@ -75,18 +115,21 @@

                          :method :post

                          :redirect nil

                          :parameters `(("code" . ,code)

-                                       ("client_id" . ,*GOOG-CLIENT-ID*)

-                                       ("client_secret" . ,*GOOG-CLIENT-SECRET*)

-                                       ("redirect_uri" . "http://srv2.elangley.org:9090/oidc_callback")

+                                       ("client_id" . ,*client-id*)

+                                       ("app_id" . ,*client-id*)

+                                       ("client_secret" . ,*client-secret*)

+                                       ("redirect_uri" . ,*redirect-uri*)

                                        ("grant_type" . "authorization_code")))))

 (defun do-auth-request (state)

+  (format t "~%client-id: ~a~%" *client-id*)

   (drakma:http-request *auth-endpoint*

                        :redirect nil

-                       :parameters `(("client_id" . ,*GOOG-CLIENT-ID*)

+                       :parameters `(("client_id" . ,*client-id*)

+                                       ("app_id" . ,*client-id*)

                                      ("response_type" . "code")

-                                     ("scope" . "openid email")

-                                     ("redirect_uri" . "http://srv2.elangley.org:9090/oidc_callback")

+                                     ("scope" . "email")

+                                     ("redirect_uri" . ,*redirect-uri*)

                                      ("state" . ,state))))

 (defun gen-state (len)

@@ -98,50 +141,116 @@

 (defmacro def-route (url args &body body)

   `(setf (ningle:route *app* ,url)

          #'(lambda ,args

+             (declare (ignorable ,@args))

              ,@body)))

 (defmacro check-state (received-state then else)

-  (alexandria:with-gensyms (saved-state)

-    `(let ((,saved-state (gethash :state *session*)))

+  (alexandria:with-gensyms (saved-state session)

+    `(let* ((,session (context :session))

+            (,saved-state (gethash :state ,session)))

        (if (equal ,saved-state ,received-state)

          ,then

          ,else))))

 (defmacro require-login (&body body)

-  `(if (not (eql nil (gethash :userinfo *session*)))

-     (progn

-       ,@body)

-     '(302 (:location "/login"))))

+  (alexandria:with-gensyms (session)

+    `(let ((,session (context :session)))

+       (if (not (eql nil (gethash :userinfo ,session)))

+         (progn

+           ,@body)

+         '(302 (:location "/login"))))))

+

+(defmacro with-session ((var) &body body)

+  `(let ((,var (context :session)))

+     ,@body))

+

 (def-route "/login" (params)

-  (declare (ignore params))

-  (let ((state (gen-state 36)))

-    (setf (gethash :state *session*) state)

-    (multiple-value-bind (content rcode headers) (do-auth-request state)

-      (if (< rcode 400)

-        `(302 (:location ,(cdr (assoc :location headers))))

-        content))))

-

-(def-route "/oidc_callback" (params)

+  (cl-who:with-html-output-to-string (s)

+    (:html

+      (:head

+        (:title "Login"))

+      (:body

+        (:div (:a :href "/login/facebook" "Facebook"))

+        (:div (:a :href "/login/google" "Google")))))) 

+

+

+(def-route "/login/google" (params)

+  (with-session (session)

+    (let ((state (gen-state 36)))

+      (setf (gethash :state session) state)

+      (with-goog-endpoints 

+        (multiple-value-bind (content rcode headers) (do-auth-request state)

+          (if (< rcode 400)

+            `(302 (:location ,(cdr (assoc :location headers))))

+            content))))))

+

+

+(def-route "/login/facebook" (params)

+  (with-session (session)

+    (let ((state (gen-state 36)))

+      (setf (gethash :state session) state)

+      (with-fbook-endpoints 

+        (multiple-value-bind (content rcode headers uri) (do-auth-request state)

+          (if (< rcode 400)

+            `(302 (:location ,(format nil "~a" uri)))

+            content))))))

+

+;(def-route "/oidc_callback" (params)

+;  (let ((received-state (cdr (string-assoc "state" params)))

+;        (code (cdr (string-assoc "code" params))))

+;    (with-fbook-endpoints

+;      (check-state received-state

+;                   (let* ((a-t (get-access-token code)))

+;                     (format nil "~s" a-t))

+;                   '(403 '() "Out, vile imposter!")))))

+

+(def-route "/oidc_callback/google" (params)

   (let ((received-state (cdr (string-assoc "state" params)))

         (code (cdr (string-assoc "code" params))))

     (check-state received-state

-                 (let* ((a-t (get-access-token code)) (id-token (assoc-cdr :id--token a-t))

-                        (decoded (cljwt:decode id-token :fail-if-unsupported nil)))

-                   (setf (gethash :userinfo *session*) decoded)

-                   '(302 (:location "/")))

+                 (with-session (session)

+                   (with-goog-endpoints 

+                     (let* ((a-t (get-access-token code)) (id-token (assoc-cdr :id--token a-t))

+                            (decoded (cljwt:decode id-token :fail-if-unsupported nil)))

+                       (setf (gethash :userinfo session) decoded)

+                       '(302 (:location "/")))))

                  '(403 '() "Out, vile imposter!"))))

+

+(def-route "/oidc_callback/facebook" (params)

+  (let ((received-state (cdr (string-assoc "state" params)))

+        (code (cdr (string-assoc "code" params))))

+    (with-fbook-endpoints 

+      (check-state received-state

+                   (with-session (session)

+                     (let* ((a-t (get-access-token code))

+                            (id-token (assoc-cdr :access--token a-t)))

+                       (setf (gethash :userinfo session) (funcall *user-info-cb* id-token))

+                       '(302 (:location "/"))))

+                   '(403 '() "Out, vile imposter!")))))

+

+(def-route "/userinfo.json" (params)

+  (with-session (session)

+    (require-login 

+      (with-fbook-endpoints 

+        (cl-json:encode-json-to-string (gethash :userinfo session))))))

+

+(def-route "/logout" (params)

+  (with-session (session)

+    (setf (gethash :userinfo session) nil)

+    '(302 (:location "/"))))

+

 (def-route "/" (params)

-  (require-login 

-    (anaphora:sunless (gethash :counter *session*) (setf anaphora:it 0))

-    (format nil "~Ath visit<br/>~a<br/>~S"

-            (incf (gethash :counter *session*))

-            *state*

-            (alexandria:hash-table-alist *session*))))

+  (with-session (session)

+    (require-login 

+      (anaphora:sunless (gethash :counter session) (setf anaphora:it 0))

+      (format nil "~Ath visit<br/>~a<br/><br/>~S<br/>"

+              (gethash :counter session)

+              (alexandria:hash-table-alist session)

+              (alexandria:hash-table-alist (context :session))))))

-(setf *handler* (clack:clackup (lack.builder:builder :session *goog-mw* *app*)

-                               :port 9090))

+(setf *handler* (clack:clackup (lack.builder:builder :session *app*) :port 9090))

new file mode 100644

@@ -0,0 +1,4 @@

+{

+  "client-id": "<secret>",

+  "secret": "<secret>"

+}