[gnunet-scheme] 11/42: dht: Use <loop> for state 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 1aaa33c71268a5d7de6c4f4ef48d8478a92317f9
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Thu Sep 8 21:30:04 2022 +0200

    dht: Use <loop> for state where possible.
    
    This brings it closer to (gnu gnunet server).
    
    * gnu/gnunet/server.scm: Export more.
    * gnu:gnunet/dht/client.scm (connect): Adjust to new behaviour of
    'reconnect'.
    (reconnect): Move all arguments except for 'old-id->operation-map'
    into a new 'loop' argument of type <loop>. Adjust inner code
    appropriately.
---
 gnu/gnunet/dht/client.scm | 53 ++++++++++++++++++++++++++---------------------
 gnu/gnunet/server.scm     |  4 ++--
 2 files changed, 31 insertions(+), 26 deletions(-)

diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 217d3d7..ee2788b 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -83,7 +83,11 @@
                maybe-send-control-message! maybe-send-control-message!*
                make-error-handler maybe-ask* answer
                <server> server-terminal-condition server-control-channel
-               make-disconnect! handle-control-message!)
+               make-disconnect! handle-control-message!
+               make-loop loop:control-channel loop:connected
+               loop:disconnected loop:configuration loop:service-name
+               loop:spawner loop:terminal-condition loop:lost-and-found
+               loop:control-channel)
          (only (guile)
                pk define-syntax-rule define* lambda* error
                ->bool and=>)
@@ -753,12 +757,14 @@ code automatically tries to reconnect, so @var{connected} 
can be called after
       ;; We could do @code{(spawn (lambda () (reconnect ...)))} here instead,
       ;; but that causes ‘(DHT) garbage collectable’ to fail.
       (spawn-procedure spawn old-id->operation-map
-                      #:terminal-condition (server-terminal-condition server)
-                      #:config config
-                      #:control-channel (server-control-channel server)
-                      #:lost-and-found (losable-lost-and-found server)
-                      #:connected connected
-                      #:disconnected disconnected #:spawn spawn)
+                      (make-loop
+                       #:terminal-condition (server-terminal-condition server)
+                       #:configuration config
+                       #:service-name "dht"
+                       #:control-channel (server-control-channel server)
+                       #:lost-and-found (losable-lost-and-found server)
+                       #:connected connected
+                       #:disconnected disconnected #:spawn spawn))
       server)
     (define (spawn-procedure spawn . rest)
       (spawn (lambda () (apply reconnect rest))))
@@ -840,12 +846,7 @@ operation is cancelled, return @code{#false} instead."
 
     (define empty-bbtree (make-bbtree <))
 
-    (define* (reconnect old-id->operation-map
-                       #:key terminal-condition config
-                       control-channel lost-and-found
-                       (spawn spawn-fiber)
-                       connected disconnected
-                       #:rest rest)
+    (define (reconnect old-id->operation-map loop)
       ;; The 'id->operation-map' holds get operations that have
       ;; been communicated to the service.  The 'old-id->operation-map'
       ;; is used for reconnecting and holds get operations that need
@@ -864,14 +865,17 @@ operation is cancelled, return @code{#false} instead."
       ;;
       ;; This code is written to support both the correct and incorrect 
behaviour
       ;; of guardians+weak vectors.
-      (define handlers (apply make-message-handlers
-                             #:terminal-condition terminal-condition
-                             #:control-channel control-channel rest))
+      (define handlers
+       (make-message-handlers
+        #:terminal-condition (loop:terminal-condition loop)
+        #:control-channel (loop:control-channel loop)))
       (define error-handler
-       (make-error-handler connected disconnected terminal-condition
-                           control-channel))
-      (define mq (connect/fibers config "dht" handlers error-handler
-                                #:spawn spawn))
+       (make-error-handler (loop:connected loop) (loop:disconnected loop)
+                           (loop:terminal-condition loop)
+                           (loop:control-channel loop)))
+      (define mq (connect/fibers (loop:configuration loop)
+                                (loop:service-name loop) handlers error-handler
+                                #:spawn (loop:spawner loop)))
       (define (process-stop-search old-id->operation-map id->operation-map get)
        ;; TODO: tests!
        ;; TODO: cancel outstanding messages to the DHT services for this
@@ -888,11 +892,12 @@ operation is cancelled, return @code{#false} instead."
       (define (k/reconnect! old-id->operation-map id->operation-map)
        ;; Self-check to make sure no information will be lost.
        (assert (= (bbtree-size old-id->operation-map) 0))
-       (apply reconnect id->operation-map rest))
+       (reconnect id->operation-map loop))
       (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 (control old-id->operation-map id->operation-map)
        "The main event loop."
@@ -972,7 +977,7 @@ operation is cancelled, return @code{#false} instead."
                   (control* old-id->operation-map id->operation-map
                             '(disconnect!))))))))
          (rest (handle-control-message!
-                rest mq terminal-condition
+                rest mq (loop:terminal-condition loop)
                 (cut k/reconnect! old-id->operation-map id->operation-map)))))
       ;; Start the main event loop.
       (control old-id->operation-map empty-bbtree))))
diff --git a/gnu/gnunet/server.scm b/gnu/gnunet/server.scm
index 5d681e2..61bc322 100644
--- a/gnu/gnunet/server.scm
+++ b/gnu/gnunet/server.scm
@@ -27,8 +27,8 @@
          handle-control-message!
          <loop> make-loop
          loop:connected loop:disconnected loop:terminal-condition
-         loop:control-channel
-         run-loop)
+         loop:control-channel loop:configuration loop:service-name
+         loop:spawner loop:lost-and-found run-loop)
   (import (only (rnrs base)
                begin define cons case else apply values quote lambda
                if error list let and append)

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