[gnunet-scheme] 02/04: dht/client: Extract disconnection to 'server'.

[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 98e5740845bd9e0923a14cfe4828a450149c1749
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Wed Jul 27 15:20:18 2022 +0200

    dht/client: Extract disconnection to 'server'.
    
    It's useful elsewhere as well.
    
    * gnu/gnunet/server.scm (make-disconnect!, primitive-disconnect!): New
    procedures.
    * gnu/gnunet/dht/client.scm (disconnect!): Use it.
---
 gnu/gnunet/dht/client.scm | 13 +++++--------
 gnu/gnunet/server.scm     | 29 ++++++++++++++++++++++++++---
 2 files changed, 31 insertions(+), 11 deletions(-)

diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 7e6439d..0686ac3 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -80,7 +80,8 @@
          (gnu gnunet mq envelope)
          (only (gnu gnunet server)
                maybe-send-control-message! make-error-handler
-               <server> server-terminal-condition server-control-channel)
+               <server> server-terminal-condition server-control-channel
+               make-disconnect!)
          (only (guile)
                pk define-syntax-rule define* lambda* error
                make-hash-table hashq-set! hashq-remove! hashv-set! hashv-ref
@@ -732,13 +733,9 @@ message header is assumed to be correct."
                  ...)
             (compare extra-size (* (+ field ...) (sizeof /dht:path-element 
'()))))))
 
-    ;; TODO reduce duplication with (gnu gnunet nse client) --- maybe introduce
-    ;; (gnu gnunet client) as in the C implementation?
-    (define (disconnect! server)
-      "Asynchronuously disconnect from the DHT service and stop reconnecting,
-even if not connected.  This is an idempotent operation.  This is an
-asynchronuous request; it won't be fulfilled immediately."
-      (maybe-send-control-message! server 'disconnect!))
+    (define disconnect!
+      (make-disconnect! 'distributed-hash-table ; for error messages
+                       server:dht?))
 
     (define* (connect config #:key (connected values) (disconnected values)
                      (spawn spawn-fiber))
diff --git a/gnu/gnunet/server.scm b/gnu/gnunet/server.scm
index 23d0da7..2d0f909 100644
--- a/gnu/gnunet/server.scm
+++ b/gnu/gnunet/server.scm
@@ -20,9 +20,11 @@
 (define-library (gnu gnunet server)
   (export maybe-send-control-message!* maybe-send-control-message!
          make-error-handler
-         <server> server-terminal-condition server-control-channel)
+         <server> server-terminal-condition server-control-channel
+         make-disconnect!)
   (import (only (rnrs base)
-               begin define case else apply values quote lambda)
+               begin define case else apply values quote lambda
+               if error list)
          (only (rnrs records syntactic)
                define-record-type)
          (only (fibers conditions)
@@ -92,4 +94,25 @@ do anything if @var{server} has been permanently 
disconnected."
                  (lambda ()
                    ((%make (make-lost-and-found))
                     (make-condition)
-                    (make-channel))))))))
+                    (make-channel))))))
+
+    (define (primitive-disconnect! server)
+      "Asynchronuously disconnect from the service and stop reconnecting,
+even if not connected.  This is an idempotent operation.  This is an
+asynchronuous request; it won't be fulfilled immediately.
+
+This maybe-sends @code{disconnect!} to the control channel."
+      (maybe-send-control-message! server 'disconnect!))
+
+    (define (make-disconnect! name type?)
+      ;; for backtrace purposes, 'lambda' is not used here.
+      (define (disconnect! server)
+       "Asynchronuously disconnect from the service and stop reconnecting,
+even if not connected.  This is an idempotent operation.  This is an
+asynchronuous request; it won't be fulfilled immediately."
+       (if (type? server)
+           (primitive-disconnect! server)
+           (error 'disconnect! ; TODO: test
+                  "wrong server object type"
+                  (list name type? server))))
+      disconnect!)))

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