(define-module (qkbox toot)
  #:use-module (ice-9 format)
  #:use-module (web response)
  #:use-module (web client)
  #:use-module (json builder)
  #:use-module (json parser)
  #:use-module (rnrs bytevectors)
  #:export (post))

(define current-mastodon-host
  (make-parameter (getenv "MASTODON_HOST")))

(define current-mastodon-access-token
  (make-parameter (getenv "MASTODON_ACCESS_TOKEN")))

(define* (post status
               #:key
               spoiler-text
               visibility
               sensitive
               reply-to)
  (define-values (res body)
    (/api/v1/statuses #:status status
                      #:spoiler-text spoiler-text
                      #:visibility visibility
                      #:sensitive sensitive
                      #:reply-to reply-to))
  (case (response-code res)
    ((200)
     (assoc-ref body "id"))
    (else
     (error "post: failed" res body))))

(define* (/api/v1/statuses #:key
                           status
                           spoiler-text
                           visibility
                           sensitive
                           reply-to
                           media-ids)
  (post-json
   "/api/v1/statuses"
   `(,@(if status
           `((status . ,(if (string? status)
                            status
                            (format #f "~y" status))))
           '())
     ,@(if spoiler-text
           `((spoiler_text . ,spoiler-text))
           '())
     ,@(if visibility
           (case visibility
             ((public unlisted private direct)
              `((visibility . ,visibility)))
             (else
              (error "post: invalid visibility (must be one of: public unlisted private direct)")))
           '())
     ,@(if sensitive `((sensitive . (if sensitive #t #f)))
           '())
     ,@(if reply-to
           `((in_reply_to_id . ,reply-to))
           '())
     ,@(if media-ids
           `((media_ids . ,(list->vector (map number->string media-ids))))
           '()))
   #:authorization? #t))

(define* (post-json path json #:key authorization?)
  (define-values (res body)
    (http-post (string-append "https://"
                              (current-mastodon-host)
                              path)
               #:headers `((content-type application/json)
                           ,@(if authorization?
                                 `((authorization
                                     ,(string->symbol
                                       (string-append
                                        "Bearer "
                                        (current-mastodon-access-token)))))
                                 '()))
               #:decode-body? #t
               #:body (scm->json-string json)))
  (if (= 200 (response-code res))
      (values res (json-string->scm (utf8->string body)))
      (values res body)))