120 lines
4.4 KiB
Racket
120 lines
4.4 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/class
|
|
racket/string
|
|
net/url
|
|
net/uri-codec
|
|
json
|
|
racket/date
|
|
web-server/stuffers/hmac-sha1
|
|
net/base64)
|
|
|
|
(provide twitter-client%)
|
|
|
|
(define twitter-client%
|
|
(class object%
|
|
; Needs the various OAuth keys and secrets
|
|
(init consumer-key consumer-secret access-key access-secret)
|
|
(super-new)
|
|
;
|
|
(define twitter-consumer-key consumer-key)
|
|
(define twitter-consumer-secret consumer-secret)
|
|
(define twitter-access-token access-key)
|
|
(define twitter-access-token-secret access-secret)
|
|
; Twitter root
|
|
(define twitter-root "https://api.twitter.com/1.1")
|
|
;
|
|
; Private methods for OAuth 1.0
|
|
; To generate timestamp & nonce
|
|
(define (get-timestamp) (number->string (current-seconds)))
|
|
; Compute the parameter string
|
|
; The oauth-headers and parameters are lists of (key . value)
|
|
(define (compute-signature-parameter-string oauth-headers parameters)
|
|
(string-join
|
|
(sort
|
|
(map
|
|
(lambda (x)
|
|
(string-append (uri-unreserved-encode (car x)) "=" (uri-unreserved-encode (cdr x))))
|
|
(append oauth-headers parameters))
|
|
string<?)
|
|
"&"))
|
|
; compute the signature base string
|
|
(define (compute-signature-base-string request-type url parameter-string)
|
|
(string-append
|
|
(string-upcase request-type)
|
|
"&"
|
|
(uri-unreserved-encode url)
|
|
"&"
|
|
(uri-unreserved-encode parameter-string)))
|
|
; compute the signature key
|
|
(define (compute-signature-key)
|
|
(string-append
|
|
(uri-unreserved-encode twitter-consumer-secret)
|
|
"&"
|
|
(uri-unreserved-encode twitter-access-token-secret)))
|
|
; compute the signature
|
|
(define (compute-signature signature-key signature-base-string)
|
|
(bytes->string/utf-8
|
|
(base64-encode
|
|
(HMAC-SHA1
|
|
(string->bytes/utf-8 signature-key)
|
|
(string->bytes/utf-8 signature-base-string))
|
|
#"")))
|
|
; compute the signature from the request
|
|
(define (compute-signature-from-request request-type url oauth-headers parameters)
|
|
(compute-signature
|
|
(compute-signature-key)
|
|
(compute-signature-base-string
|
|
request-type
|
|
url
|
|
(compute-signature-parameter-string
|
|
oauth-headers
|
|
parameters))))
|
|
;
|
|
; Post a new status
|
|
; Return a dictionnary corresponding to the json structure returned by the server
|
|
(define/public (status-update status
|
|
#:in-reply-to-id [in-reply-to-id #f])
|
|
(let*
|
|
((url (string-append twitter-root "/statuses/update.json"))
|
|
(parameters
|
|
(append
|
|
(list (cons "status" status))
|
|
(if in-reply-to-id
|
|
(list
|
|
(cons "in_reply_to_status_id" in-reply-to-id)
|
|
(cons "auto_populate_reply_metadata" "true"))
|
|
(list))
|
|
))
|
|
(timestamp (get-timestamp))
|
|
(oauth-headers
|
|
(list
|
|
(cons "oauth_consumer_key" twitter-consumer-key)
|
|
(cons "oauth_token" twitter-access-token)
|
|
(cons "oauth_version" "1.0")
|
|
(cons "oauth_timestamp" timestamp)
|
|
(cons "oauth_nonce" timestamp)
|
|
(cons "oauth_signature_method" "HMAC-SHA1"))))
|
|
(read-json
|
|
(post-pure-port
|
|
(string->url url)
|
|
(string->bytes/utf-8
|
|
(string-join
|
|
(map
|
|
(lambda (x) (string-append (uri-unreserved-encode (car x)) "=" (uri-unreserved-encode (cdr x))))
|
|
parameters)
|
|
"&"))
|
|
(list
|
|
"Content-Type: application/x-www-form-urlencoded"
|
|
(string-append
|
|
"Authorization: OAuth "
|
|
"realm=\"\","
|
|
(string-join
|
|
(map
|
|
(lambda (x) (string-append (uri-unreserved-encode (car x)) "=\"" (uri-unreserved-encode (cdr x)) "\""))
|
|
oauth-headers)
|
|
",")
|
|
",oauth_signature=\"" (uri-unreserved-encode (compute-signature-from-request "POST" url oauth-headers parameters)) "\"")
|
|
)))))
|
|
))
|