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.

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