[gnunet-scheme] branch master updated: dht/client: Use the <search-result> data structure.

[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.

The following commit(s) were added to refs/heads/master by this push:
     new 53a3f91  dht/client: Use the <search-result> data structure.
53a3f91 is described below

commit 53a3f91a4da6bdff20a727b7b7f1ddeaf84826e9
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sun Dec 26 20:45:21 2021 +0000

    dht/client: Use the <search-result> data structure.
    
    * gnu/gnunet/dht/client.scm
      (validate-datum): Validate data, not /hashcode:512.
      (<datum>): Add 'type' field.
      (slice-copy,copy-datum,copy-search-result): New procedures.
      (<get>)[found]: Document its type.
      (reconnect)[process-client-result]: Use <search-result> objects.
    * examples/web.scm (process-search-dht): Adjust to new DHT API.
---
 examples/web.scm          | 45 +++++++++++++++++++------------------
 gnu/gnunet/dht/client.scm | 57 +++++++++++++++++++++++++++++++++++------------
 2 files changed, 66 insertions(+), 36 deletions(-)

diff --git a/examples/web.scm b/examples/web.scm
index 71cf05f..13a0916 100644
--- a/examples/web.scm
+++ b/examples/web.scm
@@ -156,15 +156,11 @@ If incorrect, return @code{#false}. TODO more validation."
                         desired-replication-level))))
 
 (define (process-search-dht dht-server parameters)
-  (define what)
+  (define search-result)
   (define found? (make-condition))
-  (define (found type key data expiration get-path put-path)
-    (set! what (list type
-                    (slice-copy key)
-                    (slice-copy data)
-                    expiration
-                    (slice-copy get-path)
-                    (slice-copy put-path)))
+  (define (found %search-result)
+    ;; TODO: document necessity of copies and this procedure
+    (set! search-result (dht:copy-search-result %search-result))
     (signal-condition! found?))
   (define query (parameters->query parameters))
   (if query
@@ -175,20 +171,25 @@ If incorrect, return @code{#false}. TODO more validation."
        ;; after something has been found or if the client closes the 
connection ...
        (respond/html `(div (p "Found! ")
                            ;; TODO: better output, determine why the data is 
bogus
-                           (dl ,@(match what
-                                   ((type key data expiration get-path 
put-path)
-                                    `((dt "Type: ")
-                                      (dd ,type)
-                                      (dt "Key: ")
-                                      (dd ,(data->string key))
-                                      (dt "Data: ")
-                                      (dd ,(data->string data))
-                                      (dt "Expiration: ")
-                                      (dd ,(object->string expiration))
-                                      (dt "Get path: ") ; TODO as list
-                                      (dd ,(object->string get-path))
-                                      (dt "Put path: ")
-                                      (dd ,(object->string put-path)))))))))
+                           (dl (dt "Type: ")
+                               (dd ,(dht:datum-type
+                                     (dht:search-result->datum search-result)))
+                               (dt "Key: ")
+                               (dd ,(data->string
+                                     (dht:datum-key
+                                      (dht:search-result->datum 
search-result))))
+                               (dt "Value: ")
+                               (dd ,(data->string
+                                     (dht:datum-value
+                                      (dht:search-result->datum 
search-result))))
+                               (dt "Expiration: ")
+                               (dd ,(object->string
+                                     (dht:datum-expiration
+                                      (dht:search-result->datum 
search-result))))
+                               (dt "Get path: ") ; TODO as list
+                               (dd ,(dht:search-result-get-path search-result))
+                               (dt "Put path: ")
+                               (dd ,(dht:search-result-put-path 
search-result))))))
       (respond/html `(p "Some fields were missing / invalid")
                    #:status-code 400)))
 
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 7ceb8fa..bd2b226 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -28,13 +28,15 @@
          bound-replication-level
 
          ;; Non-interactive data structures
-         make-datum datum? datum-key datum-value datum-expiration
+         make-datum datum? datum-type datum-key datum-value datum-expiration
          datum->insertion insertion? insertion->datum
          insertion-desired-replication-level
          make-query query? query-type query-key query-desired-replication-level
          datum->search-result search-result? search-result->datum
          search-result-get-path search-result-put-path
 
+         copy-datum copy-search-result
+
          connect
          disconnect!
          put!
@@ -123,23 +125,23 @@ readable bytevector slice. If not, raise an appropriate 
exception. "
          (slice/read-only key)
          (error "length of key incorrect")))
 
-    (define (validate-datum key)
-      "If @var{key} is, in-fact, a datum, return it. Otherwise, raise an 
appropriate exception."
-      (if (= (slice-length key) (sizeof /hashcode:512 '()))
-         (slice/read-only key)
-         (error "length of key incorrect")))
+    (define (validate-datum datum)
+      "If @var{datum} is, in-fact, a datum, return it. Otherwise, raise an
+appropriate exception."
+      (if (datum? datum) datum (error "not a datum")))
 
     ;; TODO: use the data structures below and test them
 
     ;; An key-value entry in the DHT.
     (define-record-type (<datum> make-datum datum?)
-      (fields (immutable key datum-key)
+      (fields (immutable type datum-type)
+             (immutable key datum-key)
              (immutable value datum-value)
              (immutable expiration datum-expiration))
       (protocol
        (lambda (%make)
         (lambda* (type key value #:key (expiration 0)) ; TODO default 
expiration
-          "Make ad datum object of block type @var{type} (or its corresponding
+          "Make a datum object of block type @var{type} (or its corresponding
 numeric value), with key @var{key} (a readable @code{/hashcode:512} bytevector
 slice), value @var{value} (a readable bytevector slice) and expiring at 
@var{expiration}.
 The keyword argument @var{expiration} is optional, see ???.
@@ -153,6 +155,20 @@ It can be tested if an object is a datum object with the 
predicate @code{datum?}
                  (slice/read-only value) ; TODO: max size
                  expiration))))) ; TODO validate expiration
 
+    ;; XXX deduplicate
+    (define (slice-copy slice)
+      (define new (make-slice/read-write (slice-length slice)))
+      (slice-copy! slice new)
+      new)
+
+    (define (copy-datum old)
+      "Make a copy of the datum @var{old}, such that modifications to the
+slices in @var{old} do not impact the new datum."
+      (make-datum (datum-type old)
+                 (slice-copy (datum-key old))
+                 (slice-copy (datum-value old))
+                 #:expiration (datum-expiration old)))
+
     ;; A request to insert something in the DHT.
     (define-record-type (<insertion> datum->insertion insertion?)
       (fields (immutable datum insertion->datum)
@@ -205,6 +221,16 @@ optional keyword arguments @code{get-path} and 
@code{put-path} are currently
 undocumented and untested."
           ;; TODO: get-path and put-path
           (%make (validate-datum datum) get-path put-path)))))
+
+    (define (copy-search-result old)
+      "Make a copy of the search result @var{old}, such that modifications to 
the
+slices in @var{old} do not impact the new search result."
+      (define get-path (search-result-get-path old))
+      (define put-path (search-result-put-path old))
+      (datum->search-result (search-result->datum old)
+                           #:get-path (and get-path (slice-copy get-path))
+                           #:put-path (and put-path (slice-copy put-path))))
+
     
 
     ;; New get or put operations are initially in new-get-operations or
@@ -243,7 +269,7 @@ undocumented and untested."
 
     (define-record-type (<get> %make-get get?)
       (fields (immutable server get:server)
-             (immutable found get:iterator)
+             (immutable found get:iterator) ; procedure accepting 
<search-result>
              (immutable query get:query) ; <query>
              (immutable unique-id get:unique-id)
              (immutable options get:options)))
@@ -423,11 +449,14 @@ structure) to the get request @var{handle}."
                               (+ put-path-length get-path-length))))
        ;; TODO: maybe validate 'key' and 'type'
        ((get:iterator handle)
-        (read% /:msg:dht:client:result '(type) header)
-        (select /:msg:dht:client:result '(key) header)
-        data
-        (read% /:msg:dht:client:result '(expiration) header)
-        get-path put-path))
+        (datum->search-result
+         (make-datum
+          (read% /:msg:dht:client:result '(type) header)
+          (select /:msg:dht:client:result '(key) header)
+          data
+          #:expiration
+          (read% /:msg:dht:client:result '(expiration) header))
+         #:get-path get-path #:put-path put-path)))
       (define handlers
        (message-handlers
         (message-handler

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