eutro: 1 Add open-attachment 3 files changed, 69 insertions(+), 31 deletions(-)
Copy & paste the following snippet into your terminal to import this patchset into git:
curl -s https://lists.sr.ht/~williewillus/public-inbox/patches/25400/mbox | git am -3Learn more about email & git
--- frontends/discord.rkt | 83 ++++++++++++++++++++++++++++--------------- info.rkt | 3 +- scribblings/r16.scrbl | 14 +++++++- 3 files changed, 69 insertions(+), 31 deletions(-) diff --git a/frontends/discord.rkt b/frontends/discord.rkt index 9923cbe..532217a 100644 --- a/frontends/discord.rkt +++ b/frontends/discord.rkt @@ -33,6 +33,13 @@ (define (message-author-id message) (hash-ref (hash-ref message 'author) 'id)) +(define-syntax-rule (thread-loop body ...) + (thread + (thunk + (let loop () + body ... + (loop))))) + (define discord-frontend% (class* object% [r16-frontend<%>] (init-field client) @@ -70,13 +77,10 @@ (http:trigger-typing-indicator client channel))) (define _typing-thread - (thread - (thunk - (let loop () - (for ([(channel _) (unbox counters-box)]) - (trigger-typing channel)) - (sleep 5) - (loop))))) + (thread-loop + (for ([(channel _) (unbox counters-box)]) + (trigger-typing channel)) + (sleep 5))) (lambda (proc) (define channel (hash-ref (current-message) 'channel_id)) @@ -86,30 +90,33 @@ (thunk (change-counter channel -1)))))) (define deleter-thread - (thread - (thunk - (let loop () - (match-let ([(cons client message) (thread-receive)]) - (with-handlers ([exn:fail:network? identity]) - (http:delete-message - client - (hash-ref message 'channel_id) - (hash-ref message 'id))) - (loop)))))) + (thread-loop + (match-let ([(cons client message) (thread-receive)]) + (with-handlers ([exn:fail:network? identity]) + (http:delete-message + client + (hash-ref message 'channel_id) + (hash-ref message 'id)))))) (define emote-image-thread - (thread - (thunk - (let loop () - (let ([message (thread-receive)]) - ; TODO this only uses PNG, racket-cord needs to expose an animated field on emoji - (channel-put (cdr message) - (with-handlers ([exn:fail? (const #f)]) - (~> (~a "https://cdn.discordapp.com/emojis/" (car message) ".png?v=1") - string->url - get-pure-port - port->bytes)))) - (loop))))) + (thread-loop + (let ([message (thread-receive)]) + ; TODO this only uses PNG, racket-cord needs to expose an animated field on emoji + (channel-put (cdr message) + (with-handlers ([exn:fail? (const #f)]) + (~> (~a "https://cdn.discordapp.com/emojis/" (car message) ".png?v=1") + string->url + get-pure-port + port->bytes)))))) + + (define open-attachment-thread + (thread-loop + (match-define (list url cust chan) (thread-receive)) + (define port + (with-handlers ([exn:fail? (const #f)]) + (parameterize ([current-custodian cust]) + (get-pure-port url)))) + (channel-put chan port))) (define current-message (make-parameter #f)) @@ -149,6 +156,7 @@ (define/public (get-enrich-context) (define message (current-message)) (define message-contents (hash-ref message 'content)) + (define message-attachments (or (hash-ref message 'attachments #f) null)) (define message-author (message-author-id message)) (define/contract (emote-image id) @@ -171,6 +179,22 @@ (-> bytes? (or/c string? bytes?) (or/c symbol? string? bytes?) http:attachment?) (http:attachment data (~a type) name)) + (define attachment-count (length message-attachments)) + + (define/contract (open-attachment [index 0]) + (->* () (exact-nonnegative-integer?) (or/c input-port? #f)) + (let/cc return + (define chan (make-channel)) + (when (>= index attachment-count) + (return #f)) + (define attachment (list-ref message-attachments index)) + #; ;; is an attachment size cap necessary? + (when (> (hash-ref attachment 'size) OPEN_ATTACHMENT_MAX_SIZE_BYTES) + (return #f)) + (define attachment-url (string->url (hash-ref attachment 'proxy_url))) + (thread-send open-attachment-thread (list attachment-url (current-custodian) chan)) + (channel-get chan))) + (define (storage-info type) (match type ['guild (cons 65536 'global)] @@ -214,6 +238,7 @@ (read-storage . ,(read-storage trick-obj)) (write-storage . ,(write-storage trick-obj)) (attachment-data . ,http:attachment-data) + (open-attachment . ,open-attachment) ,@(car base)) ,@(cdr base)))) diff --git a/info.rkt b/info.rkt index f0301b0..0ff3f17 100644 --- a/info.rkt +++ b/info.rkt @@ -8,6 +8,7 @@ "threading-lib")) (define build-deps '("racket-doc" "rackunit-lib" - "scribble-lib")) + "scribble-lib" + "threading-doc")) (define test-omit-paths '("presentation")) (define scribblings '(("scribblings/r16.scrbl" ()))) diff --git a/scribblings/r16.scrbl b/scribblings/r16.scrbl index a55282e..35d39b8 100644 --- a/scribblings/r16.scrbl +++ b/scribblings/r16.scrbl @@ -1,6 +1,6 @@ #lang scribble/manual -@(require (for-label racket/base)) +@(require (for-label racket/base (only-in racket/math natural?) racket/contract)) @title{R16 -- Community-Driven Interactive Code Evaluation} @@ -94,6 +94,7 @@ The @tt{frontend} object in the configuration file can have the following keys a ] @subsection{Trick Environment Extensions} + In additional to the bindings described above, the following items are available in the trick environment. @@ -143,3 +144,14 @@ A trick's "trick-local storage" can be per-guild, per-channel, or per-user; each } This will always be a no-op when invoked from the eval command. + +@defproc[(attachment-data [attachment any/c]) bytes?]{ +Get the payload of an attachment created with @racket[make-attachment]. +} + +@defproc[(open-attachment [index natural? 0]) (or/c input-port? #f)]{ +Opens the @racket[index]th attachment of the message as an input port. + +Returns @racket[#f] if the message doesn't have an @racket[index]th attachment, or +if the attachment couldn't be opened for any other reason. +} -- 2.33.0
builds.sr.ht <builds@sr.ht>r16/patches/linux_buildtest.yml: SUCCESS in 1m47s [Add open-attachment][0] from [eutro][1] [0]: https://lists.sr.ht/~williewillus/public-inbox/patches/25400 [1]: mailto:benedek.szilvasy@gmail.com ✓ #595486 SUCCESS r16/patches/linux_buildtest.yml https://builds.sr.ht/~williewillus/job/595486