#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)) "\"")
              )))))
  ))
