r16: Implement trick-local storage v1 SUPERSEDED

: 1
 Implement trick-local storage

 3 files changed, 64 insertions(+), 6 deletions(-)
#464962 linux_buildtest.yml success
Export patchset (mbox)
How do I use this?

Copy & paste the following snippet into your terminal to import this patchset into git:

curl -s https://lists.sr.ht/~williewillus/public-inbox/patches/21321/mbox | git am -3
Learn more about email & git
View this thread in the archives

[PATCH r16] Implement trick-local storage Export this patch

From: Alwinfy <20421383+Alwinfy@users.noreply.github.com>

Trick-local storage is currently *transient*.
By necessity, evaluation-contexts now know what trick they're from;
read/write are no-ops for `!rkt eval`.
Storage comes in three varieties: global (64kb), per-channel (8kb), per-user (2kb).
Right now they use `write` for measuring/saving stored data, for lower overhead than `serialize`.

 .gitignore            |  1 +
 r16.rkt               | 39 +++++++++++++++++++++++++++++++++++++--
 scribblings/r16.scrbl | 30 ++++++++++++++++++++++++++----
 3 files changed, 64 insertions(+), 6 deletions(-)

diff --git a/.gitignore b/.gitignore
index ebc25e8..01cf6e4 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,3 +4,4 @@ compiled/
diff --git a/r16.rkt b/r16.rkt
index 3fc3cca..1f125f5 100755
--- a/r16.rkt
+++ b/r16.rkt
@@ -33,6 +33,7 @@
   [storage #:mutable]
   [invocations #:mutable]))

(define (can-modify? message trick)
@@ -101,12 +102,13 @@
  (trick (if parent (trick-author parent) (message-author-id message))
         (strip-backticks body)
         (if parent (trick-created parent) (rc:message-timestamp message))
         (if parent (trick-storage parent) (make-hash))
         (if parent (trick-invocations parent) 0)))

(define (run-snippet client db message code)
  (let ([code (strip-backticks code)])
    (with-typing-indicator client message
      (thunk (ev:run code (evaluation-ctx client message db (context-id message) "" #f))))))
      (thunk (ev:run code (evaluation-ctx #f client message db (context-id message) "" #f))))))

(define (register-trick client db message text)
@@ -132,6 +134,7 @@
             (thunk (ev:run
                     (trick-body trick)
@@ -256,6 +259,7 @@
               (thunk (ev:run
                       (trick-body trick)
@@ -268,6 +272,33 @@
          (apply values vals))
        (raise (make-exn:fail:contract (~a "Trick " name " doesn't exist!"))))))

(define (storage-info message type)
  (match type
    ['guild   (cons 65536 'global)]
    ['channel (cons 8192  (rc:message-channel-id message))]
    ['user    (cons 2048  (message-author-id message))]
    [_        (cons 0     #f)]))

(define/contract (read-storage trick message type)
  (-> (or/c trick? #f) rc:message? (or/c 'guild 'channel 'user) any/c)
  (let ([datum (and~> trick
                 (hash-ref (cdr (storage-info message type)) #f)
                 (with-input-from-bytes read)
                 (with-handlers ([exn:fail:read? (const #f)]) _))])
    (and (not (eof-object? datum)) datum)))
(define/contract (write-storage trick message type data)
  (-> (or/c trick? #f) rc:message? (or/c 'guild 'channel 'user) any/c boolean?)
  (and trick
    (match-let ([(cons limit key) (storage-info message type)])
      (and key
        (let ([data (with-output-to-bytes (curry write data))])
            (<= (bytes-length data) limit)
              (hash-set! (trick-storage trick) key data)

; client -> (emote name -> emote id)
(define emote-lookup-cache (make-hash))

@@ -310,7 +341,7 @@
         ; If empty byte string returned, return #f
         (and data (positive? (bytes-length data)) data)))))))

(define (evaluation-ctx client message db context-id args parent-ctx)
(define (evaluation-ctx trick client message db context-id args parent-ctx)
  (let* ([placeholder (make-placeholder #f)]
          `((message-contents . ,(rc:message-content message))
@@ -329,6 +360,9 @@
            (delete-caller    . ,(thunk (thread-send deleter-thread (cons client message))))
            (make-attachment  . ,make-attachment)
            (call-trick       . ,(call-subtrick client db context-id message placeholder))
            (message-author   . ,(message-author-id message))
            (read-storage     . ,(curry read-storage trick message))
            (write-storage    . ,(curry write-storage trick message))
            (parent-context   . ,parent-ctx))])
    (placeholder-set! placeholder (make-hash ctx))
    (cons (make-reader-graph ctx) '(threading))))
@@ -344,6 +378,7 @@
   (hash-ref json 'author)
   (hash-ref json 'body)
   (hash-ref json 'created)
   (make-hash) ; We purposefully don't save the trick storage due to space limits
   (hash-ref json 'invocations)))

(define command-table
diff --git a/scribblings/r16.scrbl b/scribblings/r16.scrbl
index 2052f3c..11ae4a0 100644
--- a/scribblings/r16.scrbl
+++ b/scribblings/r16.scrbl
@@ -19,8 +19,8 @@ All symbols from the @racket[threading-lib] package are available for convenienc
                          [mime (or/c symbol? string? bytes?)]) any/c]{
Creates an attachment with payload @racket[payload], filename @racket[name], and MIME-type @racket[mime].
This opaque object must be returned from the trick to be sent to Discord.
If more than one attachment is returned, an unspecified one is sent.                      
If more than one attachment is returned, an unspecified one is sent.

@defproc[(call-trick [name (or/c symbol? string?)]
                     [argument any/c]) any/c]{
@@ -48,10 +48,32 @@ Function that returns the ID for emote with name @racket[name], or @racket[#f] i
Function that returns the PNG data of the emote with ID @racket[id], or @racket[#f] if it doesn't exist.

@defproc[(read-storage [type (or/c 'guild 'channel 'user)]) any/c]{
Reads "trick-local storage" @racket[name] and return its result, or @racket[#f] if the result is uninitialized.

A trick's "trick-local storage" can be per-guild, per-channel, or per-user.

This will always return @racket[#f] for the eval command.

@defproc[(write-storage [type (or/c 'guild 'channel 'user)]
                        [data any/c]) boolean?]{
Writes @racket[data] to the trick's "trick-local storage," overwriting any existing value, and returns whether the write succeeded. All data supported by @racket[write] can be written.

A trick's "trick-local storage" can be per-guild, per-channel, or per-user; each type of storage has its own limitation on size:
@tabular[#:sep @hspace[1]
  `(,(list @bold{Type} @bold{Size Limit})
          ("guild"     "64kb")
          ("channel"   "8kb")
          ("user"      "2kb"))]

This will always be a no-op for the eval command.

@defproc[(delete-caller) void?]{
Thunk that deletes the message that invoked this sandbox.

@defthing[parent-context (or/c (hash/c symbol? any/c) #f)]{
Mapping of all the above symbols for the trick calling this one, or @racket[#f] if this trick is the top level invocation.
r16/patches/linux_buildtest.yml: SUCCESS in 1m26s

[Implement trick-local storage][0] from [][1]

[0]: https://lists.sr.ht/~williewillus/public-inbox/patches/21321
[1]: mailto:wenming.yi@gmail.com

✓ #464962 SUCCESS r16/patches/linux_buildtest.yml https://builds.sr.ht/~williewillus/job/464962
Looks good, just rebase and also reformat to match normal lisp indenting
conventions. In particular, all arguments should always be aligned.

wenming.yi@gmail.com writes: