Implement <search-result> as a cisw type.

* doc/distributed-hash-table.scm: Document search results as cisw
objects.
* gnu/gnunet/dht/client.scm: Simplify the implementation accordingly.
* tests/distributed-hash-table.scm: Likewise, and adjust for new API.

3 files changed, 143 insertions, 125 deletions

diff --git a/doc/distributed-hash-table.tm b/doc/distributed-hash-table.tm
index fcd03ce..cc6d6aa 100644
--- a/doc/distributed-hash-table.tm
+++ b/doc/distributed-hash-table.tm
@@ -94,30 +94,38 @@
   </explain>
 
   <\explain>
-    <scm|(datum-\<gtr\>search-result <var|datum> #:get-path
-    #:put-path)><index|datum-\<gtr\>search-result>
+    <scm|(make-search-result <var|datum> #:get-path
+    #:put-path)><index|make-search-result>
   <|explain>
-    Make a search result object for the datum <var|datum>. The datum can be
-    recovered with the accessor <scm|search-result-\<gtr\>datum><index|search-result-\<gtr\>datum>.
-    It can be tested if an object is a search result with the predicate
-    <scm|search-result?><index|search-result?>. The optional arguments
-    <var|get-path> and <var|put-path>, when not false, are bytevector slices
-    consisting of a list of <scm|/dht:path-element><index|/dht:path-element><index|path
-    element>.
-
-    The <var|get-path><index|get path> , if any, is the path from the storage
+    Make a search result object for the datum <var|datum> with (optionally) a
+    get path <var|get-path> and put path <var|put-path>. Search results are
+    <acronym|cisw> (<reference|cisw>) objects and as such the procedures
+    <scm|search-result-\<gtr\>datum><index|search-result-\<gtr\>datum>,
+    <scm|search-result-get-path><index|search-result-get-path>,
+    <scm|search-result-put-path><index|search-result-put-path>,
+    <scm|make-search-result><index|make-search-result> ,
+    <scm|make-search-result/share><index|make-search-result/share>,
+    <scm|search-result?><index|search-result?>,
+    <scm|copy-search-result><index|copy-search-result> and
+    <scm|search-result=?><index|search-result=?> have the usual semantics.
+
+    The optional arguments <var|get-path> and <var|put-path>, when not false,
+    are bytevector slices consisting of a list of
+    <scm|/dht:path-element><index|/dht:path-element><index|path element>.
+
+    The <var|get-path><index|get path>, if any, is the path from the storage
     location to the current peer. Conversely, the <var|put-path><index|put
     path>, if any, is a path from the peer that inserted the datum into the
-    DHT to the storage location. The <var|get-path> and <var|put-path> can be
-    accessed with <scm|search-result-get-path><index|search-result-get-path>
-    and <scm|search-result-put-path><index|search-result-put-path>
-    respectively.
+    DHT to the storage location.
 
-    When the datum, get path and put path together are too large, a
+    When the datum, get path and put path together are too large, an
     <scm|&overly-large-paths><index|&overly-large-paths> condition is raised.
     When the bytevector slice length of <var|get-path> or <var|put-path> is
     not a multiple of the size of a path element, then a
     <scm|&malformed-path><index|&malformed-path> condition is raised.
+
+    It currently is unknown whether the presence of a path requires the
+    presence of the other path. TODO: define too large.
   </explain>
 
   <section|Accessing data in the DHT>
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index e4943c9..91928f8 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -49,8 +49,9 @@
 	  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
+	  make-search-result make-search-result/share search-result?
+	  search-result->datum search-result-get-path search-result-put-path
+	  search-result=?
 
 	  copy-datum copy-search-result copy-insertion copy-query
 
@@ -124,7 +125,7 @@
 		and < >= = quote * / + - define begin ... let*
 		quote case else values apply let cond if > eq?
 		<= expt assert exact? integer? lambda for-each
-		not expt min max div-and-mod positive?
+		not expt min max / mod or positive?
 		vector cons append list =>)
 	  (only (rnrs control)
 		unless when)
@@ -326,92 +327,109 @@ modifications to the slices in @var{old} do not impact the new query object.")
 	       #: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)
-	      (immutable get-path search-result-get-path)
-	      (immutable put-path search-result-put-path))
-      (protocol
-       (lambda (%make)
-	 (lambda* (datum #:key (get-path #f) (put-path #f))
-	   "Make a search result object for the datum @var{datum}. The datum can
-be recovered with the accessor @code{search-result->datum}. It can be tested if
-an object is a search result with the predicate @code{search-result?}. The
-optional arguments @var{get-path} and @var{put-path}, when not false, are bytevector
-slices consisting of a list of @code{/dht:path-element}.
-
-The @var{get-path} , if any, is the path from the storage location to the
-current peer. Conversely, the @var{put-path}, if any, is a path from the
-peer that inserted the datum into the DHT to the storage location. The
-@var{get-path}} and @var{put-path} can be accessed with
-@code{search-result-get-path} and @code{search-result-put-path} respectively.
-
-When the datum, get path and put path together are too large, a
-@code{&overly-large-paths} condition is raised. When the
-bytevector slice length of @var{get-path} or @var{put-path} is not a
-multiple of the size of a path element, then a @code{&malformed-path}
-condition is raised."
-	   ;; TODO: can a get-path exist without a put-path?
-	   (let^ ((! (make-who)
-		     (make-who-condition 'datum->search-result))
-		  (! datum (validate-datum datum))
-		  (!^ (verify-path what path)
-		      "Test if @var{path} looks like a get path, put path or
+    (define (verify-path what path)
+      "Test if @var{path} looks like a get path, put path or
 falsehood. If it is false, return @code{#false}, @code{0} and @code{0}.
 Otherwise, if it appears to be a valid path, return @var{path} as a readable
-bytevector slice, the size of the path and the length of the path.  If
-@var{path} is invalid, raise an appropriate exception."
-		     ((? (not path)
-			 (values #false 0 0))
-		      ;; Verify the slice is readable, and make sure the
-		      ;; 'what' field of the &missing-capabilities is
-		      ;; precise -- we can rely on slice/read-only to
-		      ;; perform capability checking, but then the 'what'
-		      ;; field wouldn't be correct.
-		      (_ (verify-slice-readable what path))
-		      ;; Verify the path actually consists of an integral number
-		      ;; of /dht:path-element structures.
-		      (! size (slice-length path))
-		      (<-- (length remainder)
-			   (div-and-mod size (sizeof /dht:path-element '())))
-		      (? (positive? remainder)
-			 (raise (condition
-				 (make-who)
-				 (make-malformed-path what size)))))
-		     ;; We could place an upper bound on the length of
-		     ;; @var{path} here, but that's a bit useless because
-		     ;; we will verify the total length (get-path + put-path)
-		     ;; later anyway.
-		     (values (slice/read-only path) size length))
-		  ;; Verify both the get-path and the put-path (if any),
-		  ;; remove writability and only keep readability.
-		  (<-- (get-path get-path-size get-path-length)
-		       (verify-path 'get-path get-path))
-		  (<-- (put-path put-path-size put-path-length)
-		       (verify-path 'put-path put-path))
-		  ;; Make sure the get-path, put-path, datum and
-		  ;; /:msg:dht:client:result header will fit in a GNUnet
-		  ;; message.  TODO: maybe also consider other messages?
-		  (! hypothetical-message-size
-		     (+ (sizeof /:msg:dht:client:result '())
-			get-path-size put-path-size))
-		  (? (> hypothetical-message-size %max-message-size)
-		     (raise (condition
-			     (make-who)
-			     (make-overly-large-paths
-			      (slice-length (datum-value datum))
-			      get-path-length put-path-length)))))
-		 (%make 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 (copy-datum (search-result->datum old))
-			    #:get-path
-			    (and get-path (slice-copy/read-only get-path))
-			    #:put-path
-			    (and put-path (slice-copy/read-only put-path))))
+bytevector slice.  If @var{path} is invalid, raise an appropriate exception.
+
+Whether the length is in bounds is _not_ considered in this check,
+as the total length of all paths and the datum is verified later
+anyways."
+      (let^ ((? (not path) #false)
+	     ;; Verify the slice is readable, and make sure the
+	     ;; 'what' field of the &missing-capabilities is
+	     ;; precise -- we can rely on slice/read-only to
+	     ;; perform capability checking, but then the 'what'
+	     ;; field wouldn't be correct.
+	     (_ (verify-slice-readable what path))
+	     ;; Verify the path actually consists of an integral number
+	     ;; of /dht:path-element structures.
+	     (! size (slice-length path))
+	     (! remainder (mod size (sizeof /dht:path-element '())))
+	     (? (positive? remainder)
+		(raise (condition
+			(make-who-condition 'make-search-result/share)
+			(make-malformed-path what size)))))
+	    (slice/read-only path)))
+
+    (define (path-equal? x y)
+      (or (and (not x) (not y)) ; both are #false
+	  (and x y ; both are a slice ...
+	       (slice-contents-equal? x y)))) ; ... with the same contents
+
+    (define-record-type* (<search-result> search-result?)
+      #:constructor/copy make-search-result
+      #:constructor (make-search-result/share
+		     "Make a search result object for the datum datum with
+(optionally) a get path get-path and put path put-path. Search results are
+@acroynm{cisw} objects and as such the procedures @code{search-result->datum},
+@code{search-result-get-path}, @code{search-result-put-path},
+@code{make-search-result}, @code{make-search-result/share},
+@code{search-result?}, @code{copy-search-result} and @code{search-result=?}
+have the usual semantics.
+
+The optional arguments @var{get-path} and @var{put-path}, when not false,
+are bytevector slices consisting of a list of /dht:path-element.
+
+The @var{get-path}, if any, is the path from the storage location to the
+current peer. Conversely, the @var{put-path}, if any, is a path from the peer
+that inserted the datum into the DHT to the storage location.
+
+When the datum, get path and put path together are too large, an
+@code{&overly-large-paths} condition is raised. When the bytevector slice
+length of get-path or put-path is not a multiple of the size of a path element,
+then a @code{&malformed-path} condition is raised.
+
+It currently is unknown whether the presence of a path requires the presence
+of the other path. TODO: define too large.")
+      #:constructor-keyword-arguments
+      (datum #:key (get-path #f) (put-path #f))
+      #:copy (copy-search-result
+	      "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.")
+      #:equality search-result=?
+      #:field (datum
+	       #:copy copy-datum
+	       #:equality datum=?
+	       #:preprocess validate-datum
+	       #:getter search-result->datum)
+      #:field (get-path
+	       #:copy slice-copy/read-only
+	       #:equality path-equal?
+	       #:preprocess
+	       (=> (verify-path 'get-path get-path))
+	       #:getter search-result-get-path)
+      #:field (put-path
+	       #:copy slice-copy/read-only
+	       #:equality path-equal?
+	       #:preprocess
+	       ;; TODO: can a get-path exist without a put-path?
+	       (=> (let^ ((! put-path (verify-path 'put-path put-path))
+			  (! (path-size p)
+			     (if p
+				 (slice-length p)
+				 0))
+			  (! (path-length p)
+			     (/ (path-size p) (sizeof /dht:path-element '())))
+			  ;; Make sure the get-path, put-path, datum
+			  ;; and /:msg:dht:client:result header will fit
+			  ;; in a GNUnet message.  TODO: maybe also consider
+			  ;; other messages?
+			  (! hypothetical-message-size
+			     (+ (sizeof /:msg:dht:client:result '())
+				(path-size get-path)
+				(path-size put-path)))
+			  (? (> hypothetical-message-size %max-message-size)
+			     (raise (condition
+				     (make-who-condition
+				      'make-search-result/share)
+				     (make-overly-large-paths
+				      (slice-length (datum-value datum))
+				      (path-length get-path)
+				      (path-length put-path))))))
+			 put-path))
+	       #:getter search-result-put-path))
 
     
 
@@ -537,7 +555,7 @@ currently unsupported."
       (analyse
        /:msg:dht:client:result
        header
-       (values (datum->search-result
+       (values (make-search-result/share
 		(make-datum/share
 		 (r% type)
 		 (make-hashcode:512/share (s% key))
diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index 499617b..a0ca375 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -249,14 +249,6 @@
 	 (slice->bytevector (datum-value z))
 	 (datum-expiration z)))
 
-(define (search-result->sexp z)
-  (list (slice->bytevector (search-result-get-path z))
-	(slice->bytevector (search-result-put-path z))
-	(datum->sexp (search-result->datum z))))
-
-(define (search-result=? x y)
-  (equal? (search-result->sexp x) (search-result->sexp y)))
-
 (define (hashcode-independent? x y)
   (slice-independent? (hashcode:512->slice x) (hashcode:512->slice y)))
 
@@ -308,8 +300,8 @@
 	 (old-get-path (make-slice/read-write* (path-length->size 5)))
 	 (old-put-path (make-slice/read-write* (path-length->size 9)))
 	 (old-datum (make-a-datum #:value old-value #:expiration 555))
-	 (old (datum->search-result old-datum #:get-path old-get-path
-				    #:put-path old-put-path))
+	 (old (make-search-result/share old-datum #:get-path old-get-path
+					#:put-path old-put-path))
 	 (new (copy-search-result old)))
     (and (search-result=? old new)
 	 (search-result-independent? old new))))
@@ -325,13 +317,13 @@
 
 (define-syntax-rule (search-result-get-path-slice-test test-case k)
   (slice-property-test test-case (lambda () k) search-result?
-		       (lambda (s) (datum->search-result (make-a-datum)
-							 #:get-path s))
+		       (lambda (s) (make-search-result/share (make-a-datum)
+							     #:get-path s))
 		       search-result-get-path))
 (define-syntax-rule (search-result-put-path-slice-test test-case k)
   (slice-property-test test-case (lambda () k) search-result?
-		       (lambda (s) (datum->search-result (make-a-datum)
-							 #:put-path s))
+		       (lambda (s) (make-search-result/share (make-a-datum)
+							     #:put-path s))
 		       search-result-put-path))
 
 ;; These detected a bug: the capabilities were not restricted!
@@ -346,17 +338,17 @@
  "search-result-put-path, empty" (make-slice/read-write 0))
 (test-equal "search-result-get-path, none"
   (list #false) ; TODO: drop 'list' when SRFI-64 bug is fixed
-  (list (search-result-get-path (datum->search-result (make-a-datum)))))
+  (list (search-result-get-path (make-search-result/share (make-a-datum)))))
 (test-equal "search-result-put-path, none"
   (list #false) ; TODO: drop 'list' when SRFI-64 bug is fixed
-  (list (search-result-put-path (datum->search-result (make-a-datum)))))
+  (list (search-result-put-path (make-search-result/share (make-a-datum)))))
 
 (test-missing-caps
  "search-result get-path must be readable"
  'get-path
  CAP_WRITE
  CAP_READ
- (datum->search-result
+ (make-search-result/share
   (make-a-datum) #:get-path
   (slice/write-only (make-slice/read-write* (path-length->size 7)))))
 
@@ -365,7 +357,7 @@
  'put-path
  CAP_WRITE
  CAP_READ
- (datum->search-result
+ (make-search-result/share
   (make-a-datum) #:put-path
   (slice/write-only (make-slice/read-write* (path-length->size 7)))))
 
@@ -383,10 +375,10 @@
 			   (list (condition-who c)
 				 (malformed-path-what c)
 				 (malformed-path-size c))))
-		  (datum->search-result
+		  (make-search-result/share
 		   (make-a-datum) keyword
 		   (make-slice/read-write* size)))
-		(list 'datum->search-result what size)))))))
+		(list 'make-search-result/share what size)))))))
 
 (test-malformed-path
  "get-path size must be a multiple of the size of a path element"
@@ -519,7 +511,7 @@ supported.  When @var{explode} is signalled, the connection is closed."
 		  (let^ ((/o/ loop)
 			 (! insertion (get-message channel))
 			 ;; The tests don't require get-path/put-path.
-			 (! search-result (datum->search-result
+			 (! search-result (make-search-result/share
 					   (insertion->datum insertion)))
 			 (! message (construct-client-result search-result
 							     unique-id)))