[gnunet-scheme] 17/42: cadet/client: Use <loop> for various objects where possible.

[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 3c649c8727afdc24ed635a1f1ca7dda23463b783
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Sep 9 15:25:09 2022 +0200

    cadet/client: Use <loop> for various objects where possible.
    
    Fits better in (gnu gnunet server) that way.
    
    * gnu/gnunet/cadet/client.scm (reconnect): Use <loop> for various
    arguments.
    (connect): Adjust to new API.
    (spawn-procedure): Remove now unused procedure.
---
 gnu/gnunet/cadet/client.scm | 73 ++++++++++++++++++++++-----------------------
 1 file changed, 36 insertions(+), 37 deletions(-)

diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index af58f32..04ceb35 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -70,7 +70,11 @@
                make-disconnect!
                server-terminal-condition
                server-control-channel
-               handle-control-message!)
+               handle-control-message!
+               make-loop run-loop server->loop-arguments loop:control-channel
+               loop:lost-and-found loop:terminal-condition loop:configuration
+               loop:spawner loop:connected loop:disconnected
+               make-error-handler*/loop)
          (only (gnu gnunet hashcode struct)
                /hashcode:512)
          (only (gnu gnunet message protocols) message-type)
@@ -159,18 +163,16 @@
       "Asynchronuously connect to the CADET service, using the configuration
 @var{config}, returning a CADET server object."
       (define server (%make-server))
-      (spawn-procedure spawn config
-                      (server-terminal-condition server)
-                      (server-control-channel server)
-                      connected disconnected spawn
-                      (losable-lost-and-found server)
-                      empty-bbtree)
+      (define loop
+       (apply make-loop
+              #:configuration config
+              #:connected connected
+              #:disconnected disconnected
+              #:spawn spawn
+              (server->loop-arguments server)))
+      (spawn (lambda () (reconnect loop empty-bbtree)))
       server)
 
-    ;; TODO: reduce duplication with (gnu gnunet dht client)
-    (define (spawn-procedure spawn . rest)
-      (spawn (lambda () (apply reconnect rest))))
-
     ;; channel-number->channel-map:
     ;;   A 'bbtree' from channel numbers to their corresponding
     ;;   <channel> object, or nothing if the control loop
@@ -178,14 +180,11 @@
     ;;   has been closed.
     ;;
     ;;   TODO: GC problems, split in external and internal parts
-    (define (reconnect config terminal-condition control-channel
-                      connected disconnected spawn
-                      lost-and-found
-                      channel-number->channel-map)
+    (define (reconnect loop channel-number->channel-map)
       (define loop-operation
        (choice-operation
-        (get-operation control-channel)
-        (wrap-operation (collect-lost-and-found-operation lost-and-found)
+        (get-operation (loop:control-channel loop))
+        (wrap-operation (collect-lost-and-found-operation (loop:lost-and-found 
loop))
                         (lambda (lost) (cons 'lost lost)))))
       (define handlers
        (message-handlers
@@ -200,7 +199,8 @@
                  (! channel-number
                     (read% /:msg:cadet:local:data '(channel-number) header))
                  (! channel
-                    (maybe-ask* terminal-condition control-channel 'channel
+                    (maybe-ask* (loop:terminal-condition loop)
+                                (loop:control-channel loop) 'channel
                                 channel-number))
                  (? (not channel)
                     ???))
@@ -216,21 +216,20 @@
           ;; The slice needs to be read here (and not in 'control'), as it 
might
           ;; later be reused for something different.
           (let ((channel-number (analyse-local-acknowledgement slice)))
-            (maybe-send-control-message!* terminal-condition control-channel
-                                          'acknowledgement
-                                          channel-number))))))
-      (define error-handler
-       (make-error-handler connected disconnected terminal-condition
-                           control-channel))
-      (define mq (connect/fibers config "cadet" handlers error-handler
-                                #:spawn spawn))
+            (maybe-send-control-message!*
+             (loop:terminal-condition loop)
+             (loop:control-channel loop)
+             'acknowledgement
+             channel-number))))))
+      (define error-handler (make-error-handler*/loop loop))
+      (define mq (connect/fibers
+                 (loop:configuration loop) "cadet" handlers error-handler
+                 #:spawn (loop:spawner loop)))
       (define (k/reconnect! channel-number->channel-map)
-       (reconnect config terminal-condition control-channel connected
-                  disconnected spawn lost-and-found
-                  channel-number->channel-map))
-      (define (control channel-number->channel-map next-free-channel-number)
+       (reconnect loop channel-number->channel-map))
+      (define (control loop channel-number->channel-map 
next-free-channel-number)
        "The main event loop."
-       (control* channel-number->channel-map next-free-channel-number
+       (control* loop channel-number->channel-map next-free-channel-number
                  (perform-operation loop-operation)))
       (define (close-if-possible! channel)
        ;; Pre-conditions:
@@ -244,12 +243,12 @@
                          (channel-channel-number channel)))
          ;; We don't need the envelope.
          (values)))
-      (define (control* channel-number->channel-map next-free-channel-number
+      (define (control* loop channel-number->channel-map 
next-free-channel-number
                        message)
        (define (continue)
-         (control channel-number->channel-map next-free-channel-number))
+         (control loop channel-number->channel-map next-free-channel-number))
        (define (continue* message)
-         (control* channel-number->channel-map next-free-channel-number
+         (control* loop channel-number->channel-map next-free-channel-number
                    message))
        ;; TODO: what about closed channels?
        (define (send-channel-stuff! channel)
@@ -331,7 +330,7 @@
                     (bbtree-set channel-number->channel-map channel-number
                                 channel)))
                 (send-local-channel-create! mq channel)
-                (control channel-number->channel-map 
next-free-channel-number)))
+                (control loop channel-number->channel-map 
next-free-channel-number)))
          (('close-channel! channel)
           ;; 'close-channel!' can only be sent after the <channel> object
           ;; was returned by the procedure 'open-channel!', because only
@@ -395,10 +394,10 @@
                   (continue* '(disconnect!))))))))
          (rest
           (handle-control-message!
-           rest mq terminal-condition
+           rest mq (loop:terminal-condition loop)
            (cut k/reconnect! channel-number->channel-map)))))
       ;; Start the main event loop.
-      (control channel-number->channel-map %minimum-local-channel-id))
+      (control loop channel-number->channel-map %minimum-local-channel-id))
 
     (define-record-type (<cadet-address> make-cadet-address cadet-address?)
       (fields (immutable peer cadet-address-peer)

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