/examples/consumer/yahoo.lisp

 1
 2(asdf:oos 'asdf:load-op 'cl-oauth)
 3(asdf:oos 'asdf:load-op 'hunchentoot)
 4
 5(defpackage :cl-oauth.yahoo-consumer
 6  (:use :cl :cl-oauth))
 7
 8(in-package :cl-oauth.yahoo-consumer)
 9
10;;; insert your credentials and auxiliary information here.
11(defparameter *key* "")
12(defparameter *secret* "") 
13(defparameter *callback-uri* "")
14;(defparameter *additional-parameters* '(("AppId" . "")))
15(defparameter *callback-port* 8090
16  "Port to listen on for the callback")
17
18
19
20;;; go
21(defparameter *get-request-token-endpoint* "https://api.login.yahoo.com/oauth/v2/get_request_token")
22(defparameter *auth-request-token-endpoint* "https://api.login.yahoo.com/oauth/v2/request_auth")
23(defparameter *get-access-token-endpoint* "https://api.login.yahoo.com/oauth/v2/get_token")
24(defparameter *consumer-token* (make-consumer-token :key *key* :secret *secret*))
25(defparameter *request-token* nil)
26(defparameter *access-token* nil)
27
28(defun get-access-token ()
29  (obtain-access-token *get-access-token-endpoint* *request-token*))
30
31;;; get a request token
32(defun get-request-token ()
33  (obtain-request-token
34    *get-request-token-endpoint*
35    *consumer-token*
36    :callback-uri *callback-uri*))
37
38(setf *request-token* (get-request-token))
39
40(let ((auth-uri (make-authorization-uri *auth-request-token-endpoint* *request-token*)))
41  (format t "Please authorize the request token at this URI: ~A~%" (puri:uri auth-uri)))
42
43
44;;; set up callback uri
45(defun callback-dispatcher (request)
46  (declare (ignorable request))
47  (unless (cl-ppcre:scan  "favicon\.ico$" (hunchentoot:script-name request))
48    (lambda (&rest args)
49      (declare (ignore args))
50      (handler-case
51          (authorize-request-token-from-request
52            (lambda (rt-key)
53              (assert *request-token*)
54              (unless (equal (url-encode rt-key) (token-key *request-token*))
55                (warn "Keys differ: ~S / ~S~%" (url-encode rt-key) (token-key *request-token*)))
56              *request-token*))
57        (error (c)
58          (warn "Couldn't verify request token authorization: ~A" c)))
59      (when (request-token-authorized-p *request-token*)
60        (format t "Successfully verified request token with key ~S~%" (token-key *request-token*))
61        (setf *access-token* (get-access-token))
62        (let ((reply-body (access-protected-resource
63                            "http://social.yahooapis.com/v1/user/jupitercollision/profile"
64                            *access-token*
65                            ;; Yahoo uses OAuth session so the token might need refresh.
66                            :on-refresh (lambda (new-token)
67                                          (setf *access-token* new-token)) )))
68          (etypecase reply-body
69            (string reply-body)
70            ((vector (unsigned-byte 8)) (babel:octets-to-string reply-body))))))))
71
72(pushnew 'callback-dispatcher hunchentoot:*dispatch-table*)
73
74
75(defvar *web-server* nil)
76
77(when *web-server*
78  (hunchentoot:stop *web-server*)
79  (setf *web-server* nil))
80
81(setf *web-server* (hunchentoot:start (make-instance 'hunchentoot:acceptor :port *callback-port*)))
82