Added Google consumer demo (close to completion).
[cl-oauth:cl-oauth.git] / examples / consumer / google.lisp
1
2 (asdf:oos 'asdf:load-op 'cl-oauth)
3 (asdf:oos 'asdf:load-op 'hunchentoot)
4
5 (defpackage :cl-oauth.google-consumer
6   (:use :cl :cl-oauth))
7
8 (in-package :cl-oauth.google-consumer)
9
10 ;;; Google requires the timestamp to be synced to Unix time.
11 (defconstant +unix-to-universal-time+ 2208988800)
12
13 (defun get-unix-time (&optional (ut (get-universal-time)))
14   (- ut +unix-to-universal-time+))
15
16
17 ;;; insert your credentials and auxiliary information here.
18 (defparameter *key* "wintermute.mine.nu") 
19 (defparameter *secret* "L3YtuVz9EYU/dkrHnM7UD72c") 
20 (defparameter *callback-uri* "http://wintermute.mine.nu/")
21
22
23 ;;; go
24 (defparameter *get-request-token-endpoint* "https://www.google.com/accounts/OAuthGetRequestToken")
25 (defparameter *auth-request-token-endpoint* "https://www.google.com/accounts/OAuthAuthorizeToken")
26 (defparameter *get-access-token-endpoint* "https://www.google.com/accounts/OAuthGetAccessToken")
27 (defparameter *consumer-token* (make-consumer-token :key *key* :secret *secret*))
28 (defparameter *request-token* nil)
29 (defparameter *access-token* nil)
30
31 (defun get-access-token ()
32   (obtain-access-token *get-access-token-endpoint*
33                        *consumer-token* *request-token*
34                        :timestamp (get-unix-time)))
35
36 ;;; get a request token
37 (defun get-request-token (scope)
38   ;; TODO: scope could be a list.
39   (obtain-request-token
40     *get-request-token-endpoint*
41     *consumer-token*
42     :timestamp (get-unix-time)
43     :callback-uri *callback-uri*
44     :user-parameters `(("scope" . ,scope))))
45
46 (setf *request-token* (get-request-token "http://www.google.com/calendar/feeds/"))
47
48 (let ((auth-uri (make-authorization-uri *auth-request-token-endpoint* *request-token*)))
49   (format t "Please authorize the request token at this URI: ~A~%" (puri:uri auth-uri)))
50
51
52 ;;; set up callback uri
53 (defun callback-dispatcher (request)
54   (declare (ignorable request))
55   (unless (cl-ppcre:scan  "favicon\.ico$" (hunchentoot:script-name request))
56     (lambda (&rest args)
57       (declare (ignore args))
58       (handler-case
59           (authorize-request-token-from-request
60             (lambda (rt-key)
61               (assert *request-token*)
62               (unless (equal (url-encode rt-key) (token-key *request-token*))
63                 (warn "Keys not equal: ~S / ~S~%" (url-encode rt-key) (token-key *request-token*)))
64               *request-token*))
65         (error (c)
66           (warn "Couldn't verify request token authorization: ~A" c)))
67       (when (request-token-authorized-p *request-token*)
68         (format t "Successfully verified request token with key ~S~%" (token-key *request-token*))
69         (setf *access-token* (get-access-token))))))
70
71 (pushnew 'callback-dispatcher hunchentoot:*dispatch-table*)
72
73
74 (defvar *web-server* nil)
75
76 (when *web-server*
77   (hunchentoot:stop *web-server*)
78   (setf *web-server* nil))
79
80 (setf *web-server* (hunchentoot:start (make-instance 'hunchentoot:acceptor :port 8090)))
81
82