path: root/qkbox/toot.scm

;;; 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))