[gnunet-scheme] 16/16: dht/client: Move some code into (gnu gnunet 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 dbb443027414c8c1984a3b92c9b3a2727819683e
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Jul 26 16:14:14 2022 +0200

    dht/client: Move some code into (gnu gnunet server).
    
    * gnu/gnunet/server.scm (<server>): New record type, with
    terminal-condition and control-channel.
    * gnu/gnunet/dht/client.scm (<server>): Use it, and rename to ...
    (<server:dht>): ... this.
---
 gnu/gnunet/dht/client.scm | 20 ++++++++++----------
 gnu/gnunet/server.scm     | 31 ++++++++++++++++++++++++-------
 2 files changed, 34 insertions(+), 17 deletions(-)

diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 8cb7ee2..3db5863 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -59,6 +59,8 @@
                  (analyse-client-put #{ analyse-client-put}#)
                  (analyse-client-result #{ analyse-client-result}#))
 
+         (rename (server:dht? server?))
+
          connect
          disconnect!
          put!
@@ -77,7 +79,8 @@
          (gnu gnunet mq-impl stream)
          (gnu gnunet mq envelope)
          (only (gnu gnunet server)
-               maybe-send-control-message!* make-error-handler)
+               maybe-send-control-message!* make-error-handler
+               <server> server-terminal-condition server-control-channel)
          (only (guile)
                pk define-syntax-rule define* lambda* error
                make-hash-table hashq-set! hashq-remove! hashv-set! hashv-ref
@@ -580,16 +583,13 @@ currently unsupported."
     ;; via the control channel, using 'maybe-send-control-message!'.
     ;; Operations must be put in id->operation-map before sending them
     ;; to the service!
-    (define-record-type (<server> make-server server?)
-      (parent <losable>)
-      ;; terminal-condition: a disconnect has been requested
-      (fields (immutable terminal-condition server-terminal-condition)
-             (immutable control-channel server-control-channel)
-             ;; Atomic box holding an unsigned 64-bit integer.
-             (immutable next-unique-id/box server-next-unique-id/box))
+    (define-record-type (<server:dht> make-server server:dht?)
+      (parent <server>)
+      ;; Atomic box holding an unsigned 64-bit integer.
+      (fields (immutable next-unique-id/box server-next-unique-id/box))
       (protocol (lambda (%make)
                  (lambda ()
-                   ((%make (make-lost-and-found)) (make-condition) 
(make-channel)
+                   ((%make)
                     ;; Any ‘small’ natural number will do.
                     (make-atomic-box 0))))))
 
@@ -978,7 +978,7 @@ operation is cancelled, return @code{#false} instead."
                  ((? get? get)
                   (process-stop-search get)
                   (loop rest))
-                 ((? server? server)
+                 ((? server:dht? server)
                   (control* '(disconnect!))))))))))
       ;; Start the main event loop.
       (control))))
diff --git a/gnu/gnunet/server.scm b/gnu/gnunet/server.scm
index 0bd9147..c9d6698 100644
--- a/gnu/gnunet/server.scm
+++ b/gnu/gnunet/server.scm
@@ -1,5 +1,5 @@
 ;; This file is part of Scheme-GNUnet
-;; Copyright © 2022 GNUnet e.V.
+;; Copyright © 2021, 2022 GNUnet e.V.
 ;;
 ;; Scheme-GNUnet is free software: you can redistribute it and/or modify it
 ;; under the terms of the GNU Affero General Public License as published
@@ -18,15 +18,21 @@
 
 ;; TODO: document
 (define-library (gnu gnunet server)
-  (export maybe-send-control-message!* make-error-handler)
+  (export maybe-send-control-message!* make-error-handler
+         <server> server-terminal-condition server-control-channel)
   (import (only (rnrs base)
-               begin define case else apply values quote)
+               begin define case else apply values quote lambda)
+         (only (rnrs records syntactic)
+               define-record-type)
          (only (fibers conditions)
-               wait-operation)
+               make-condition wait-operation)
          (only (fibers channels)
-               put-operation)
+               make-channel put-operation)
          (only (fibers operations)
-               choice-operation perform-operation))
+               choice-operation perform-operation)
+         (only (gnu gnunet concurrency lost-and-found)
+               make-lost-and-found collect-lost-and-found-operation
+               losable-lost-and-found))
   (begin
     (define (maybe-send-control-message!* terminal-condition control-channel
                                          . message)
@@ -68,4 +74,15 @@ This sends a @var{message} to @var{control-channel} or waits 
for
           (apply maybe-send-control-message!* terminal-condition
                  control-channel 'oops! key arguments)
           (values))))
-      error-handler)))
+      error-handler)
+
+    (define-record-type (<server> %make-server server?)
+      (parent <losable>)
+      ;; terminal-condition: a disconnect has been requested.
+      (fields (immutable terminal-condition server-terminal-condition)
+             (immutable control-channel server-control-channel))
+      (protocol (lambda (%make)
+                 (lambda ()
+                   ((%make (make-lost-and-found))
+                    (make-condition)
+                    (make-channel))))))))

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