~williewillus/public-inbox

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/
*.sexp
*.patch
**/token
new_trick_data/
diff --git a/r16.rkt b/r16.rkt
index 3fc3cca..1f125f5 100755
--- a/r16.rkt
+++ b/r16.rkt
@@ -33,6 +33,7 @@
  (author
   body
   created
   [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)
  (check-trick-prereqs
@@ -132,6 +134,7 @@
             (thunk (ev:run
                     (trick-body trick)
                     (evaluation-ctx
                      trick
                      client
                      message
                      db
@@ -256,6 +259,7 @@
               (thunk (ev:run
                       (trick-body trick)
                       (evaluation-ctx
                        trick
                        client
                        message
                        db
@@ -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
                 trick-storage
                 (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))])
          (and
            (<= (bytes-length data) limit)
            (begin
              (hash-set! (trick-storage trick) key data)
              #t)))))))

; 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)]
         [ctx
          `((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.
} 
}
-- 
2.25.1
builds.sr.ht
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: