Регистрация | Войти
Lisp — программируемый язык программирования
google.com.lisp
Автор: Menschenkindlein - 2013-02-28T21:18:09.000000+04:00
(in-package #:saluto)

(eval-when (:load-toplevel)
  (new-oauth-provider "GOOGLE.COM"

;;; ==================================================================

                      :init-values '((provider-name . "Google.com")
                                     (oauth-host . "https://accounts.google.com")
                                     (api-host . "https://www.googleapis.com")
                                     (post-access-param-via . :DATA)
                                     (access-token-method . :POST)
                                     (query-params . (("response_type" . "code")
                                                      ("scope" . "https://www.googleapis.com/auth/userinfo.email+https://www.googleapis.com/auth/userinfo.profile")
)
)

                                     (oauth-path . "/o/oauth2/auth")
                                     (token-params . (("grant_type" . "authorization_code")))
                                     (access-token-path . "/o/oauth2/token")
)


;;; ==================================================================

                      :goto-fun
                      (alexandria:named-lambda goto-fun (module)
                        (if (not (session))
                            (progn
                              (start-session)
                              (redirect (build-goto-path module (session)))
)

                            (redirect "/")
)
)


;;; ==================================================================

                      :receiver-fun
                      (alexandria:named-lambda receiver-fun (module session code error?)
                        (when (invalid-receiver-params? code
                                                        session
                                                        error?
)

                          (logout)
                          (redirect "/")
)


                        (let ((access-token (extract-access-token
                                             (request (prepare-access-token-request module code))
)
)

                              (userinfo-request nil)
                              (userinfo nil)
)


                          (setf userinfo-request
                                (prepare-userinfo-request module access-token)
)

                          (setf userinfo (request userinfo-request))
                          (let ((parsed-userinfo (parse-userinfo module userinfo)))
                            (store-userinfo module parsed-userinfo)
)
)

                        (redirect "/")
)


;;; ==================================================================

                      :prepare-userinfo-fun
                      (alexandria:named-lambda prepare-user-info-fun (module access-token)
                        (list (concatenate 'string (api-host module) "/oauth2/v1/userinfo")
                              :parameters (list (cons "access_token" access-token))
                              :content-length t
                              :method :get
)
)


;;; ==================================================================

                      :parse-userinfo-fun
                      (alexandria:named-lambda parse-userinfo-fun (module answer)
                        (let* ((parsed-answer (jsown:parse answer))
                               (first-name (jsown:val parsed-answer "given_name"))
                               (last-name (jsown:val parsed-answer "family_name"))
                               (avatar (jsown:val parsed-answer "picture"))
                               (email (jsown:val parsed-answer "email"))
                               (uid (jsown:val parsed-answer "id"))
)

                          (list :first-name first-name
                                :last-name last-name
                                :avatar avatar
                                :email email
                                :uid uid
                                :session (session)
                                :provider "Google.com"
)
)
)
)
)
@2009-2013 lisper.ru