[gnunet-scheme] 21/42: server: Unify loop spawning.

[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 d4bf64f2cc35619b6da7c58db366a0d37255b4e2
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Sep 9 17:15:47 2022 +0200

    server: Unify loop spawning.
    
    Reduces duplication and imports.
    
    * gnu/gnunet/server.scm (spawn-server-loop): New procedure.
    * gnu/gnunet/nse/client.scm (<loop>): Give a default value to 'default'.
    (connect): Remove default value of 'updated', as it is unused.  Also
    use spawn-server-loop.
    * gnu/gnunet/dht/client.scm (connect): Likewise
    * gnu/gnunet/cadet/client.scm (connect): Likewise
---
 gnu/gnunet/cadet/client.scm | 28 +++++++++++-----------------
 gnu/gnunet/dht/client.scm   | 40 ++++++++++------------------------------
 gnu/gnunet/nse/client.scm   | 33 +++++++++++----------------------
 gnu/gnunet/server.scm       | 15 +++++++++++++--
 4 files changed, 45 insertions(+), 71 deletions(-)

diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index 7de91fb..7772cd5 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -69,7 +69,7 @@
                server-terminal-condition
                server-control-channel
                handle-control-message!
-               make-loop run-loop server->loop-arguments loop:control-channel
+               make-loop run-loop spawn-server-loop loop:control-channel
                loop:terminal-condition)
          (only (gnu gnunet hashcode struct)
                /hashcode:512)
@@ -88,7 +88,7 @@
          (only (rnrs base)
                begin define lambda assert quote cons apply values
                case else = define-syntax + expt - let and >
-               not if <)
+               not if < append list)
          (only (rnrs control)
                when)
          (only (pfds bbtrees)
@@ -148,23 +148,17 @@
 
     (define empty-bbtree (make-bbtree <))
 
-    (define* (connect config #:key (connected values) (disconnected values)
-                     (spawn spawn-fiber))
+    (define* (connect config #:key connected disconnected spawn #:rest r)
       "Asynchronuously connect to the CADET service, using the configuration
 @var{config}, returning a CADET server object."
-      (define server (%make-server))
-      (define loop
-       (apply make-loop
-              #:make-message-handlers make-message-handlers
-              #:control-message-handler control-message-handler
-              #:service-name "cadet"
-              #:configuration config
-              #:connected connected
-              #:disconnected disconnected
-              #:spawn spawn
-              (server->loop-arguments server)))
-      (spawn (lambda () (run-loop loop empty-bbtree 
%minimum-local-channel-id)))
-      server)
+      (apply spawn-server-loop (%make-server)
+            #:make-message-handlers make-message-handlers
+            #:control-message-handler control-message-handler
+            #:service-name "cadet"
+            #:configuration config
+            #:initial-extra-loop-arguments
+            (list empty-bbtree %minimum-local-channel-id)
+            r))
 
     ;; channel-number->channel-map:
     ;;   A 'bbtree' from channel numbers to their corresponding
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index bd0feb4..d4c32eb 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -77,17 +77,14 @@
          (gnu gnunet hashcode struct)
          (gnu gnunet mq)
          (gnu gnunet mq handler)
-         (gnu gnunet mq-impl stream)
          (gnu gnunet mq envelope)
          (only (gnu gnunet server)
                maybe-send-control-message! maybe-send-control-message!*
                maybe-ask* answer
                <server> server-terminal-condition server-control-channel
                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 run-loop server->loop-arguments)
+               loop:terminal-condition loop:control-channel
+               run-loop spawn-server-loop)
          (only (guile)
                pk define-syntax-rule define* lambda* error
                ->bool and=>)
@@ -102,16 +99,7 @@
                bbtree-delete make-bbtree bbtree-ref)
          (only (gnu extractor enum)
                symbol-value)
-         (only (fibers)
-               spawn-fiber)
-         (only (fibers conditions)
-               make-condition signal-condition! wait-operation wait)
-         (only (fibers operations)
-               perform-operation choice-operation wrap-operation)
-         (only (fibers channels)
-               put-operation get-operation put-message)
          (only (gnu gnunet concurrency lost-and-found)
-               make-lost-and-found collect-lost-and-found-operation
                losable-lost-and-found)
          (gnu gnunet dht struct)
          (only (gnu gnunet message protocols)
@@ -130,7 +118,7 @@
                quote case else values apply let cond if > eq?
                <= expt assert exact? integer? lambda for-each
                not expt min max div-and-mod positive? define-syntax
-               vector cons)
+               vector cons append list)
          (only (rnrs control)
                unless when)
          (only (rnrs records syntactic)
@@ -744,27 +732,19 @@ message header is assumed to be correct."
       (make-disconnect! 'distributed-hash-table ; for error messages
                        server:dht?))
 
