[gnunet-scheme] 01/02: dht/client: Extract question-response code.

[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 3110dd7b23872e87d5146ed9b5ab6862295f4cbb
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Thu Aug 18 12:34:14 2022 +0200

    dht/client: Extract question-response code.
    
    It will be useful for cadet/client.
    
    * gnu/gnunet/dht/client.scm (reconnect)[request-search-result-iterator]:
    Extract some code to ...
    * gnu/gnunet/server.scm (maybe-ask*): ... this new procedure, and ...
    * gnu/gnunet/dht/client.scm 
(reconnect)[control*]{request-search-result-iterator}:
    ... extract some code to ...
    * gnu/gnunet/server.scm (answer): ... this new procedure.
---
 gnu/gnunet/dht/client.scm | 22 +++++++++-------------
 gnu/gnunet/server.scm     | 22 ++++++++++++++++++++--
 2 files changed, 29 insertions(+), 15 deletions(-)

diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 1c6a479..55ba62a 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -80,7 +80,7 @@
          (gnu gnunet mq envelope)
          (only (gnu gnunet server)
                maybe-send-control-message! maybe-send-control-message!*
-               make-error-handler
+               make-error-handler maybe-ask* answer
                <server> server-terminal-condition server-control-channel
                make-disconnect! handle-control-message!)
          (only (guile)
@@ -103,7 +103,7 @@
          (only (fibers operations)
                perform-operation choice-operation wrap-operation)
          (only (fibers channels)
-               make-channel put-operation get-operation get-message 
put-message)
+               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)
@@ -797,14 +797,10 @@ unique id @var{unique-id}.  If there is no such get 
operation, or the get
 operation is cancelled, return @code{#false} instead."
        ;; It is possible to look at id->operation-map directly instead,
        ;; but hash tables are thread-unsafe.
-       ;; TODO: reduce allocations
-       (define response-channel (make-channel))
        ;; TODO: is the 'terminal-condition' case needed?
-       (and (maybe-send-control-message!* terminal-condition control-channel
-                                          'request-search-result-iterator
-                                          unique-id
-                                          response-channel)
-            (get-message response-channel)))
+       (maybe-ask* terminal-condition control-channel
+                   'request-search-result-iterator
+                   unique-id))
       (define handlers
        (message-handlers
         (message-handler
@@ -906,10 +902,10 @@ operation is cancelled, return @code{#false} instead."
           ;; Continue!
           (control))
          ;; Send by @code{request-search-result-iterator}.
-         (('request-search-result-iterator unique-id response-channel)
-          (put-message response-channel
-                       (and=> (hashv-ref id->operation-map unique-id)
-                              dereference))
+         (('request-search-result-iterator answer-box unique-id)
+          (answer answer-box
+                  (and=> (hashv-ref id->operation-map unique-id)
+                         dereference))
           ;; Continue!
           (control))
          (('resend-old-operations!)
diff --git a/gnu/gnunet/server.scm b/gnu/gnunet/server.scm
index 0c60dab..ca1b1e2 100644
--- a/gnu/gnunet/server.scm
+++ b/gnu/gnunet/server.scm
@@ -19,19 +19,20 @@
 ;; TODO: document
 (define-library (gnu gnunet server)
   (export maybe-send-control-message!* maybe-send-control-message!
+         maybe-ask* answer
          make-error-handler
          <server> server-terminal-condition server-control-channel
          make-disconnect!
          handle-control-message!)
   (import (only (rnrs base)
                begin define case else apply values quote lambda
-               if error list)
+               if error list let and)
          (only (rnrs records syntactic)
                define-record-type)
          (only (fibers conditions)
                make-condition wait-operation signal-condition!)
          (only (fibers channels)
-               make-channel put-operation)
+               make-channel put-operation put-message get-message)
          (only (fibers operations)
                choice-operation perform-operation wrap-operation)
          (only (gnu gnunet concurrency lost-and-found)
@@ -74,6 +75,23 @@ values are the same as for 
@code{maybe-send-control-message!*}."
       (apply maybe-send-control-message!* (server-terminal-condition server)
             (server-control-channel server) message))
 
+    (define (maybe-ask* terminal-condition control-channel question . rest)
+      "Maybe-send a list @code{(question answer-box . rest)} to the control 
channel of
+the server.  The control channel should put an answer in the answer box with
+@code{answer}, when done so, the response value is returned.  In case of a 
permanent
+disconnect, @code{#false} is returned.
+
+The type of @var{answer-box} is an implementation detail."
+      (let ((response-channel (make-channel)))
+       (and (apply maybe-send-control-message!* terminal-condition
+                   control-channel question response-channel rest)
+            (get-message response-channel))))
+
+    (define (answer answer-box answer)
+      "The counterpart of @code{maybe-ask*}."
+      (put-message answer-box answer)
+      (values)) ; for backtraces, if the type of @var{answer-box} is incorrect
+
     (define (make-error-handler connected disconnected terminal-condition 
control-channel)
       (define (error-handler key . arguments)
        (case key

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