[gnunet-scheme] 05/08: dht/client: Rewrite <datum> 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 fdbe758765e6b5d597f7d2faacf9bc096c74c09a
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Thu Feb 9 15:29:53 2023 +0100

    dht/client: Rewrite <datum> in terms of cisw.
    
    This makes the code and documentation more consistent, and reduces the
    risk of bugs.  As a result, there is a new procedure make-datum/share
    that behaves like the old make-datum, and make-datum now makes a copy.
    
    * gnu/gnunet/dht/client.scm (<datum>): Adjust to cisw.
    * examples/web.scm: Replace 'dht:make-datum' by
    'dht:make-datum/share'.
    * gnu/gnunet/dht/client.scm (analyse-client-put): Likewise.
    (analyse-client-result): Likewise.
    * tests/distributed-hash-table.scm (make-a-datum): Likewise.
    ("synchronuous ping-pong with multiple balls (no interruptions, no
    cancellation)"): Likewise.
    ("search callback re-entrancy"): Likewise.
---
 doc/distributed-hash-table.tm    | 22 ++++-----
 examples/web.scm                 |  2 +-
 gnu/gnunet/dht/client.scm        | 96 ++++++++++++++++++++++------------------
 tests/distributed-hash-table.scm |  8 ++--
 4 files changed, 68 insertions(+), 60 deletions(-)

diff --git a/doc/distributed-hash-table.tm b/doc/distributed-hash-table.tm
index 4dcaa39..8ed8c8e 100644
--- a/doc/distributed-hash-table.tm
+++ b/doc/distributed-hash-table.tm
@@ -43,17 +43,17 @@
     epoch>). The keyword argument <var|expiration> is optional, see
     <reference|???>.
 
-    The numeric value of the block type can be retrieved with the accessor
-    <scm|datum-type>. The accessors <scm|datum-key><index|datum-key>,
-    <scm|datum-value><index|datum-value> and
-    <scm|datum-expiration><index|datum-expiration> return the key, value and
-    expiration time respectively. It can be tested if an object is a datum
-    object with the predicate <scm|datum?><index|datum?>.
+    Datums are <acronym|cisw> (<reference|cisw>) objects and as such the
+    procedures <scm|datum-type><index|datum-type>,
+    <scm|datum-key><index|datum-key>, <scm|datum-value><index|datum-value>,
+    <scm|datum-expiration><index|datum-expiration>,
+    <scm|datum?><index|datum?>, <scm|make-datum> and
+    <scm|make-datum/share><index|make-datum/share> have the usual semantics.
 
     The length of <var|value> may be at most
     <scm|%max-datum-value-length><index|%max-datum-value-length>. If this
     bound is exceeded, an appropriate 
<scm|&overly-large-datum><index|&overly-large-datum>
-    and <scm|&who> condition is raised.
+    and <scm|&who> condition is raised in the constructor.
   </explain>
 
   <\explain>
@@ -138,10 +138,10 @@
     block. As such, it is recommended for <var|found> to do as little as
     possible by itself and instead delegate any work to a separate fiber.
 
-    To avoid expensive copies, the implementation can choose to reuse
-    internal buffers for the slices passed to <var|found>, which could be
-    overwritten after the call to <var|found>. As such, it might be necessary
-    to make a copy of the search result, using <scm|copy-search-result>.
+    The search object is only valid for the duration of the call to
+    <var|found>. As such, it might be necessary to make a copy of the search
+    result, using <scm|copy-search-result>, to satisfy the <acronym|cisw>
+    (<reference|cisw>) requirements.
 
     When the boolean <var|linger?> is false (this is the default), the search
     is automatically cancelled when the search object becomes unreachable
