[gnunet-scheme] branch master updated (bd67a16 -> 0d3930c)

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a change to branch master
in repository gnunet-scheme.

    from bd67a16  dht/client: Move field construction of <server> to the 
constructor.
     new dbe574b  dht/client: Remove unused ‘mq-defined’ variable.
     new 0d3930c  cadet/client: Unstub connection/disconnection code.

The 2 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "add" were already present in the repository and have only
been added to this reference.


Summary of changes:
 Makefile.am                 |   1 +
 gnu/gnunet/cadet/client.scm | 111 ++++++++++++++++++++++++++++++++++++++++++--
 gnu/gnunet/dht/client.scm   |   2 -
 tests/cadet.scm             |  28 +++++++++++
 4 files changed, 137 insertions(+), 5 deletions(-)
 create mode 100644 tests/cadet.scm

diff --git a/Makefile.am b/Makefile.am
index dc4b207..594698e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -193,6 +193,7 @@ SCM_TESTS = \
   tests/config-expand.scm \
   tests/config-db.scm \
   tests/config-fs.scm \
+  tests/cadet.scm \
   tests/crypto.scm \
   tests/distributed-hash-table.scm \
   tests/form.scm \
diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index a930f55..94ac640 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -20,12 +20,117 @@
          make-cadet-address cadet-address? cadet-address-peer 
cadet-address-port
          channel? open-channel! close-channel!
          port? open-port! close-port!)
-  (import (only (rnrs base) begin define assert))
+  (import (only (gnu gnunet concurrency lost-and-found)
+               make-lost-and-found collect-lost-and-found-operation)
+         (only (gnu gnunet mq handler) message-handlers)
+         (only (gnu gnunet mq) close-queue!)
+         (only (gnu gnunet mq-impl stream) connect/fibers)
+         (only (rnrs base)
+               begin define lambda assert quote cons apply values
+               case else)
+         (only (rnrs records syntactic) define-record-type)
+         (only (ice-9 match) match)
+         (only (guile) define*)
+         (only (fibers) spawn-fiber)
+         (only (fibers channels) get-operation put-operation make-channel)
+         (only (fibers conditions) make-condition wait-operation
+               signal-condition!)
+         (only (fibers operations)
+               wrap-operation choice-operation perform-operation))
   (begin
+    ;; TODO: deduplicate these three procedures with (gnu gnunet dht client)
+    (define (maybe-send-control-message!* terminal-condition control-channel
+                                         . message)
+      (perform-operation
+       (choice-operation
+       (wait-operation terminal-condition)
+       (put-operation control-channel message))))
+    (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))
+      (protocol (lambda (%make)
+                 (lambda ()
+                   (define lost-and-found (make-lost-and-found))
+                   ((%make lost-and-found) lost-and-found (make-condition)
+                    (make-channel))))))
+
+    (define* (connect config #:key (connected values) (disconnected values)
+                     (spawn spawn-fiber))
+      "Asynchronuously connect to the CADET service, using the configuration
+@var{config}, returning a CADET server object."
+      (define server (%make-server))
+      (spawn-procedure spawn config
+                      (server-terminal-condition server)
+                      (server-control-channel server)
+                      connected disconnected spawn
+                      (server-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
+                      lost-and-found)
+      (define loop-operation
+       (choice-operation
+        (get-operation control-channel)
+        (wrap-operation (collect-lost-and-found-operation lost-and-found)
+                        (lambda (lost) (cons 'lost lost)))))
+      (define handlers (message-handlers)) ; TODO
+      ;; TODO: abstract duplication in (gnu gnunet dht client)
+      (define (error-handler key . arguments)
+       (case key
+         ((connection:connected)
+          (connected)
+          (maybe-send-control-message!* terminal-condition control-channel
+                                        'resend-old-operations!)
+          (values))
+         ((input:regular-end-of-file input:premature-end-of-file)
+          (disconnected)
+          (maybe-send-control-message!* terminal-condition control-channel 
'reconnect!))
+         ((connection:interrupted)
+          (values))
+         (else
+          (apply maybe-send-control-message!* terminal-condition
+                 control-channel 'oops! key arguments)
+          (values))))
+      (define mq (connect/fibers config "cadet" handlers error-handler
+                                #:spawn spawn))
+      (define (control)
+       "The main event loop."
+       (control* (perform-operation loop-operation)))
+      (define (control* 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))
+         (('lost . lost)
+          (match lost
+            (() (control))
+            ((object . rest)
+             (match object
+               ((? server? lost) (control* '(disconnect!)))))))))
+      ;; Start the main event loop.
+      (control))
+
     (define (stub . foo)
       (error "todo"))
-    (define connect stub)
-    (define disconnect! stub)
     (define make-cadet-address stub)
     (define cadet-address? stub)
     (define cadet-address-peer stub)
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index cb8636f..5ed1583 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -888,7 +888,6 @@ operation is cancelled, return @code{#false} instead."
                 ;; TODO: wrong type (maybe a put handle?).
                 TODO-error-reporting/2)))))
       ;; TODO: abstract duplication in (gnu gnunet nse client)
-      (define mq-defined (make-condition))
       (define (error-handler key . arguments)
        (case key
          ((connection:connected)
@@ -917,7 +916,6 @@ operation is cancelled, return @code{#false} instead."
           (values))))
       (define mq (connect/fibers config "dht" handlers error-handler
                                 #:spawn spawn))
-      (signal-condition! mq-defined)
       (define (process-stop-search get)
        ;; TODO: tests!
        ;; TODO: cancel outstanding messages to the DHT services for this
diff --git a/tests/cadet.scm b/tests/cadet.scm
new file mode 100644
index 0000000..b509ccf
--- /dev/null
+++ b/tests/cadet.scm
@@ -0,0 +1,28 @@
+;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
+;; Copyright © 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
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; scheme-GNUnet is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Affero General Public License for more details.
+;;
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; SPDX-License-Identifier: AGPL-3.0-or-later
+(define-module (test-distributed-hash-table))
+(import (gnu gnunet cadet client)
+       (srfi srfi-64)
+       (tests utils))
+
+(test-begin "CADET")
+(test-assert "(CADET) close, not connected --> all fibers stop, no callbacks 
called"
+  (close-not-connected-no-fallbacks "cadet" connect disconnect!))
+(test-assert "(CADET) garbage collectable"
+  (garbage-collectable "cadet" connect))
+(test-end "CADET")

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