EmacsからGoogle Calendar APIにアクセスする

(require 'url)

(let ((url-request-method        "POST")
      (url-request-extra-headers `(("Content-Type" . "application/x-www-form-urlencoded")))
      (url-request-data          "field1=Hello&field2=from&field3=Emacs"))
  (with-current-buffer (url-retrieve-synchronously url)
    (buffer-string)))

(require 'json)

(json-read-from-string "{\"name\": \"Taro\", \"age\": 18}")
 ;;=> ((name . "Taro") (age . 18))

(json-encode '((name . "Taro") (age . 18)))
 ;;=> "{\"name\":\"Taro\",\"age\":18}"

(json-read-from-string (decode-coding-string response-body 'utf-8))

(encode-coding-string (json-encode json-obj) 'utf-8)

;; HTTP

(defun gcal-http (method url params headers data)
  (let ((url-request-method (or method "GET"))
        (url-request-extra-headers headers)
        (url-request-data data))
    (gcal-parse-http-response
     (url-retrieve-synchronously (gcal-http-make-query-url url params)))))

(defun gcal-parse-http-response (buffer)
  "バッファ内のHTTPレスポンスを解析して、ステータス、ヘッダー、ボディ等に分割します。"
  (with-current-buffer buffer
    ;; Response Line (ex: HTTP/1.1 200 OK)
    (beginning-of-buffer)
    (if (looking-at "^HTTP/[^ ]+ \\([0-9]+\\) ?\\(.*\\)$")
        (let ((status (string-to-number (match-string 1)))
              (message (match-string 2))
              (headers)
              (body))
          (next-line)
          ;; Header Lines
          (while (not (eolp))
            (if (looking-at "^\\([^:]+\\): \\(.*\\)$")
                (push (cons (match-string 1) (match-string 2)) headers))
            (next-line))

          ;; Body
          (next-line)
          (setq body (buffer-substring (point) (point-max)))

          ;; Result
          ;;(push (cons ":Body" body) headers)
          ;;(push (cons ":Status" status) headers)
          ;;(push (cons ":Message" message) headers)
          (list status message headers body)
          ))))

(defun gcal-http-get (url params)
  "指定されたurlへparamsをGETします。"
  (gcal-http "GET" url params nil nil))

(defun gcal-http-post-www-form (url params)
  "指定されたurlへparamsをPOSTします。"
  (gcal-http "POST" url nil
             '(("Content-Type" . "application/x-www-form-urlencoded"))
             (gcal-http-make-query params)))

(defun gcal-http-post-json (url params json-obj)
  "指定されたurlへjsonをPOSTします。"
  (gcal-http "POST" url params
             '(("Content-Type" . "application/json"))
             (encode-coding-string (json-encode json-obj) 'utf-8)))


(defun gcal-retrieve-json-get (url params)
  "指定されたurlへparamsをGETして得られるjsonを解析したリストを返します。"
  (gcal-http-response-to-json (gcal-http-get url params)))

(defun gcal-retrieve-json-post-www-form (url params)
  "指定されたurlへparamsをPOSTして得られるjsonを解析したリストを返します。"
  (gcal-http-response-to-json (gcal-http-post-www-form url params)))

(defun gcal-retrieve-json-post-json (url params json-obj)
  "指定されたurlへparamsとjsonをPOSTして得られるjsonを解析したリストを返します。"
  (gcal-http-response-to-json (gcal-http-post-json url params json-obj)))


(defun gcal-http-response-to-json (response)
  "レスポンス(gcal-http, gcal-parse-http-responseの戻り値)のボディをjson-read-from-stringします。"
  (let* ((status (nth 0 response))
         (body (nth 3 response)))
    ;;@todo check status
    (json-read-from-string (decode-coding-string body 'utf-8))))

(defun gcal-http-make-query (params)
  "クエリ文字列を作成します。(ex: a=1&b=2&c=3)"
  (url-build-query-string params))

(defun gcal-http-make-query-url (url params)
  "クエリ付きのURLを作成します。(ex:http://example.com/?a=1&b=2&c=3)"
  (let* ((query (gcal-http-make-query params)))
    (if (> (length query) 0) (concat url "?" query) url)))

;;
;; OAuth
;; (この部分は一応Google Calendar以外でも使い回せるように作っています)
;;
;; Example: (setq token (gcal-oauth-get token "https://accounts.google.com/o/oauth2/auth" "https://www.googleapis.com/oauth2/v3/token" "xxx.apps.googleusercontent.com" "secret_xxx" "https://www.googleapis.com/auth/calendar"))

(defstruct gcal-oauth-token access expires refresh url)

(defun gcal-oauth-get (token auth-url token-url client-id client-secret scope)
  "アクセストークンを取得します。必要なら認証やリフレッシュを行います。"
  (if token
      (if (time-less-p (gcal-oauth-token-expires token) (current-time))
          (setq token (gcal-oauth-refresh token client-id client-secret token-url)))
    (setq token (gcal-oauth-auth auth-url token-url client-id client-secret scope)))

  token)

(defun gcal-oauth-auth (auth-url token-url client-id client-secret scope)
  "OAuthによりアクセストークンを取得します。gcal-oauth-token構造体を返します。"
  (let* ((result (gcal-oauth-get-access-token auth-url token-url client-id client-secret scope))
         (access-token (cdr (assq 'access_token result)))
         (expires-in (cdr (assq 'expires_in result)))
         (refresh-token (cdr (assq 'refresh_token result)))
         (expires (time-add (current-time) (seconds-to-time expires-in))))
    (make-gcal-oauth-token
     :access access-token
     :expires expires
     :refresh refresh-token
     :url token-url)))

(defun gcal-oauth-refresh (token client-id client-secret &optional token-url)
  "gcal-oauth-token構造体のアクセストークンをリフレッシュします。"
  (let* ((result (gcal-oauth-get-refresh-token
                  (gcal-oauth-token-refresh token)
                  (or token-url (gcal-oauth-token-url token))
                  client-id client-secret))
         (access-token (cdr (assq 'access_token result)))
         (expires-in (cdr (assq 'expires_in result)))
         (expires (time-add (current-time) (seconds-to-time expires-in))))
    (when (and access-token expires)
      (setf (gcal-oauth-token-access token) access-token)
      (setf (gcal-oauth-token-expires token) expires)))
  token)


   ;; implementation details
(defun gcal-oauth-get-access-token (auth-url token-url client-id client-secret scope)
  "アクセストークンを取得します。JSONをリストへ変換したもので返します。"
  (gcal-retrieve-json-post-www-form
   token-url
   `(
     ("client_id" ,client-id)
     ("client_secret" ,client-secret)
     ("redirect_uri" "urn:ietf:wg:oauth:2.0:oob")
     ("grant_type" "authorization_code")
     ("code" ,(gcal-oauth-get-authorization-code auth-url client-id scope)))))

(defun gcal-oauth-get-authorization-code (auth-url client-id scope)
  "ブラウザを開いてユーザに認証してもらい、認証コードを受け付けます。"
  (browse-url
   (concat auth-url
           "?client_id=" (url-hexify-string client-id)
           "&response_type=code"
           "&redirect_uri=" (url-hexify-string "urn:ietf:wg:oauth:2.0:oob")
           "&scope=" (url-hexify-string scope)))
  (read-string "Enter the code your browser displayed: "))

(defun gcal-oauth-get-refresh-token (refresh-token token-url client-id client-secret)
  "リフレッシュされたアクセストークンを取得します。JSONをリストへ変換したもので返します。"
  (gcal-retrieve-json-post-www-form
   gcal-token-url
   `(
     ("client_id" ,client-id)
     ("client_secret" ,client-secret)
     ("redirect_uri" "urn:ietf:wg:oauth:2.0:oob")
     ("grant_type" "refresh_token")
     ("refresh_token" ,refresh-token))))