[gnunet-scheme] 03/03: examples/web: Implement the cadet-start-chat form.

[gnunet]

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.