diff --git a/examples/web.scm b/examples/web.scm
index 823ad75..9f233aa 100644
--- a/examples/web.scm
+++ b/examples/web.scm
@@ -155,7 +155,7 @@ for success is used."
   ;; TODO replication level, expiration ...
   (dht:put! dht-server
            (dht:datum->insertion
-            (dht:make-datum
+            (dht:make-datum/share
              (string->number (assoc-ref parameters "type"))
              (decode/key (assoc-ref parameters "key-encoding")
                          ;; TODO the key is 00000.... according to 
gnunet-dht-monitor
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index a09f355..ea3a0eb 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -1,6 +1,6 @@
 ;#!r6rs
 ;; This file is part of GNUnet
-;; Copyright (C) 2004-2013, 2016, 2021, 2022 GNUnet e.V.
+;; Copyright (C) 2004-2013, 2016, 2021-2023 GNUnet e.V.
 ;;
 ;; GNUnet is free software: you can redistribute it and/or modify it
 ;; under the terms of the GNU Affero General Public License as published
@@ -40,7 +40,8 @@
          &malformed-path make-malformed-path malformed-path?
          malformed-path-what malformed-path-size
 
-         make-datum datum? datum-type datum-key datum-value datum-expiration
+         make-datum make-datum/share 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
@@ -88,7 +89,7 @@
                run-loop spawn-server-loop)
          (only (guile)
                define-syntax-rule define* lambda* error
-               ->bool and=>)
+               ->bool and=> identity)
          (only (ice-9 atomic)
                make-atomic-box)
          (only (ice-9 match)
@@ -113,12 +114,14 @@
                slice-slice verify-slice-readable slice-copy/read-write
                slice-copy/read-only)
          (gnu gnunet utils hat-let)
+         (only (gnu gnunet utils records)
+               define-record-type*)
          (only (rnrs base)
                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?
-               vector cons append list)
+               vector cons append list =>)
          (only (rnrs control)
                unless when)
          (only (rnrs records syntactic)
@@ -213,44 +216,49 @@ appropriate exception."
       (size malformed-path-size))
 
     ;; An key-value entry in the DHT.
-    (define-record-type (<datum> make-datum datum?)
-      (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 a datum object of block type @var{type} (or its corresponding
-numeric value), with key @var{key} (a hashcode:512), value @var{value} (a 
readable
-bytevector slice) and expiring at @var{expiration}.  The keyword argument
-@var{expiration} is optional, see ???.
-
-The numeric value of the block type can be retrieved with the accessor
-@code{datum-type}. The accessors @code{datum-key}, @code{datum-value} and
-@code{datum-expiration} return the key, value and expiration time respectively.
-It can be tested if an object is a datum object with the predicate 
@code{datum?}.
-
-The length of @var{value} may be at most @code{%max-datum-value-length}.
-If this bound is exceeded, an appropriate @code{&overly-large-datum} and
-@code{&who} condition is raised."
-          (define t (canonical-block-type type))
-          (unless (<= (slice-length value) %max-datum-value-length)
-            (raise (condition
-                    (make-who-condition 'make-datum)
-                    (make-overly-large-datum t (slice-length value)))))
-          (%make t
-                 (validate-key key)
-                 (slice/read-only value)
-                 expiration))))) ; TODO validate expiration
-
-    (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)
-                 (copy-hashcode:512 (datum-key old))
-                 (slice-copy/read-only (datum-value old))
-                 #:expiration (datum-expiration old)))
+    (define-record-type* (<datum> datum?)
+      #:constructor %make-datum/share
+      #:constructor/copy %make-datum
+      #:copy (copy-datum
+             "Make a copy of the datum, such that modifications to the slices
+in the original do not impact the copy.")
+      #:field (type #:copy identity
+                   #:getter datum-type
+                   #:preprocess canonical-block-type)
+      #:field (key #:copy copy-hashcode:512
+                  #:getter datum-key
+                  #:preprocess validate-key)
+      #:field (value #:copy slice-copy/read-only
+                    #:getter datum-value
+                    #:preprocess
+                    (=>
+                     (if (<= (slice-length value) %max-datum-value-length)
+                         (slice/read-only value)
+                         (raise (condition
+                                 (make-who-condition 'make-datum)
+                                 (make-overly-large-datum
+                                  type (slice-length value)))))))
+      #:field (expiration #:copy identity
+                         #:getter datum-expiration))
+
+    ;; TODO default expiration
+    (define* (make-datum type key value #:key (expiration 0))
+      "Make a datum object of block type @var{type} (or its corresponding
+numeric value), with key @var{key} (a hashcode:512), value @var{value} (a
+readable bytevector slice) and expiring at @var{expiration} (TODO type, epoch).
+The keyword argument expiration is optional, see ?.
+
+Datums are @acronym{cisw} objects and as such the procedures
+@code{datum-type}, @code{datum-key}, @code{datum-value},
+@code{datum-expiration}, @code{datum?}, @cod€{make-datum} and
+@code{make-datum/share} have the usual semantics.  The length of value may be
+at most @code{%max-datum-value-length}. If this bound is exceeded, an
+appropriate @code{&overly-large-datum} and @code{&who} condition is raised in
+the constructor."
+      (%make-datum type key value expiration))
+
+    (define* (make-datum/share type key value #:key (expiration 0))
+      (%make-datum/share type key value expiration))
 
     ;; A request to insert something in the DHT.
     (define-record-type (<insertion> datum->insertion insertion?)
@@ -496,7 +504,7 @@ currently unsupported."
       (analyse /:msg:dht:client:put header
               (values
                (datum->insertion
-                (make-datum
+                (make-datum/share
                  (r% type)
                  (make-hashcode:512/share (s% key))
                  value
@@ -516,7 +524,7 @@ currently unsupported."
        /:msg:dht:client:result
        header
        (values (datum->search-result
-               (make-datum
+               (make-datum/share
                 (r% type)
                 (make-hashcode:512/share (s% key))
                 ;; 'value'
diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index fe6ba96..fccfe68 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -1,5 +1,5 @@
 ;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
-;; Copyright (C) 2021, 2022 GNUnet e.V.
+;; Copyright (C) 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
@@ -142,7 +142,7 @@
                              (sizeof /hashcode:512 '()))))
                       (value (make-slice/read-write 0))
                       (expiration (random (expt 2 64))))
-  (make-datum type key value #:expiration expiration))
+  (make-datum/share type key value #:expiration expiration))
 (test-assert "datum?"
   (datum? (make-a-datum)))
 (test-equal "not a datum"
@@ -620,7 +620,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 type key value)))
+       (datum->insertion (make-datum/share type key value)))
      (define (make-a-query type round)
        (define key (round->key round))
        (make-query type key))
@@ -772,7 +772,7 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
        (slice-u64-set! key-s 0 round (endianness big))
        (slice-u64-set! value-s 0 (value round) (endianness big))
        (put! server (datum->insertion
-                    (make-datum type (make-hashcode:512/share key-s) value-s)))
+                    (make-datum/share type (make-hashcode:512/share key-s) 
value-s)))
        (when (< round (- ROUNDS 1))
         (loop (+ round 1))))
      (wait done)

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