#lang racket/base

(require racket/class
         racket/string
         racket/file
         srfi/8
         net/url
         net/uri-codec
         json)

(provide mastodon-client%)

; Mastodon client class
; Only Bearer Authorization is supported
(define mastodon-client%
  (class object%
    (init instance authorization-bearer)
    (super-new)
    ; Instance to connect to
    (define mastodon-instance instance)
    ; Authorization bearer to use
    (define mastodon-authorization-bearer authorization-bearer)
    ; Methods
    ; Post a new status
    ; status: the message to post
    ; visibility: #f if using the default visibility, or one of "public" "unlisted" "private" "direct"
    ; in-reply-to-id: #f if not replying, or the numeric id of the post to reply to
    ; spoiler-text: #f if not set, or the text to be shown as a warning before the actual content
    ; media-ids: #f if not set, or a list of identifiers for media attachments
    ; TODO: media_ids + sensitive
    ; Return a dictionnary corresponding to the json structure returned by the server
    (define/public (new-status status
                               #:visibility [visibility #f]
                               #:in-reply-to-id [in-reply-to-id #f]
                               #:spoiler-text [spoiler-text #f]
                               #:media-ids [media-ids #f])
      (read-json
        (post-pure-port
          (string->url (string-append mastodon-instance "/api/v1/statuses"))
          (string->bytes/utf-8
            (string-append
              "status=" (uri-encode status)
              (if visibility
                  (string-append "&visibility=" visibility)
                  "")
              (if in-reply-to-id
                  (string-append "&in_reply_to_id=" (if (string? in-reply-to-id) in-reply-to-id (number->string in-reply-to-id)))
                  "")
              (if spoiler-text
                  (string-append "&spoiler_text=" (uri-encode spoiler-text))
                  "")
              (if media-ids
                  (string-join
                    (map (lambda (x) (string-append "&media_ids[]=" (if (string? x) x (number->string x)))) media-ids)
                    "")
                  "")
              ))
          (list
            "Content-Type: application/x-www-form-urlencoded"
            (string-append "Authorization: Bearer " mastodon-authorization-bearer))
        )))
    ; Upload a media
    ; file: path of the file to upload
    ; content-type: type of content, as a string
    (define/public (upload-media filepath content-type)
      (let ((boundary (string-append "----rkt" (number->string (current-seconds))))
            (endline "\r\n")
            (path (string->path filepath))
            )
        (read-json
          (post-pure-port
            (string->url (string-append mastodon-instance "/api/v1/media"))
            (bytes-append
              (string->bytes/utf-8 (string-append "--" boundary endline))
              (receive
                (basepath filename dir?) (split-path path)
                (string->bytes/utf-8 (string-append "Content-Disposition: form-data; name=\"file\"; filename=\"" (path->string filename) "\"" endline)))
              (string->bytes/utf-8 (string-append "Content-Type: " content-type endline))
              (string->bytes/utf-8 (string-append "Content-Transfer-Encoding: binary" endline))
              (string->bytes/utf-8 endline)
              (file->bytes path)
              (string->bytes/utf-8 (string-append "--" boundary "--"))
              )
            (list
              (string-append "Content-Type: multipart/form-data; boundary=" boundary)
              (string-append "Authorization: Bearer " mastodon-authorization-bearer))
          ))))
  ))
