[gnunet-scheme] 02/02: cadet/client: Implement sending data.

[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 aa9df4ca3d12e5764956baa927f1ed32bb0820ee
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Aug 16 17:55:38 2022 +0200

    cadet/client: Implement sending data.
    
    * gnu/gnunet/cadet/client.scm
    (reconnect)[control*]<send-channel-stuff!>: New procedure.
    (reconnect)[control*]<send-channel-stuff!>: Use it to handle the message.
---
 gnu/gnunet/cadet/client.scm | 54 +++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 50 insertions(+), 4 deletions(-)

diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index 83b02fe..fa8c7ed 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -55,7 +55,10 @@
                losable-lost-and-found)
          (only (gnu gnunet mq handler)
                message-handlers message-handler)
-         (only (gnu gnunet mq) close-queue! send-message!)
+         (only (gnu gnunet mq)
+               close-queue! send-message! make-one-by-one-sender)
+         (only (gnu gnunet mq envelope)
+               attempt-irrevocable-sent!)
          (only (gnu gnunet server)
                maybe-send-control-message! make-error-handler
                make-disconnect!
@@ -78,10 +81,13 @@
                let^)
          (only (rnrs base)
                begin define lambda assert quote cons apply values
-               case else = define-syntax + expt - let* let and)
+               case else = define-syntax + expt - let* let and >=)
+         (only (rnrs control)
+               unless)
          (only (rnrs records syntactic) define-record-type)
+         (only (ice-9 control) let/ec)
          (only (ice-9 match) match)
-         (only (guile) define*)
+         (only (guile) define* error)
          (only (fibers) spawn-fiber)
          (only (fibers channels) get-operation put-operation make-channel)
          (only (fibers conditions) make-condition wait-operation
@@ -176,6 +182,46 @@
          (control next-free-channel-number))
        (define (continue* message)
          (control* next-free-channel-number message))
+       (define (send-channel-stuff! channel)
+         ;; Send messages one-by-one, keeping in mind that we might not be able
+         ;; to send all messages to the service at once, only 
'channel-allow-send'
+         ;; messages can be sent and this decreases by sending messages.
+         ;;
+         ;; TODO: use priority information, somehow when cancelling a message
+         ;; cancel the corresponding message to be sent to the CADET service 
when
+         ;; there is still time, zero-copy networking.
+         ;;
+         ;; TODO: integration with local-acknowledgement
+         ;;
+         ;; TODO: untested
+         (let/ec
+          stop
+          (define (stop-if-exhausted)
+            (unless (>= (channel-allow-send channel) 0)
+              (stop)))
+          (define (decrement!)
+            (set-channel-allow-send! channel
+                                     (- (channel-allow-send channel) 1)))
+          ;; It is important to check that a message can be sent before
+          ;; send! is called, otherwise the message will be removed from
+          ;; the message queue and be forgotten without being ever sent.
+          (stop-if-exhausted)
+          (define (send! envelope)
+            (attempt-irrevocable-sent!
+             envelope
+             ((go message priority)
+              (send-message! mq
+                             (construct-local-data
+                              (channel-channel-number channel)
+                              0 ;; TODO: relation between priority and 
priority-preference?
+                              message))
+              (decrement!))
+             ((cancelled) (values))
+             ((already-sent) (error "tried to send an envelope twice 
(CADET)")))
+            ;; Exit once nothing can be sent anymore (TODO check if
+            ;; make-one-by-one-sender allows non-local exits).
+            (stop-if-exhausted))
+          ((make-one-by-one-sender send!) (channel-message-queue channel))))
        (match message
          (('open-channel! channel)
           (let* ((channel-number next-free-channel-number)
@@ -191,7 +237,7 @@
           (continue))
          (('send-channel-stuff! message-queue channel)
           ;; Tell the service to send the messages over CADET.
-          TODO
+          (send-channel-stuff! channel)
           (continue))
          (('lost . lost)
           (let loop ((lost lost))

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.