[gnunet-scheme] 10/49: dht/client: Register new get operations for processing.

[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 a86a0cf983d6f60f78eb8d6ea7418a2831176ea9
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Sep 18 17:59:46 2021 +0200

    dht/client: Register new get operations for processing.
    
    * gnu/gnunet/dht/client.scm
      
(<server>)[new-get-operations,new-get-operation,trigger,next-unique-id/box]:
      New fields.
      (<get>): New record type.
      (fresh-id): New procedure.
      (start-get!): New procedure.
      (reconnect): Add TODO.
---
 gnu/gnunet/dht/client.scm | 87 +++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 81 insertions(+), 6 deletions(-)

diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index e37abff..dbbaebb 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -32,11 +32,16 @@
          ;; Extended API: monitor
          start-monitor!
          stop-monitor!)
-  (import (gnu gnunet mq)
+  (import (gnu extractor enum)
+         (gnu gnunet block)
+         (gnu gnunet concurrency repeated-condition)
+         (gnu gnunet mq)
          (gnu gnunet mq handler)
          (gnu gnunet mq-impl stream)
+         (gnu gnunet mq envelope)
          (only (guile)
-               pk define-syntax-rule define*)
+               pk define-syntax-rule define* error
+               make-hash-table hashq-set!)
          (only (ice-9 atomic)
                make-atomic-box atomic-box-ref atomic-box-set!)
          (only (gnu extractor enum)
@@ -60,16 +65,82 @@
                slice-length slice/read-only)
          (only (rnrs base)
                and >= = quote * + - define begin ... let*
-               quote case else values apply)
+               quote case else values apply let cond if >
+               <= expt assert integer?)
          (only (rnrs control)
-               unless)
+               unless when)
          (only (rnrs records syntactic)
                define-record-type))
   (begin
     (define-record-type (<server> %make-server server?)
       (fields (immutable request-close?/box server-request-close?/box)
              (immutable request-close-condition
-                        server-request-close-condition)))
+                        server-request-close-condition)
+             ;; Hash table from new <get> to #true.  These get operations
+             ;; are not yet sent to the services, and not yet queued for
+             ;; sending.  Guile's hash tables are thread safe, so no locking
+             ;; is required.
+             (immutable new-get-operations server-new-get-operations)
+             ;; After adding new entries to 'new-get-operations', this
+             ;; ‘repeated condition’ is triggered to interrupt the fiber
+             ;; responsible for processing the new get operations.
+             (immutable new-get-operaton-trigger
+                        server-new-get-operation-trigger)
+             ;; Atomic box holding an unsigned 64-bit integer.
+             (immutable next-unique-id/box server-next-unique-id/box)))
+
+    (define-record-type (<get> %make-get get?)
+      (fields (immutable server get:server)
+             (immutable found get:iterator)
+             (immutable key get:key)
+             (immutable unique-id get:unique-id)
+             (immutable desired-replication-level
+                        get:desired-replication-level)
+             (immutable type get:type)
+             (immutable options get:options)))
+
+    (define (fresh-id server)
+      "Generate a fresh numeric ID to use for communication with @var{server}."
+      ;; Atomically increment the ‘next unique id’, but avoid
+      ;; overflow (the GNUnet network structures limit the ‘unique id’
+      ;; to being less than (expt 2 64)).
+      (%%bind-atomic-boxen
+       ((next-unique-id (server-next-unique-id/box server) swap!))
+       (let loop ((expected next-unique-id))
+        (define desired (+ 1 expected))
+        ;; TODO(low-priority): handle overflow without errors
+        (when (> desired (- (expt 2 64) 1))
+          (error "you overflowed an 64-bit counter."))
+        (define actual (swap! expected desired))
+        (if (= expected actual)
+            ;; Always returning ‘desired’ instead of ‘expected’ would work
+            ;; too.
+            expected
+            (loop actual)))))
+
+    (define* (start-get! server type key found
+                        #:key (desired-replication-level 3))
+      "Perform an asynchronous GET operation on the DHT, and return a handle
+to control the GET operation.  Search for a block of type @var{type} (a
+@code{block-type} or its numeric value) and key @var{key}, a readable 
bytevector
+slice.  Call @var{found} on every search result."
+      ;; TODO: options, xquery ...
+      (define canonical-type
+       (cond ((integer? type)
+              (unless (and (<= 0 type (- (expt 2 32) 1)))
+                (error "block type out of bounds")
+                type))
+             (#t
+              (assert (block-type? type))
+              (value->index type))))
+      (define handle (%make-get server found key (fresh-id server)
+                               desired-replication-level
+                               type
+                               0)) ; TODO
+      (hashq-set! (server-new-get-operations server) handle #t)
+      ;; Asynchronuously process the new get request.
+      (trigger-condition! (server-new-get-operation-trigger server))
+      handle)
 
     (define-syntax-rule (well-formed?/path-length slice type (field ...) 
compare)
       "Verify the TYPE message in @var{slice}, which has @var{field ...} ...
@@ -103,7 +174,10 @@ even if not connected.  This is an idempotent operation."
       (define request-close-condition (make-condition))
       (reconnect request-close?/box request-close-condition config
                 #:spawn spawn)
-      (%make-server request-close?/box request-close-condition))
+      (%make-server request-close?/box request-close-condition
+                   (make-hash-table) (make-repeated-condition)
+                   ;; Any ‘small’ exact natural number will do.
+                   (make-atomic-box 0)))
 
     (define* (reconnect request-close?/box request-close-condition config
                        #:key (spawn spawn-fiber)
@@ -173,4 +247,5 @@ even if not connected.  This is an idempotent operation."
       (define mq (connect/fibers config "dht" handlers error-handler
                                 #:spawn spawn))
       (spawn request-close-handler)
+      ;; TODO: use new-get-operations
       'todo)))

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