-    (define* (connect config #:key (connected values) (disconnected values)
-                     (spawn spawn-fiber))
+    (define* (connect config #:key connected disconnected spawn #:rest r)
       "Connect to the DHT service, using the configuration @var{config}.  The
 connection is made asynchronuously; the optional thunk @var{connected} is 
called
 when the connection has been made.  The connection can break; the optional 
thunk
 @var{disconnected} is called when it does. If the connection breaks, the client
 code automatically tries to reconnect, so @var{connected} can be called after
 @var{disconnected}.  This procedure returns a DHT server object."
-      (define server (make-server))
-      (define loop
-       (apply make-loop
-              #:make-message-handlers make-message-handlers
-              #:control-message-handler control-message-handler
-              #:configuration config
-              #:service-name "dht"
-              #:spawn spawn
-              #:connected connected
-              #:disconnected disconnected #:spawn spawn
-              (server->loop-arguments server)))
-      (spawn (lambda () (run-loop loop empty-bbtree empty-bbtree)))
-      server)
+      (apply spawn-server-loop (make-server)
+            #:make-message-handlers make-message-handlers
+            #:control-message-handler control-message-handler
+            #:configuration config
+            #:service-name "dht"
+            #:initial-extra-loop-arguments (list empty-bbtree empty-bbtree) r))
 
     ;; TODO: put in new module?
     (define (make-weak-reference to)
diff --git a/gnu/gnunet/nse/client.scm b/gnu/gnunet/nse/client.scm
index 0cc4300..126dedc 100644
--- a/gnu/gnunet/nse/client.scm
+++ b/gnu/gnunet/nse/client.scm
@@ -66,12 +66,8 @@
           (gnu gnunet message protocols)
          (only (gnu gnunet server)
                <server> make-disconnect!
-               server-terminal-condition
-               server-control-channel
                handle-control-message!
-               <loop> run-loop server->loop-arguments
-               loop:connected loop:disconnected
-               loop:control-channel loop:terminal-condition)
+               <loop> spawn-server-loop run-loop loop:terminal-condition)
           (only (gnu gnunet nse struct)
                /:msg:nse:estimate))
   (begin
@@ -129,7 +125,8 @@ timestamp."
              (immutable estimate/box loop:estimate/box))
       (protocol
        (lambda (%make)
-        (lambda* (#:key updated estimate/box #:allow-other-keys #:rest r)
+        (lambda* (#:key (updated values) estimate/box #:allow-other-keys
+                  #:rest r)
           ((apply %make r) updated estimate/box)))))
 
     ;; See 'connect'.  TODO: gc test fails
@@ -187,8 +184,8 @@ timestamp."
         (handle-control-message! message message-queue
                                  (loop:terminal-condition loop) 
k/reconnect!))))
 
-    (define* (connect config #:key (updated values) (connected values)
-                     (disconnected values) (spawn spawn-fiber))
+    (define* (connect config #:key updated connected disconnected spawn
+                     #:rest r)
       "Connect to the NSE service in the background.
 
 When connected, the thunk @var{connected} is called and estimates
@@ -201,17 +198,9 @@ shortly after calling @var{disconnected}.
 
 The procedures @var{updated}, @var{connected} and @var{disconnected} are 
optional."
       (define server (%make-server))
-      (define loop
-       (apply make-loop:nse
-              #:make-message-handlers make-message-handlers
-              #:control-message-handler control-message-handler
-              #:service-name "nse"
-              #:configuration config
-              #:connected connected
-              #:disconnected disconnected
-              #:spawn spawn
-              #:estimate/box (server-estimate/box server)
-              #:updated updated
-              (server->loop-arguments server)))
-      (spawn (lambda () (run-loop loop)))
-      server)))
+      (apply spawn-server-loop server #:make-loop make-loop:nse
+            #:make-message-handlers make-message-handlers
+            #:control-message-handler control-message-handler
+            #:service-name "nse"
+            #:configuration config
+            #:estimate/box (server-estimate/box server) r))))
diff --git a/gnu/gnunet/server.scm b/gnu/gnunet/server.scm
index 2dbace8..425735e 100644
--- a/gnu/gnunet/server.scm
+++ b/gnu/gnunet/server.scm
@@ -28,7 +28,7 @@
          <loop> make-loop server->loop-arguments
          loop:connected loop:disconnected loop:terminal-condition
          loop:control-channel loop:configuration loop:service-name
-         loop:spawner loop:lost-and-found run-loop)
+         loop:spawner loop:lost-and-found run-loop spawn-server-loop)
   (import (only (rnrs base)
                begin define cons case else apply values quote lambda
                if error list let and append)
@@ -263,4 +263,15 @@ TODO: maybe 'lost'"
       (define (control state . rest)
        "The main event loop."
        (apply control* (perform-operation loop-operation) state rest))
-      (apply control state rest))))
+      (apply control state rest))
+
+    (define* (spawn-server-loop server #:key (make-loop make-loop)
+                               (initial-extra-loop-arguments '())
+                               (spawn spawn-fiber) #:allow-other-keys
+                               #:rest arguments)
+      "[TODO] and return @var{server}"
+      (define loop-arguments (append arguments (server->loop-arguments 
server)))
+      (spawn (lambda ()
+              (apply run-loop (apply make-loop loop-arguments)
+                     initial-extra-loop-arguments)))
+      server)))

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