[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 03/03: examples/web: Implement the cadet-start-chat form
From: |
gnunet |
Subject: |
[gnunet-scheme] 03/03: examples/web: Implement the cadet-start-chat form. |
Date: |
Thu, 18 Aug 2022 16:33:24 +0200 |
This is an automated email from the git hooks/post-receive script.
maxime-devos pushed a commit to branch master
in repository gnunet-scheme.
commit d5c2c781737ee831b067547d365f1b79c8048013
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Thu Aug 18 16:31:49 2022 +0200
examples/web: Implement the cadet-start-chat form.
* examples/web.scm (process-cadet-chat,parameters->cadet-address): New
procedures.
(url-handler)[/cadet-chat]: Implement the POST case.
---
examples/web.scm | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++-----
1 file changed, 63 insertions(+), 5 deletions(-)
diff --git a/examples/web.scm b/examples/web.scm
index 9708372..d2e4468 100644
--- a/examples/web.scm
+++ b/examples/web.scm
@@ -26,16 +26,30 @@
(gnu extractor enum)
(gnu gnunet block)
(gnu gnunet crypto)
+ (gnu gnunet crypto struct)
(gnu gnunet utils bv-slice)
+ (gnu gnunet utils cut-syntax)
+ ((gnu gnunet utils hat-let)
+ #:select (let^))
(gnu gnunet config db)
(gnu gnunet config fs)
+ ((gnu gnunet netstruct syntactic)
+ #:select (sizeof set%!))
(rnrs hashtables)
+ (gnu gnunet message protocols)
((gnu gnunet nse client)
#:prefix #{nse:}#)
((gnu gnunet dht client)
#:prefix #{dht:}#)
((gnu gnunet cadet client)
#:prefix #{cadet:}#)
+ (gnu gnunet cadet struct)
+ ((gnu gnunet data-string)
+ #:select (string->data))
+ ((gnu gnunet mq handler)
+ #:select (message-handlers message-handler))
+ ((gnu gnunet mq)
+ #:select (send-message!))
(web response)
(web server)
(web uri)
@@ -149,6 +163,41 @@ for success is used."
(decode/data (assoc-ref parameters "data-encoding")
(assoc-ref parameters "data"))))))
+(define (process-cadet-chat cadet-server parameters)
+ (define (connected) (values))
+ (define handlers
+ (message-handlers
+ (message-handler
+ (type (symbol-value message-type msg:cadet:command-line-traffic))
+ ((interpose exp) exp)
+ ((well-formed? slice) #true)
+ ((handle! slice)
+ (let^ ((! data (slice-slice slice (sizeof
/:msg:cadet:command-line-traffic '())))
+ (! string (data->string data)))
+ ;; TODO: would be nice to view the message on a web page
+ (format #t "Message received: ~s~%" string))))))
+ (define channel
+ (cadet:open-channel! cadet-server
+ (parameters->cadet-address parameters)
+ handlers))
+ (define mq (cadet:channel-message-queue channel))
+ (define message (string->utf8
+ (string-append (assoc-ref parameters "message")
+ "\n")))
+ (define s (make-slice/read-write
+ (+ (sizeof /:msg:cadet:command-line-traffic '())
+ (bytevector-length message))))
+ (define header (slice-slice s 0 (sizeof /:msg:cadet:command-line-traffic
'())))
+ (define-syntax set*
+ (cut-syntax set%! /:msg:cadet:command-line-traffic <> header <>))
+ (set* '(header size) (slice-length s))
+ (set* '(header type)
+ (value->index (symbol-value message-type
msg:cadet:command-line-traffic)))
+ (slice-copy! (bv-slice/read-write message)
+ (slice-slice s (sizeof /:msg:cadet:command-line-traffic '())))
+ (send-message! mq s)
+ (pk 'p channel mq))
+
(define (try-utf8->string bv) ; TODO: less duplication
(catch 'decoding-error
(lambda () (utf8->string bv))
@@ -176,6 +225,12 @@ If incorrect, return @code{#false}. TODO more validation."
#:desired-replication-level
desired-replication-level))))
+(define (parameters->cadet-address parameters)
+ (pk 'p parameters)
+ (cadet:make-cadet-address
+ (bv-slice/read-write (string->eddsa-public-key (assoc-ref parameters
"peer")))
+ (hash/sha512 (bv-slice/read-write (string->utf8 (assoc-ref parameters
"port"))))))
+
(define (process-search-dht dht-server parameters)
(define search-result)
(define found? (make-condition))
@@ -242,12 +297,15 @@ merely a race?")))
(if current-estimate
(estimate->html current-estimate)
'(p "No etimate yet")))))
- ("/cadet-chat"
- (respond/html `(div (p "You can only send a message to an already
existing chat here,
+ ("/cadet-chat" ; TODO check method and Content-Type, validation ...
+ (if (pk 'b body)
+ (process-cadet-chat cadet-server (urlencoded->alist body))
+ (respond/html
+ `(div (p "You can only send a message to an already existing chat
here,
not start new chats or view conversation.")
- (p "Run gnunet-cadet --open-port=PORT to run a new
chat!")
- (p "Send a message to a chat!")
- ,cadet-start-chat-form)))
+ (p "Run gnunet-cadet --open-port=PORT to run a new chat!")
+ (p "Send a message to a chat!")
+ ,cadet-start-chat-form))))
("/search-dht" ; TODO check method and Content-Type, validation ...
(if (pk 'b body)
(process-search-dht dht-server (urlencoded->alist body))
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.