[gnunet-scheme] 02/02: dht/client: Rewrite <insertion> in terms of cisw.

[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 785d73834f3d2076f55f0d85187308953447f09b
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Wed Mar 1 10:11:06 2023 +0100

    dht/client: Rewrite <insertion> in terms of cisw.
    
    * doc/distributed-hash-table.scm: Adjust API.
    * examples/web.scm: Adjust to new procedure names.
    * gnu/gnunet/dht/client.scm (datum->insertion): Rename to ...
    (make-insertion/share): ... this.
    (make-insertion): New procedure.
    (<insertion>): Rewrite as a cisw.
    (insertion=?): Add standard cisw procedure.
    (analyse-client-put): Adjust to renaming.
    * tests/distributed-hash-table.scm
    ("copy-insertion: equal and independent")
    ("synchronuous ping-pong with multiple balls (no interruptions, no
    cancellation)")
    ("search callback re-entrancy"):
    ("searches restarted after disconnect")
    ("cancelling a search within a search callback does not hang")
    (i): Adjust to new names.
    (insertion=?,insertion->sexp): Remove now unused procedures.
---
 doc/distributed-hash-table.tm    | 14 +++++------
 examples/web.scm                 |  4 ++--
 gnu/gnunet/dht/client.scm        | 52 ++++++++++++++++++++++------------------
 tests/distributed-hash-table.scm | 19 +++++----------
 4 files changed, 44 insertions(+), 45 deletions(-)

diff --git a/doc/distributed-hash-table.tm b/doc/distributed-hash-table.tm
index da57120..837c45e 100644
--- a/doc/distributed-hash-table.tm
+++ b/doc/distributed-hash-table.tm
@@ -59,18 +59,18 @@
   </explain>
 
   <\explain>
-    <scm|(datum-\<gtr\>insertion <var|datum>
-    #:desired-replication-level)><index|datum-\<gtr\>insertion>
+    <scm|(make-insertion <var|datum> 
#:desired-replication-level)><index|make-insertion>
   <|explain>
     Make an insertion object for inserting the datum <var|datum>, desiring a
     replication level <var|desired-replication-level> (see
     <reference|replication levels???>)<todo|various options>.
 
-    The datum and desired replication level can be recovered with the
-    accessors <scm|insertion-\<gtr\>datum><index|insertion-\<gtr\>datum> and
-    
<var|insertion-desired-replication-level><index|insertion-desired-replication-level>.
-    It can be tested if an object is an insertion object with the predicate
-    <scm|insertion?><index|insertion?>.
+    Insertions are <acronym|cisw> (<reference|cisw>) ojects and as such the
+    procedures <scm|insertion-\<gtr\>datum><index|insertion-\<gtr\>datum>,
+    
<scm|insertion-desired-replication-level><index|insertion-desired-replication-level>,
+    <scm|insertion?><index|insertion?>, <scm|make-insertion>,
+    <scm|make-insertion/share><index|make-insertion/share> and
+    <scm|insertion=?><index|insertion=?> have the usual semantics.
   </explain>
 
   <\explain>
diff --git a/examples/web.scm b/examples/web.scm
index 9f233aa..4c2d2ff 100644
--- a/examples/web.scm
+++ b/examples/web.scm
@@ -1,5 +1,5 @@
 ;; This file is part of scheme-GNUnet.
-;; Copyright © 2021, 2022 GNUnet e.V.
+;; Copyright © 2021--2023 GNUnet e.V.
 ;;
 ;; scheme-GNUnet is free software: you can redistribute it and/or modify it
 ;; under the terms of the GNU Affero General Public License as published
@@ -154,7 +154,7 @@ for success is used."
 (define (process-put-dht dht-server parameters)
   ;; TODO replication level, expiration ...
   (dht:put! dht-server
-           (dht:datum->insertion
+           (dht:make-insertion/share
             (dht:make-datum/share
              (string->number (assoc-ref parameters "type"))
              (decode/key (assoc-ref parameters "key-encoding")
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 27530df..1b86d6d 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -42,7 +42,8 @@
 
          make-datum make-datum/share datum? datum-type datum-key datum-value
          datum-expiration datum=?
-         datum->insertion insertion? insertion->datum
+         make-insertion make-insertion/share insertion? insertion->datum
+         insertion=?
          insertion-desired-replication-level
          make-query query? query-type query-key query-desired-replication-level
          datum->search-result search-result? search-result->datum
@@ -266,29 +267,34 @@ the constructor."
       (%make-datum/share type key value expiration))
 
     ;; A request to insert something in the DHT.
-    (define-record-type (<insertion> datum->insertion insertion?)
-      (fields (immutable datum insertion->datum)
-             (immutable desired-replication-level
-                        insertion-desired-replication-level))
-      (protocol
-       (lambda (%make)
-        (lambda* (datum #:key (desired-replication-level 3)) ; TODO defaults
-          "Make an insertion object for inserting the datum @var{datum},
+    (define-record-type* (<insertion> insertion?)
+      #:copy (copy-insertion
+             "Make a copy of the insertion, such that modifications to the
+slices in the old insertion do not impact the new insertion.")
+      #:constructor/copy %make-insertion
+      #:constructor %make-insertion/share
+      #:equality insertion=?
+      #:field (datum #:copy copy-datum
+                    #:equality datum=?
+                    #:getter insertion->datum
+                    #:preprocess validate-datum)
+      #:field (desired-replication-leval
+              #:copy identity
+              #:equality =
+              #:getter insertion-desired-replication-level
+              #:preprocess bound-replication-level))
+
+    (define* (make-insertion datum #:key (desired-replication-level 3)) ; TODO 
defaults
+      "Make an insertion object for inserting the datum @var{datum},
 desiring a replication level @var{desired-replication-level} (see ??).
 
-The datum and desired replication level can be recovered with the accessors
-@var{insertion->datum} and @var{insertion-desired-replication-level}. It can
-be tested if an object is an insertion object with the predicate
-@code{insertion?}."
-          (%make (validate-datum datum)
-                 (bound-replication-level desired-replication-level))))))
-
-    (define (copy-insertion old)
-      "Make a copy of the insertion @var{old}, such that modifications to the
-slices in @var{old} do not impact the new insertion."
-      (datum->insertion (copy-datum (insertion->datum old))
-                       #:desired-replication-level
-                       (insertion-desired-replication-level old)))
+Insertions are cisw (?) ojects and as such the procedures
+@code{insertion->datum}, @code{insertion-desired-replication-level},
+@code{insertion?}, @code{make-insertion}, @code{make-insertion/share}
+and @code{insertion=?} have the usual semantics."
+      (%make-insertion datum desired-replication-level))
+    (define* (make-insertion/share datum #:key (desired-replication-level 3))
+      (%make-insertion/share datum desired-replication-level))
 
     (define-record-type (<query> make-query query?)
       (fields (immutable type query-type)
@@ -508,7 +514,7 @@ currently unsupported."
       (define value (slice-slice message (sizeof /:msg:dht:client:put '())))
       (analyse /:msg:dht:client:put header
               (values
-               (datum->insertion
+               (make-insertion/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 367d530..10e57ab 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -254,10 +254,6 @@
         (slice->bytevector (datum-value z))
         (datum-expiration z)))
 
-(define (insertion->sexp z)
-  (list (datum->sexp (insertion->datum z))
-       (insertion-desired-replication-level z)))
-
 (define (search-result->sexp z)
   (list (slice->bytevector (search-result-get-path z))
        (slice->bytevector (search-result-put-path z))
@@ -269,9 +265,6 @@
 (define (search-result=? x y)
   (equal? (search-result->sexp x) (search-result->sexp y)))
 
-(define (insertion=? x y)
-  (equal? (insertion->sexp x) (insertion->sexp y)))
-
 (define (hashcode-independent? x y)
   (slice-independent? (hashcode:512->slice x) (hashcode:512->slice y)))
 
@@ -333,7 +326,7 @@
   (let* ((old-value (make-slice/read-write* 71))
         (old-datum (make-a-datum #:value old-value))
         (old
-         (datum->insertion old-datum #:desired-replication-level (random 8)))
+         (make-insertion/share old-datum #:desired-replication-level (random 
8)))
         (new (copy-insertion old)))
     (and (insertion=? old new)
         (insertion-independent? old new))))
@@ -434,7 +427,7 @@
 ;;; Cancelling, closing the connection, parallelism and multiple
 ;;; in-progress requests are currently untested (TBD and implemented!).
 
-(define i (datum->insertion (make-a-datum) #:desired-replication-level 7))
+(define i (make-insertion/share (make-a-datum) #:desired-replication-level 7))
 
 (define (no-error-handler . e)
   (pk 'e e)
@@ -617,7 +610,7 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
        (define key (round->key round))
        (define value (make-slice/read-write 8))
        (slice-u64-set! value 0 j (endianness little))
-       (datum->insertion (make-datum/share type key value)))
+       (make-insertion/share (make-datum/share type key value)))
      (define (make-a-query type round)
        (define key (round->key round))
        (make-query type key))
@@ -768,7 +761,7 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
        (define value-s (make-slice/read-write (sizeof u64/big '())))
        (slice-u64-set! key-s 0 round (endianness big))
        (slice-u64-set! value-s 0 (value round) (endianness big))
-       (put! server (datum->insertion
+       (put! server (make-insertion/share
                     (make-datum/share type (make-hashcode:512/share key-s) 
value-s)))
        (when (< round (- ROUNDS 1))
         (loop (+ round 1))))
@@ -792,7 +785,7 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
                   ;; The 'found' callback is responsible for cancellation.
                   #:linger? #true))
      (signal-condition! search-defined)
-     (put! server (datum->insertion datum))
+     (put! server (make-insertion/share datum))
      (wait done)
      #true)))
 
@@ -854,7 +847,7 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
        (wait disconnected/condition)
        ;; Insert the datum, such that @var{search} can complete (assuming
        ;; that @var{server} remembered to start the search again!).
-       (put! server (datum->insertion datum))
+       (put! server (make-insertion/share datum))
        (wait found/condition)
        ;; Explicitely cancel 'search' such that it is not cancelled too
        ;; early due to GC.

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