summaryrefslogtreecommitdiff
path: root/qkbox
diff options
context:
space:
mode:
authorMasaya Tojo <masaya@tojo.tokyo>2020-07-15 06:10:14 +0900
committerMasaya Tojo <masaya@tojo.tokyo>2020-07-15 06:10:14 +0900
commitd7285203cb04d4e6625bcbf7222f012ba4f7cdb6 (patch)
treecae7076eee7129adbfd3dd0f3ab766c9e9675179 /qkbox
parent1321b087545c721766690086e08be4c88e95102b (diff)
Rename proejct from qkbox to toot.
Diffstat (limited to 'qkbox')
-rw-r--r--qkbox/.dir-locals.el4
-rw-r--r--qkbox/toot.scm882
2 files changed, 0 insertions, 886 deletions
diff --git a/qkbox/.dir-locals.el b/qkbox/.dir-locals.el
deleted file mode 100644
index c5c5588..0000000
--- a/qkbox/.dir-locals.el
+++ /dev/null
@@ -1,4 +0,0 @@
-((scheme-mode
- .
- ((indent-tabs-mode . nil)
- (eval . (put 'set-record-type-printer! 'scheme-indent-function 1)))))
diff --git a/qkbox/toot.scm b/qkbox/toot.scm
deleted file mode 100644
index 0043fb8..0000000
--- a/qkbox/toot.scm
+++ /dev/null
@@ -1,882 +0,0 @@
-;;; Qkbox --- TojoQK's toybox
-;;; Copyright © 2020 Masaya Tojo <masaya@tojo.tokyo>
-;;;
-;;; This file is part of Qkbox.
-;;;
-;;; Qkbox is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; Qkbox is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Qkbox. If not, see <http://www.gnu.org/licenses/>.
-
-(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)
- #:use-module (ice-9 binary-ports)
- #:use-module (ice-9 receive)
- #:use-module (ice-9 regex)
- #:use-module (ice-9 optargs)
- #:use-module (srfi srfi-9)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-19)
- #:use-module (srfi srfi-9 gnu)
- #:use-module (pict)
- #:use-module ((htmlprag)
- #:select (html->sxml))
- #:use-module ((sxml fold)
- #:select (foldt))
- #:use-module ((sxml xpath)
- #:select (sxpath))
- #:use-module (rnrs io ports)
- #:export (;; config
- current-mastodon-host
- current-mastodon-access-token
-
- ;; get
- fetch-status
- fetch-account
- fetch-home-timeline
- fetch-public-timeline
-
- ;; post
- post
- favourite
- unfavourite
- reblog
- unreblog
-
- ;; streaming
- streaming-user
- streaming-public
-
- ;; status
- status?
- status-id
- status-emojis
- status-reblog
- status-account
- status-content
- status-public?
- status-sensitive?
- status-visibility
- status-spoiler-text
- status-creation-time
- status-in-reply-to-id
- status-in-reply-to-account-id
- display-status
-
- ;; notification
- notification?
- notification-id
- notification-type
- notification-status
- notification-account
- notification-creation-time
- display-notification
-
- ;; emoji
- emoji?
- emoji-shortcode
- emoji-static-url
- emoji-visible-in-picker?
-
- ;; account
- account?
- account-id
- account-acct
- account-emojis
- account-display-name
- account-avatar-static
- ))
-
-(define-syntax-rule (and/nil test expr)
- (if test
- expr
- '()))
-
-(define current-mastodon-host
- (make-parameter (getenv "MASTODON_HOST")))
-
-(define current-mastodon-access-token
- (make-parameter (getenv "MASTODON_ACCESS_TOKEN")))
-
-(define (created-at-string->date str)
- (time-utc->date
- (date->time-utc
- (string->date str "~Y-~m-~dT~H:~M:~S.~N~z"))))
-
-(define (creation-time->string date)
- (date->string date "~4"))
-
-(define* (post text
- #:key
- spoiler-text
- visibility
- sensitive?
- reply-to)
- (receive (res body)
- (post-/api/v1/statuses #:status text
- #: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* (post-/api/v1/statuses #:key
- status
- spoiler-text
- visibility
- sensitive?
- reply-to
- media-ids)
- (request
- 'POST
- "/api/v1/statuses"
- #:json
- `(,@(and/nil status
- `((status . ,(if (string? status)
- status
- (format #f "~y" status)))))
- ,@(and/nil spoiler-text
- `((spoiler_text . ,spoiler-text)))
- ,@(and/nil visibility
- (case visibility
- ((public unlisted private direct)
- `((visibility . ,visibility)))
- (else
- (error "post: invalid visibility (must be one of: public unlisted private direct)"))))
- ,@(and/nil sensitive?
- `((sensitive . (if sensitive? #t #f))))
- ,@(and/nil reply-to
- `((in_reply_to_id . ,reply-to)))
- ,@(and/nil media-ids
- `((media_ids . ,(list->vector (map number->string media-ids))))))
- #:authorization? #t))
-
-(define-record-type <status>
- (make-status json)
- status?
- (json status-json))
-
-(set-record-type-printer! <status>
- (lambda (status port)
- (format port
- "#<status id: ~s ...>"
- (status-id status))))
-
-(define-record-type <account>
- (make-account json)
- account?
- (json account-json))
-
-(set-record-type-printer! <account>
- (lambda (account port)
- (format port "#<account id: ~s acct: ~s ...>"
- (account-id account)
- (account-acct account))))
-
-(define-record-type <notification>
- (make-notification json)
- notification?
- (json notification-json))
-
-(define (notification-id notification)
- (assoc-ref (notification-json notification)
- "id"))
-
-(define (notification-status notification)
- (make-status
- (assoc-ref (notification-json notification)
- "status")))
-
-(define (notification-account notification)
- (make-account
- (assoc-ref (notification-json notification)
- "account")))
-
-(define (notification-type notification)
- (string->symbol
- (assoc-ref (notification-json notification)
- "type")))
-
-(define (notification-creation-time notification)
- (created-at-string->date
- (assoc-ref (notification-json notification)
- "created_at")))
-
-(define* (display-notification notification #:key (port (current-output-port)))
- (let ((account (notification-account notification))
- (status (notification-status notification))
- (time (notification-creation-time notification)))
- (format port
- "[NOTIFICATION] ~:@(~a~)~%~a ~a ~a~%> "
- (notification-type notification)
- (fetch-avatar-static
- (account-avatar-static account))
- (account-to-string account)
- (creation-time->string time))
- (display-status (notification-status notification))))
-
-(define (status-public? status)
- (eq? 'public (status-visibility status)))
-
-(define (account-to-string account)
- (format #f "~{~a~} <~a> (account-id: ~s)"
- (insert-emoji-picts (account-emojis account)
- (sanitize (account-display-name account)))
- (account-acct account)
- (account-id account)))
-
-(define* (display-status status
- #:key
- (port (current-output-port))
- display-cw?
- display-sensitive?
- (display-id? #t))
- (let ((status (or (status-reblog status) status))
- (status/original status))
- (let ((account (status-account status)))
- (cond
- (else
- (format port
- "~s ~a ~a~@?~@?~@?~@?~@?~%~@?~@?"
- (status-avatar-pict status/original)
- (account-to-string account)
- (creation-time->string
- (status-creation-time status/original))
- "~@[~% * status-id: ~s~]"
- (and display-id? (status-id status/original))
- "~@[~% * visibility: ~:@(~a~)~]"
- (and (not (status-public? status))
- (status-visibility status))
- "~@[~% * boosted-by: ~a~]"
- (and (status-reblog status/original)
- (account-to-string
- (status-account status/original)))
- "~@[~% * in-reply-to-id: ~s~]"
- (status-in-reply-to-id status)
- "~@[~% * content-warning: ~a~]"
- (status-spoiler-text status)
- "~@[~a~%~]"
- (and (or (not (status-spoiler-text status))
- display-cw?)
- (sanitize
- (status-to-content-string status)))
- "~{~a~%~}"
- (map (lambda (att)
- (if (or (not (status-sensitive? status))
- display-sensitive?)
- (case (attachment-type att)
- ((image)
- (cond
- ((fetch-attachment-preview-pict att)
- => identity)
- (else
- "FAILED: IMAGE")))
- (else
- =>
- (lambda (type)
- (format #f "UNSUPPORTED: ~:@(~a~)" type))))
- (format #f "NSFW: ~:@(~a~)" (attachment-type att))))
- (status-media-attachments status))))))))
-
-(define (status-avatar-pict status)
- (let ((status-pict (or (fetch-avatar-static
- (account-avatar-static
- (status-account status)))
- no-image)))
- (cond
- ((status-reblog status)
- =>
- (lambda (reblog)
- (let ((reblog-pict (status-avatar-pict reblog)))
- (rb-superimpose
- (lt-superimpose (ghost reblog-pict) (scale reblog-pict 0.8))
- (scale status-pict 0.5)))))
- (else status-pict))))
-
-(define (status-id status)
- (assoc-ref (status-json status) "id"))
-
-(define (status-account status)
- (make-account (assoc-ref (status-json status) "account")))
-
-(define (status-reblog status)
- (let ((reblog/json (assoc-ref (status-json status) "reblog")))
- (if (eq? reblog/json 'null)
- #f
- (make-status reblog/json))))
-
-(define (status-sensitive? status)
- (assoc-ref (status-json status) "sensitive"))
-
-(define (status-content status)
- (assoc-ref (status-json status) "content"))
-
-(define (sanitize x)
- (string-delete (char-set #\x202d #\x202e) x))
-
-(define (content->sxml content)
- (html->sxml content))
-
-(define (status-to-content-string status)
- (let ((content (status-content status))
- (emojis (status-emojis status)))
- (call-with-output-string
- (lambda (port)
- (for-each (lambda (x) (display x port))
- (append-map
- (lambda (x) (insert-emoji-picts emojis x))
- (flatten
- (foldt (lambda (xs)
- (define (unexpected)
- (format #f "~%[DEBUG] UNEXPECTED ~s~%" xs))
- (case (car xs)
- ((*TOP* span status p a) (cdr xs))
- ((br) #\newline)
- ((@ class target rel href) '())
- ((*ENTITY*)
- (if (equal? '(*ENTITY* "additional" "nbsp") xs)
- " "
- (unexpected)))
- (else (unexpected))))
- (lambda (obj) obj)
- (content->sxml content)))))
- (get-output-string port)))))
-
-(define (flatten x)
- (cond
- ((list? x)
- (append-map flatten x))
- (else (list x))))
-
-(define (status-visibility status)
- (string->symbol (assoc-ref (status-json status) "visibility")))
-
-(define (status-spoiler-text status)
- (let ((s (assoc-ref (status-json status) "spoiler_text")))
- (if (zero? (string-length s))
- #f
- s)))
-
-(define-record-type <emoji>
- (make-emoji json)
- emoji?
- (json emoji-json))
-
-(define (emojis->regexp emojis)
- (string-append ":("
- (string-join (map (compose regexp-quote emoji-shortcode) emojis)
- "|")
- "):"))
-
-(define (status-emojis status)
- (map make-emoji (vector->list (assoc-ref (status-json status) "emojis"))))
-
-(define-record-type <attachment>
- (make-attachment json)
- attachment?
- (json attachment-json))
-
-(define (attachment-type attachment)
- (string->symbol (assoc-ref (attachment-json attachment) "type")))
-
-(define (attachment-preview-url attachment)
- (assoc-ref (attachment-json attachment) "preview_url"))
-
-(define (attachment-url attachment)
- (assoc-ref (attachment-json attachment) "url"))
-
-(define (fetch-attachment-preview-pict attachment)
- (fetch-pict (attachment-preview-url attachment)
- #:height> 128))
-
-(define (fetch-attachment-pict attachment)
- (fetch-pict (attachment-url attachment)))
-
-(define (status-media-attachments status)
- (let ((v (assoc-ref (status-json status) "media_attachments")))
- (map make-attachment (vector->list v))))
-
-(define (status-in-reply-to-id status)
- (let ((id (assoc-ref (status-json status) "in_reply_to_id")))
- (if (eq? 'null id)
- #f
- id)))
-
-(define (status-in-reply-to-account-id status)
- (let ((id (assoc-ref (status-json status) "in_reply_to_account_id")))
- (if (eq? 'null id)
- #f
- id)))
-
-(define (status-creation-time status)
- (created-at-string->date (assoc-ref (status-json status)
- "created_at")))
-
-(define (emoji-static-url emoji)
- (assoc-ref (emoji-json emoji) "static_url"))
-
-(define (emoji-shortcode emoji)
- (assoc-ref (emoji-json emoji) "shortcode"))
-
-(define (emoji-visible-in-picker? emoji)
- (assoc-ref (emoji-json emoji) "visible_in_picker"))
-
-(define emoji-cache (make-hash-table))
-
-(define (fetch-emoji-pict emoji)
- (let ((url (emoji-static-url emoji)))
- (cond
- ((hash-ref emoji-cache url) => identity)
- ((fetch-pict (emoji-static-url emoji)
- #:resize '(24 24))
- =>
- (lambda (pict)
- (hash-set! emoji-cache url pict)
- pict))
- (else #f))))
-
-(define (insert-emoji-picts emojis x)
- (let ((r (emojis->regexp emojis)))
- (if (string? x)
- (let loop ((s x))
- (cond ((string-match r s)
- =>
- (lambda (mat)
- (let ((shortcode (match:substring mat 1)))
- (cons* (match:prefix mat)
- (cond
- ((emojis-ref emojis shortcode)
- =>
- (lambda (emoji)
- (or (fetch-emoji-pict emoji)
- shortcode))))
- (loop (match:suffix mat))))))
- (else
- (list s))))
- (list x))))
-
-(define (emojis-ref emojis shortcode)
- (find (lambda (emoji) (equal? shortcode (emoji-shortcode emoji)))
- emojis))
-
-(define (account-id account)
- (assoc-ref (account-json account) "id"))
-
-(define (account-avatar-static account)
- (assoc-ref (account-json account) "avatar_static"))
-
-(define (account-acct account)
- (assoc-ref (account-json account) "acct"))
-
-(define (account-display-name account)
- (assoc-ref (account-json account) "display_name"))
-
-(define (account-emojis account)
- (map make-emoji (vector->list (assoc-ref (account-json account) "emojis"))))
-
-(define avatar-static-cache (make-hash-table))
-
-(define* (fetch-pict url #:key resize height>)
- (receive (res body)
- (http-get url)
- (case (response-code res)
- ((200)
- (let ((tmp (tmpnam)))
- (let ((in (open tmp (logior O_WRONLY O_CREAT O_EXCL))))
- (put-bytevector in body)
- (close in))
- (let ((pict
- (and (zero? (apply system* "convert"
- `(,@(and/nil resize
- `("-resize"
- ,(format #f "~dx~d!"
- (car resize)
- (cadr resize))))
- ,@(and/nil height>
- `("-resize"
- ,(format #f "x~d>"
- height>)))
- ,(string-append tmp "[0]")
- ,(string-append "png:" tmp))))
- (pict-from-file tmp))))
- (delete-file tmp)
- pict)))
- (else #f))))
-
-(define* (fetch-avatar-static url)
- (cond
- ((hash-ref avatar-static-cache url) => identity)
- (else
- (cond
- ((fetch-pict url #:resize '(32 32))
- =>
- (lambda (pict)
- (hash-set! avatar-static-cache url pict)
- pict))
- (else #f)))))
-
-(define no-image
- (cc-superimpose
- (filled-rectangle 32 32
- #:color "white"
- #:border-width 0)
- (line 0 0 32 32 #:color "red")
- (line 0 32 32 0 #:color "red")))
-
-(define* (fetch-status id #:key (authorization? #t))
- (receive (res body)
- (get-/api/v1/statuses/:id id #:authorization? authorization?)
- (case (response-code res)
- ((200) (make-status body))
- (else
- (error "fetch-status: failed" res body)))))
-
-(define* (get-/api/v1/statuses/:id id #:key (authorization? #t))
- (request
- 'GET
- (format #f "/api/v1/statuses/~a" id)
- #:authorization? authorization?))
-
-(define* (fetch-home-timeline #:key max-id since-id min-id limit local?)
- (receive (res body)
- (get-/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 make-status (vector->list body)))
- ((206)
- (error "fetch-home-timeline: Home feed is regenerating"))
- (else
- (error "fetch-home-timeline: failed" res body)))))
-
-(define* (fetch-public-timeline #:key max-id since-id min-id limit local? remote? only-media?)
- (receive (res body)
- (get-/api/v1/timelines/public #:max-id max-id
- #:since-id since-id
- #:min-id min-id
- #:limit limit
- #:local? local?
- #:remote? remote?
- #:only-media? only-media?)
- (case (response-code res)
- ((200)
- (map make-status (vector->list body)))
- (else
- (error "fetch-public-timeline: failed" res body)))))
-
-(define* (get-/api/v1/timelines/home #:key max-id since-id min-id limit local?)
- (request
- 'GET
- "/api/v1/timelines/home"
- #:json
- `(,@(and/nil max-id `((max_id . ,max-id)))
- ,@(and/nil since-id `((since_id . ,since-id)))
- ,@(and/nil min-id `((min_id . ,min-id)))
- ,@(and/nil limit `((limit . ,limit)))
- ,@(and/nil local? `((local . ,local?))))
- #:authorization? #t))
-
-(define* (get-/api/v1/timelines/public #:key max-id since-id min-id limit local? remote? only-media?)
- (request
- 'GET
- "/api/v1/timelines/public"
- #:json
- `(,@(and/nil max-id `((max_id . ,max-id)))
- ,@(and/nil since-id `((since_id . ,since-id)))
- ,@(and/nil min-id `((min_id . ,min-id)))
- ,@(and/nil limit `((limit . ,limit)))
- ,@(and/nil local? `((local . ,local?)))
- ,@(and/nil remote? `((remote . ,remote?)))
- ,@(and/nil only-media? `((only_media . ,only-media?))))
- #:authorization? #t))
-
-(define (favourite id)
- (define-values (res body)
- (post-/api/v1/statuses/:id/favourite id))
- (case (response-code res)
- ((200) #t)
- (else
- (error "favourite: failed" res body))))
-
-(define (post-/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)
- (post-/api/v1/statuses/:id/unfavourite id))
- (case (response-code res)
- ((200) #t)
- (else
- (error "unfavourite: failed" res body))))
-
-(define (post-/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)
- (post-/api/v1/statuses/:id/reblog id))
- (case (response-code res)
- ((200) #t)
- (else
- (error "reblog: failed" res body))))
-
-(define (post-/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)
- (post-/api/v1/statuses/:id/unreblog id))
- (case (response-code res)
- ((200) #t)
- (else
- (error "unreblog: failed" res body))))
-
-(define (post-/api/v1/statuses/:id/unreblog id)
- (request
- 'POST
- (format #f "/api/v1/statuses/~a/unreblog" id)
- #:authorization? #t))
-
-(define* (raw-request method path #:key (headers '()) (body "") authorization? streaming?)
- (receive (res body)
- (http-request (string-append "https://"
- (current-mastodon-host)
- path)
- #:method method
- #:headers `(,@headers
- ,@(and/nil
- authorization?
- `((authorization
- ,(string->symbol
- (string-append
- "Bearer "
- (current-mastodon-access-token)))))))
- #:decode-body? #f
- #:streaming? streaming?
- #:body body)
- (values res body)))
-
-(define* (request method path
- #:key
- json
- authorization?)
- (receive (res body)
- (raw-request method path
- #:body (and json
- (scm->json-string json))
- #:headers (and/nil json
- '((content-type application/json)))
- #:authorization? authorization?)
- (if (= 200 (response-code res))
- (values res (json-string->scm (utf8->string body)))
- (values res body))))
-
-(define* (fetch-account id)
- (receive (res body)
- (get-/api/v1/accounts/:id id)
- (case (response-code res)
- ((200) (make-account body))
- ((401)
- (error "fetch-account: Unauthorized" id))
- ((404)
- (error "fetch-account: Not Found" id))
- ((410)
- (error "fetch-account: Account is suspended" id))
- (else
- (error "fetch-account: failed"
- (response-code res)
- (utf8->string body))))))
-
-(define* (get-/api/v1/accounts/:id id)
- (request
- 'GET
- (format #f "/api/v1/accounts/~a" id)))
-
-(define (streaming-health?)
- (receive (res body)
- (get-/api/v1/streaming/health)
- (case (response-code res)
- ((200)
- (let ((result (utf8->string (get-bytevector-all body))))
- (close-input-port body)
- (string=? "OK" result)))
- (else
- #f))))
-
-(define (get-/api/v1/streaming/health)
- (raw-request 'GET "/api/v1/streaming/health" #:streaming? #t))
-
-(define (utf8-read-line in)
- (call/cc
- (lambda (k)
- (utf8->string
- (call-with-bytevector-output-port
- (lambda (out)
- (let loop ((b (get-u8 in)))
- (cond
- ((eof-object? b)
- (k b))
- ((or (= b 10))
- 'done)
- (else
- (put-u8 out b)
- (loop (get-u8 in)))))))))))
-
-(define (read-streaming port)
- (let ((line (utf8-read-line port)))
- (cond
- ((eof-object? line)
- (values (eof-object) ""))
- (else
- (let* ((i (string-index line #\:)))
- (if (or (not i)
- (<= i 1))
- (read-streaming port)
- (values
- (string-trim-both (substring line 0 i))
- (string-trim-both
- (substring line (+ i 1))))))))))
-
-(define (streaming-user handler)
- (streaming get-/api/v1/streaming/user handler))
-
-(define* (streaming-public handler #:key only-media?)
- (streaming (if only-media?
- get-/api/v1/streaming/public?only_media=true
- get-/api/v1/streaming/public)
- handler))
-
-(define* (streaming-local handler #:key only-media?)
- (streaming (if only-media?
- get-/api/v1/streaming/local?only_media=true
- get-/api/v1/streaming/local)
- handler))
-
-(define (streaming-hashtag hashtag handler)
- (streaming (lambda ()
- (get-/api/v1/streaming/hashtag?tag=:hashtag hashtag))
- handler))
-
-(define (streaming-local-hashtag hashtag handler)
- (streaming (lambda ()
- (get-/api/v1/streaming/hashtag/local?tag=:hashtag hashtag))
- handler))
-
-(define (streaming-list list-id handler)
- (streaming (lambda ()
- (get-/api/v1/streaming/list?list=:list_id list-id))
- handler))
-
-(define* (streaming-direct handler)
- (streaming get-/api/v1/streaming/direct handler))
-
-(define (streaming streamer handler)
- (receive (res body)
- (streamer)
- (case (response-code res)
- ((200)
- (dynamic-wind
- (lambda () 'ok)
- (lambda ()
- (let loop ((event #f))
- (receive (type data)
- (read-streaming body)
- (cond
- ((eof-object? type) 'end)
- ((string=? type "event")
- (loop (string->symbol data)))
- ((string=? type "data")
- (case event
- ((update)
- (handler event
- (make-status
- (json-string->scm data)))
- (loop #f))
- ((delete)
- (handler event data))
- ((notification)
- (handler event
- (make-notification
- (json-string->scm data)))
- (loop #f))
- (else
- (handler event data)
- (loop #f))))
- (else
- (format #t "[DEBUG] ~a: ~a" event data)
- (loop #f))))))
- (lambda ()
- (close-input-port body))))
- (else #f))))
-
-(define (get-/api/v1/streaming/user)
- (raw-request 'GET "/api/v1/streaming/user"
- #:streaming? #t
- #:authorization? #t))
-
-(define (get-/api/v1/streaming/public)
- (raw-request 'GET "/api/v1/streaming/public"
- #:streaming? #t))
-
-(define (get-/api/v1/streaming/public?only_media=true)
- (raw-request 'GET "/api/v1/streaming/public?only_media=true"
- #:streaming? #t))
-
-(define (get-/api/v1/streaming/local)
- (raw-request 'GET "/api/v1/streaming/local"
- #:streaming? #t))
-
-(define (get-/api/v1/streaming/local?only_media=true)
- (raw-request 'GET "/api/v1/streaming/local?only_media=true"
- #:streaming? #t))
-
-(define (get-/api/v1/streaming/hashtag?tag=:hashtag hashtag)
- (raw-request 'GET
- (format #f "/api/v1/streaming/hashtag?tag=~a" hashtag)
- #:streaming? #t))
-
-(define (get-/api/v1/streaming/hashtag/local?tag=:hashtag hashtag)
- (raw-request 'GET
- (format #f "/api/v1/streaming/hashtag/local?tag=~a" hashtag)
- #:streaming? #t))
-
-(define (get-/api/v1/streaming/list?list=:list_id hashtag)
- (raw-request 'GET
- (format #f "/api/v1/streaming/list?list=~a" hashtag)
- #:streaming? #t
- #:authorization? #t))
-
-(define (get-/api/v1/streaming/direct)
- (raw-request 'GET
- "/api/v1/streaming/direct"
- #:streaming? #t
- #:authorization? #t))