[gnunet-scheme] 02/02: dht/client: Implement <query> as a cisw type.

[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 8381e8c1b730e3031bc1f2fd553581d0243d4d9a
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Mar 21 00:32:42 2023 +0100

    dht/client: Implement <query> as a cisw type.
    
    * doc/distributed-hash-table.tm: Document queries as ciws objects.
    * gnu/gnunet/dht/client.scm: Simplify the implementation accordingly.
    * tests/distributed-hash-table.scm: Adjust for new API.
    * examples/web.scm: Likewise.
---
 doc/distributed-hash-table.tm    | 13 ++++----
 examples/web.scm                 |  8 ++---
 gnu/gnunet/dht/client.scm        | 66 ++++++++++++++++++++++------------------
 tests/distributed-hash-table.scm | 20 ++++--------
 4 files changed, 53 insertions(+), 54 deletions(-)

diff --git a/doc/distributed-hash-table.tm b/doc/distributed-hash-table.tm
index 3ee3f71..fcd03ce 100644
--- a/doc/distributed-hash-table.tm
+++ b/doc/distributed-hash-table.tm
@@ -84,12 +84,13 @@
     <todo|various options, xquery> The block type <var|type> is normalised to
     its numerical value; <scm|query-type> returns integers.
 
-    The numeric value of the block type, the key and the desired replication
-    level can be recovered with the accessors
-    <scm|query-type><index|query-type>, <scm|query-key><index|query-key> and
-    
<scm|query-desired-replication-level><index|query-desired-replication-level>.
-    It can be tested if an object is a query object with the predicate
-    <scm|query?><index|query?>.
+    Queries are <acronym|cisw> (<reference|cisw>) objects and as such the
+    procedures <scm|query-type><index|query-type>,
+    <scm|query-key><index|query-key>, 
<scm|query-desired-replication-level><index|query-desired-replication-level>,
+    <scm|query?><index|query?>, <scm|make-query><index|make-query>,
+    <scm|make-query/share><index|make-insertion/share>,
+    <scm|query?><index|query?> and <scm|copy-query><index|copy-query> have
+    the usual semantics.
   </explain>
 
   <\explain>
diff --git a/examples/web.scm b/examples/web.scm
index 4c2d2ff..1f9068c 100644
--- a/examples/web.scm
+++ b/examples/web.scm
@@ -220,10 +220,10 @@ If incorrect, return @code{#false}. TODO more validation."
         (desired-replication-level
          (and=> (assoc-ref parameters "replication-level") string->number)))
     (and type key-encoding key replication-level desired-replication-level
-        (dht:make-query type
-                        (decode/key key-encoding key)
-                        #:desired-replication-level
-                        desired-replication-level))))
+        (dht:make-query/share type
+                              (decode/key key-encoding key)
+                              #:desired-replication-level
+                              desired-replication-level))))
 
 (define (parameters->cadet-address parameters)
   (pk 'p parameters)
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 789dc97..e4943c9 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -45,7 +45,10 @@
          make-insertion make-insertion/share insertion? insertion->datum
          insertion=?
          insertion-desired-replication-level
-         make-query query? query-type query-key query-desired-replication-level
+
+         make-query make-query/share query? query-type
+         query-key query-desired-replication-level query=? copy-query
+
          datum->search-result search-result? search-result->datum
          search-result-get-path search-result-put-path
 
@@ -293,32 +296,35 @@ and @code{insertion=?} have the usual semantics.")
               #:getter insertion-desired-replication-level
               #:preprocess bound-replication-level))
 
-    (define-record-type (<query> make-query query?)
-      (fields (immutable type query-type)
-             (immutable key query-key)
-             (immutable desired-replication-level 
query-desired-replication-level))
-      (protocol
-       (lambda (%make)
-        (lambda* (type key #:key (desired-replication-level 3))
-          "Make a query object for searching for a value of block type 
@var{type}
-(or its corresponding numeric value), with key @var{key} (a hashcode:512}, at
-desired replication level @var{desired-replication-level}.
-
-The numeric value of the block type, the key and the desired replication level
-can be recovered with the accessors @code{query-type}, @code{query-key} and
-@code{query-desired-replication-level}. It can be tested if an object is a
-query object with the predicate @code{query?}."
-          (%make (canonical-block-type type)
-                 (validate-key key)
-                 (bound-replication-level desired-replication-level))))))
-
-    (define (copy-query old)
-      "Make a copy of the query object @var{old}, such that modifications to 
the
-slices in @var{old} do not impact the new query object."
-      (make-query (query-type old)
-                 (copy-hashcode:512 (query-key old))
-                 #:desired-replication-level
-                 (query-desired-replication-level old)))
+    (define-record-type* (<query> query?)
+      #:constructor/copy make-query
+      #:constructor (make-query/share
+                    "Make a query object for searching for a value of block
+type @var{type} (or its corresponding numeric value), with key @var{key} (a
+hashcode:512), at desired replication level @var{desired-replication-level}
+(see ?). [TODO: various options, xquery] The block type type is normalised
+to its numerical value; @code{query-type} returns integers.
+
+Queries are cisw (?) objects and as such the procedures @code{query-type}, 
@code{query-key}, @code{query-desired-replication-level}, @code{query?}, 
@code{make-query}, @code{make-query/share}, @code{query?} and @code{copy-query} 
have the usual semantics.")
+      #:constructor-keyword-arguments
+      (type key #:key (desired-replication-level 3))
+      #:copy (copy-query
+             "Make a copy of the query object @var{old}, such that
+modifications to the slices in @var{old} do not impact the new query object.")
+      #:equality query=?
+      #:field (type #:copy identity
+                   #:equality =
+                   #:preprocess canonical-block-type
+                   #:getter query-type)
+      #:field (key #:copy copy-hashcode:512
+                  #:equality hashcode:512=?
+                  #:getter query-key
+                  #:preprocess validate-key)
+      #:field (desired-replication-level
+              #:copy identity
+              #:equality =
+              #:getter query-desired-replication-level
+              #:preprocess bound-replication-level))
 
     (define-record-type (<search-result> datum->search-result search-result?)
       (fields (immutable datum search-result->datum)
@@ -493,9 +499,9 @@ result object @var{search-result}, with @var{unique-id} as 
‘unique id’"
       "Return the query object, the unique id and the options corresponding to
 the @code{/:msg:dht:client:result} message @var{message}.  Xqueries are
 currently unsupported."
-      (values (make-query (r% type) (make-hashcode:512/share (s% key))
-                         #:desired-replication-level
-                         (r% desired-replication-level))
+      (values (make-query/share (r% type) (make-hashcode:512/share (s% key))
+                               #:desired-replication-level
+                               (r% desired-replication-level))
              (r% unique-id)
              (r% options)))
 
diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index 10e57ab..499617b 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -243,11 +243,6 @@
   (slice-copy! s s2)
   b)
 
-(define (query->sexp z)
-  (list (query-type z)
-       (slice->bytevector (hashcode:512->slice (query-key z)))
-       (query-desired-replication-level z)))
-
 (define (datum->sexp z)
    (list (datum-type z)
         (slice->bytevector (hashcode:512->slice (datum-key z)))
@@ -259,9 +254,6 @@
        (slice->bytevector (search-result-put-path z))
        (datum->sexp (search-result->datum z))))
 
-(define (query=? x y)
-  (equal? (query->sexp x) (query->sexp y)))
-
 (define (search-result=? x y)
   (equal? (search-result->sexp x) (search-result->sexp y)))
 
@@ -289,7 +281,7 @@
   (let* ((old-key (make-slice/read-write* (sizeof /hashcode:512 '())))
         (type (random 65536))
         (desired-replication-level (+ 1 %maximum-replication-level))
-        (old (make-query type (make-hashcode:512/share old-key)))
+        (old (make-query/share type (make-hashcode:512/share old-key)))
         (new (copy-query old)))
     (and (query=? old new)
         (query-independent? old new))))
@@ -613,7 +605,7 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
        (make-insertion/share (make-datum/share type key value)))
      (define (make-a-query type round)
        (define key (round->key round))
-       (make-query type key))
+       (make-query/share type key))
      (define (n-responses-for-round round)
        (+ 1 (mod round 8)))
      (define (ping/pong type round)
@@ -732,7 +724,7 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
      (define (make-a-query round)
        (define key (make-slice/read-write (sizeof /hashcode:512 '())))
        (slice-u64-set! key 0 round (endianness big))
-       (make-query type (make-hashcode:512/share key)))
+       (make-query/share type (make-hashcode:512/share key)))
      (define (value round)
        (expt 2 round))
      (define done (make-condition))
@@ -774,7 +766,7 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
    (lambda (config spawn-fiber)
      (define server (connect config))
      (define datum (make-a-datum))
-     (define query (make-query (datum-type datum) (datum-key datum)))
+     (define query (make-query/share (datum-type datum) (datum-key datum)))
      (define search-defined (make-condition))
      (define done (make-condition))
      (define search
@@ -795,7 +787,7 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
    (lambda (config spawn-fiber)
      (define server (connect config))
      (define datum (make-a-datum))
-     (define query (make-query (datum-type datum) (datum-key datum)))
+     (define query (make-query/share (datum-type datum) (datum-key datum)))
      (define search (start-get! server query (lambda (foo) (values))
                                ;; Not testing cancellation on GC here.
                                #:linger? #true))
@@ -832,7 +824,7 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
           (error "wrong search result"))
         (unless (signal-condition! found/condition)
           (error "multiple results")))
-       (define query (make-query (datum-type datum) (datum-key datum)))
+       (define query (make-query/share (datum-type datum) (datum-key datum)))
        (define search (start-get! server query found))
        ;; Give @var{server} a chance to actually send the request.
        ;; Removing the 'let loop' is possible, but would test some

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