qkbox: toot: Add favourite and unfavourite procedures.

1 files changed, 35 insertions, 2 deletions

diff --git a/qkbox/toot.scm b/qkbox/toot.scm
index 3bbc856..0ccad60 100644
--- a/qkbox/toot.scm
+++ b/qkbox/toot.scm
@@ -41,6 +41,7 @@
   (request
    'POST
    "/api/v1/statuses"
+   #:json
    `(,@(if status
            `((status . ,(if (string? status)
                             status
@@ -91,6 +92,7 @@
   (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)) '())
@@ -98,7 +100,36 @@
      ,@(if local? `((local . ,local?)) '()))
    #:authorization? #t))
 
-(define* (request method path json #:key authorization?)
+
+(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* (request method path #:key json authorization?)
   (define-values (res body)
     (http-request (string-append "https://"
                                  (current-mastodon-host)
@@ -113,7 +144,9 @@
                                           (current-mastodon-access-token)))))
                                     '()))
                   #:decode-body? #t
-                  #:body (scm->json-string json)))
+                  #:body (if json
+                             (scm->json-string json)
+                             #f)))
   (if (= 200 (response-code res))
       (values res (json-string->scm (utf8->string body)))
       (values res body)))