Archived
1
0
Disbranĉigi 0

Support message-sending

This commit is contained in:
Jaidyn Ann 2023-05-31 00:47:16 -05:00
parent 1bf41f30ad
commit 79e8b61ac3
2 changed files with 36 additions and 1 deletions

View File

@ -62,6 +62,15 @@
(chatdir:channels irc-dir))))))) (chatdir:channels irc-dir)))))))
;; “Send” a message to the given chatdir root, simply by creating a file.
;; That was easy!
(define (send-message irc-dir channel message)
(with-output-to-file
(string-append irc-dir "/" channel "/.in/a")
(lambda ()
(write-string message))))
;; Returns all of a channel's messages — in alist format, with parsed datetimes. ;; Returns all of a channel's messages — in alist format, with parsed datetimes.
(define (channel-messages irc-dir channel) (define (channel-messages irc-dir channel)
(map (lambda (msg-alist) (map (lambda (msg-alist)
@ -139,6 +148,19 @@
body: (room-chat-html irc-dir channel)))) body: (room-chat-html irc-dir channel))))
(define (http-send-room-message irc-dir #!optional request path)
(let ([request-data (intarweb:read-urlencoded-request-data request 50000)]
[channel (third path)])
(if (alist-ref 'message request-data)
(begin
(send-message irc-dir channel (alist-ref 'message request-data))
;; We don't want the page to render before the message has been sent!
;; Then the user might think, “uhh my message not sent¿?”
(sleep 1)))
(http-get-room-dir irc-dir request path)))
;; Send response for the / index. ;; Send response for the / index.
(define (http-get-root #!optional irc-dir request path) (define (http-get-root #!optional irc-dir request path)
(spiffy:send-response status: 'ok body: (spiffy:send-response status: 'ok body:
@ -168,6 +190,11 @@
(("*") . ,http-get-root))) (("*") . ,http-get-root)))
;; An associative list of POST handlers, to be used by assoc-by-path.
(define http-post-handlers
`(((/ "room" "*") . ,http-send-room-message)))
;; Get a pair from an associative list based on the closest match to the ;; Get a pair from an associative list based on the closest match to the
;; given path. Wild-cards acceptable! For example… ;; given path. Wild-cards acceptable! For example…
;; '(/ "dad" "mom") matches, in order of precedence: ;; '(/ "dad" "mom") matches, in order of precedence:
@ -205,7 +232,11 @@
;; Handle all POST requests. ;; Handle all POST requests.
(define (http-post irc-dir request continue) (define (http-post irc-dir request continue)
(continue)) (let* ([path (uri:uri-path (intarweb:request-uri request))]
[handler (assoc-by-path path http-post-handlers)])
(if handler
(apply (cdr handler) (list irc-dir request path))
(continue))))
;; Creates a handler for all HTTP requests, with the given IRC dir. ;; Creates a handler for all HTTP requests, with the given IRC dir.

View File

@ -10,5 +10,9 @@
<table> <table>
{{LIST_ITEMS}} {{LIST_ITEMS}}
</table> </table>
<form method="post">
<input name="message" />
<button>Send</button>
</form>
</body> </body>
</html> </html>