[gnunet-scheme] branch master updated: cadet/client: Use 'server' module.

[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.

The following commit(s) were added to refs/heads/master by this push:
     new c3980f3  cadet/client:  Use 'server' module.
c3980f3 is described below

commit c3980f3a22031a27dbed50a40ea3259c531dbd3b
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Wed Jul 27 22:37:19 2022 +0200

    cadet/client:  Use 'server' module.
    
    It removes some duplication, which is good for e.g. test coverage.
    
    * gnu/gnunet/cadet/client.scm (<server>, server?): Rename to
    <server:cadet> and server:cadet?, and inherit from <server>.
    (maybe-send-control-message!): Delete.
    (disconnect!): Use 'make-disconnect!'.
    (<channel>): Adjust constructor to new supertype.
    (connect): Adjust to new types.
    (reconnect)[control*]: Handle 'disconnect!', 'close-queue!' and
    'reconnect!' cases with 'handle-control-message!'.
    (open-channel!): Adjust to new predicate name.
---
 gnu/gnunet/cadet/client.scm | 59 ++++++++++++++++++---------------------------
 1 file changed, 24 insertions(+), 35 deletions(-)

diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index f5c9df0..5ae4ef8 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -22,6 +22,8 @@
          port? open-port! close-port!
          %max-cadet-message-size
 
+         (rename (server:cadet? server?))
+
          ;; Network manipulation procedures
          ;; (these belong to (gnu gnunet cadet network)).
          (rename (analyse-local-channel-create
@@ -48,11 +50,16 @@
          (only (gnu gnunet crypto struct)
                /peer-identity)
          (only (gnu gnunet concurrency lost-and-found)
-               make-lost-and-found collect-lost-and-found-operation)
+               make-lost-and-found collect-lost-and-found-operation
+               losable-lost-and-found)
          (only (gnu gnunet mq handler) message-handlers)
          (only (gnu gnunet mq) close-queue! send-message!)
          (only (gnu gnunet server)
-               maybe-send-control-message!* make-error-handler)
+               maybe-send-control-message! make-error-handler
+               make-disconnect!
+               server-terminal-condition
+               server-control-channel
+               handle-control-message!)
          (only (gnu gnunet hashcode struct)
                /hashcode:512)
          (only (gnu gnunet message protocols) message-type)
@@ -79,23 +86,14 @@
          (only (fibers operations)
                wrap-operation choice-operation perform-operation))
   (begin
-    ;; TODO: deduplicate these two procedures with (gnu gnunet dht client)
-    (define (maybe-send-control-message! server . message)
-      (apply maybe-send-control-message!* (server-terminal-condition server)
-            (server-control-channel server) message))
-    (define (disconnect! server)
-      (maybe-send-control-message! server 'disconnect!))
-
-    (define-record-type (<server> %make-server server?)
-      (parent <losable>)
-      (fields (immutable lost-and-found server-lost-and-found)
-             (immutable terminal-condition server-terminal-condition)
-             (immutable control-channel server-control-channel))
+    (define-record-type (<server:cadet> %make-server server:cadet?)
+      (parent <server>)
       (protocol (lambda (%make)
                  (lambda ()
-                   (define lost-and-found (make-lost-and-found))
-                   ((%make lost-and-found) lost-and-found (make-condition)
-                    (make-channel))))))
+                   ((%make))))))
+
+    (define disconnect!
+      (make-disconnect! 'cadet server:cadet?))
 
     (define-record-type (<channel> %make-channel channel?)
       (parent <losable>)
@@ -110,7 +108,7 @@
                       set-channel-channel-number!))
       (protocol (lambda (%make)
                  (lambda (server destination options)
-                   ((%make (server-lost-and-found server)) server
+                   ((%make (losable-lost-and-found server)) server
                     destination options #false)))))
 
     (define* (connect config #:key (connected values) (disconnected values)
@@ -122,14 +120,12 @@
                       (server-terminal-condition server)
                       (server-control-channel server)
                       connected disconnected spawn
-                      (server-lost-and-found server))
+                      (losable-lost-and-found server))
       server)
 
     ;; TODO: reduce duplication with (gnu gnunet dht client)
     (define (spawn-procedure spawn . rest)
       (spawn (lambda () (apply reconnect rest))))
-    (define (disconnect! server)
-      (maybe-send-control-message! server 'disconnect!))
 
     (define (reconnect config terminal-condition control-channel
                       connected disconnected spawn
@@ -145,6 +141,9 @@
                            control-channel))
       (define mq (connect/fibers config "cadet" handlers error-handler
                                 #:spawn spawn))
+      (define (k/reconnect!)
+       (reconnect config terminal-condition control-channel connected
+                  disconnected spawn lost-and-found))
       (define (control next-free-channel-number)
        "The main event loop."
        (control* next-free-channel-number
@@ -155,17 +154,6 @@
        (define (continue* message)
          (control* next-free-channel-number message))
        (match message
-         (('disconnect!)
-          ;; Ignore future requests instead of blocking.
-          (signal-condition! terminal-condition)
-          ;; Close networking ports.
-          (close-queue! mq)
-          ;; And the fibers of the <server> object are now done!
-          (values))
-         (('reconnect!)
-          ;; Restart the loop with a new message queue.
-          ;; TODO: deduplicate with (gnu gnunet dht client)
-          (reconnect config terminal-condition control-channel connected 
disconnected spawn lost-and-found))
          (('open-channel! channel)
           (let* ((channel-number next-free-channel-number)
                  ;; TODO: handle overflow, and respect bounds
@@ -187,8 +175,9 @@
                  ((? channel? lost)
                   TODO
                   (loop rest))
-                 ((? server? lost)
-                  (continue* '(disconnect!))))))))))
+                 ((? server:cadet? lost)
+                  (continue* '(disconnect!))))))))
+         (rest (handle-control-message! rest mq terminal-condition 
k/reconnect!))))
       ;; Start the main event loop.
       (control 0))
 
@@ -329,7 +318,7 @@ message @var{message}."
 
     ;; TODO: callbacks, message queue, actually test it
     (define* (open-channel! server address)
-      (assert (and (server? server) (cadet-address? address)))
+      (assert (and (server:cadet? server) (cadet-address? address)))
       (define channel (%make-channel server address 0))
       (maybe-send-control-message! server 'open-channel! channel)
       channel)

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