(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
            timeline
            favourite
            unfavourite
            reblog
            unreblog))

(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)
  (request
   'POST
   "/api/v1/statuses"
   #:json
   `(,@(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* (timeline #:key max-id since-id min-id limit local?)
  (define-values (res body)
    (/api/v1/timelines/home #:max-id max-id
                            #:since-id since-id
                            #:min-id min-id
                            #:limit limit
                            #:local? local?))
  (case (response-code res)
    ((200)
     (map (lambda (status)
            `((id . ,(assoc-ref status "id"))
              (name . ,(assoc-ref (assoc-ref status "account")
                                  "display_name"))
              (url . ,(assoc-ref status "url"))
              (content . ,(assoc-ref status "content"))))
          (vector->list body)))
    ((206)
     (error "timeline: Home feed is regenerating"))
    (else
     (error "timeline: failed" res body))))

(define* (/api/v1/timelines/home #:key max-id since-id min-id limit local?)
  (request
   'GET
   "/api/v1/timelines/home"
   #:json
   `(,@(if max-id `((max-id . ,max-id)) '())
     ,@(if since-id `((since-id . ,since-id)) '())
     ,@(if min-id `((min-id . ,min-id)) '())
     ,@(if limit `((limit . ,limit)) '())
     ,@(if local? `((local . ,local?)) '()))
   #:authorization? #t))

(define (favourite id)
  (define-values (res body)
    (/api/v1/statuses/:id/favourite id))
  (case (response-code res)
    ((200) #t)
    (else
     (error "favourite: failed" res body))))

(define (/api/v1/statuses/:id/favourite id)
  (request
   'POST
   (format #f "/api/v1/statuses/~a/favourite" id)
   #:authorization? #t))

(define (unfavourite id)
  (define-values (res body)
    (/api/v1/statuses/:id/unfavourite id))
  (case (response-code res)
    ((200) #t)
    (else
     (error "unfavourite: failed" res body))))

(define (/api/v1/statuses/:id/unfavourite id)
  (request
   'POST
   (format #f "/api/v1/statuses/~a/unfavourite" id)
   #:authorization? #t))

(define (reblog id)
  (define-values (res body)
    (/api/v1/statuses/:id/reblog id))
  (case (response-code res)
    ((200) #t)
    (else
     (error "reblog: failed" res body))))

(define (/api/v1/statuses/:id/reblog id)
  (request
   'POST
   (format #f "/api/v1/statuses/~a/reblog" id)
   #:authorization? #t))

(define (unreblog id)
  (define-values (res body)
    (/api/v1/statuses/:id/unreblog id))
  (case (response-code res)
    ((200) #t)
    (else
     (error "unreblog: failed" res body))))

(define (/api/v1/statuses/:id/unreblog id)
  (request
   'POST
   (format #f "/api/v1/statuses/~a/unreblog" id)
   #:authorization? #t))

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