[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] branch master updated (86e6038 -> 671b95d)
|
From: |
gnunet |
|
Subject: |
[gnunet-scheme] branch master updated (86e6038 -> 671b95d) |
|
Date: |
Thu, 09 Feb 2023 15:47:57 +0100 |
This is an automated email from the git hooks/post-receive script.
maxime-devos pushed a change to branch master
in repository gnunet-scheme.
from 86e6038 utils/records: Raise &missing-capabilities exceptions.
new 918c2fa WIP new construct + analyse
new 6144a9e utils/records: Fix auto-generated constructor/copy docstring.
new 1844a24 utils/records: Support copying when
#:read-only-slice-wrapper=#false.
new eded264 utils/records: Give preprocessors access to previous fields.
new fdbe758 dht/client: Rewrite <datum> in terms of cisw.
new d3a8067 doc/distributed-hash-table: Normalise language for
normalisation of type.
new 903c860 dht/client: Define equality procedure for datums.
new 671b95d dht/client: Fix typo: € -> e.
The 8 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails. The revisions
listed as "add" were already present in the repository and have only
been added to this reference.
Summary of changes:
doc/distributed-hash-table.tm | 29 ++++++-----
examples/web.scm | 2 +-
gnu/gnunet/dht/client.scm | 103 ++++++++++++++++++++++-----------------
gnu/gnunet/fs/network.scm | 36 ++++++++++++--
gnu/gnunet/fs/struct.scm | 2 +-
gnu/gnunet/utils/records.scm | 85 ++++++++++++++++++++++----------
tests/distributed-hash-table.scm | 11 ++---
7 files changed, 171 insertions(+), 97 deletions(-)
diff --git a/doc/distributed-hash-table.tm b/doc/distributed-hash-table.tm
index 4dcaa39..da57120 100644
--- a/doc/distributed-hash-table.tm
+++ b/doc/distributed-hash-table.tm
@@ -41,19 +41,21 @@
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 <var|expiration> is optional, see
- <reference|???>.
+ <reference|???>. The block type <var|type> is normalised to its numerical
+ value; <scm|datum-type> returns integers.
- 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>,
+ <scm|make-datum/share><index|make-datum/share> and
+ <scm|datum=?><index|datum=?> 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>
@@ -79,7 +81,8 @@
(or its corresponding numeric value), with key <var|key> (a
hashcode:512), at desired replication level
<scm|desired-replication-level> (see <reference|replication levels???>).
- <todo|various options, xquery>
+ <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
@@ -138,10 +141,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..27530df 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=?
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)
@@ -111,14 +112,16 @@
(only (gnu gnunet utils bv-slice)
slice-length slice/read-only make-slice/read-write slice-copy!
slice-slice verify-slice-readable slice-copy/read-write
- slice-copy/read-only)
+ slice-copy/read-only slice-contents-equal?)
(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,54 @@ 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.")
+ #:equality datum=?
+ #:field (type #:copy identity
+ #:equality =
+ #:getter datum-type
+ #:preprocess canonical-block-type)
+ #:field (key #:copy copy-hashcode:512
+ #:equality hashcode:512=?
+ #:getter datum-key
+ #:preprocess validate-key)
+ #:field (value #:copy slice-copy/read-only
+ #:equality slice-contents-equal?
+ #: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
+ #:equality =
+ #: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?}, @code{make-datum} and
+@code{make-datum/share} and @datum=?} 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 +509,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 +529,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/gnu/gnunet/fs/network.scm b/gnu/gnunet/fs/network.scm
index 8de63c0..904a47e 100644
--- a/gnu/gnunet/fs/network.scm
+++ b/gnu/gnunet/fs/network.scm
@@ -1,6 +1,6 @@
;#!r6rs
;; This file is part of Scheme-GNUnet
-;; Copyright © 2022 GNUnet e.V.
+;; Copyright © 2022, 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
@@ -19,13 +19,15 @@
;; TODO: untested
(define-library (gnu gnunet fs network)
- (export construct-request-loc-signature analyse-request-loc-signature)
+ (export construct-request-loc-signature analyse-request-loc-signature
+ construct-response-loc-signature analyse-response-loc-signature)
(import (only (rnrs base) define values)
(only (guile) begin define*)
(only (gnu extractor enum) value->index symbol-value)
(only (gnu gnunet message protocols) message-type)
(only (gnu gnunet fs struct)
- /content-hash-key /:msg:fs:request-loc-signature)
+ /content-hash-key /:msg:fs:request-loc-signature
+ /:msg:fs:response-loc-signature)
(only (gnu gnunet fs uri)
content-hash-key-key ;; TODO rename
content-hash-key-query
@@ -72,4 +74,32 @@ message @var{message}."
(values (r% file-length)
(make-content-hash-key/share (s% content-hash-key))
(r% expiration-time)
+ (r% purpose)))
+
+ (define*
+ (construct-response-loc-signature expiration-time signature peer
+ #:key (purpose %purpose-peer-placement))
+ "Create a new @code{/:msg:fs:response-loc-signature} message, for an
EdDSA signature
+@var{signature} (as a readable @code{/eddsa-signature} bytevector slice) by
@var{peer}
+(as a readable @code{/peer-identity} bytevector slice), expiring at
@var{expiration-time}
+(TODO type)."
+ (construct
+ /:msg:fs:response-loc-signature
+ (=>! (header size) (%sizeof))
+ (=>! (header type)
+ (value->index
+ (symbol-value message-type msg:fs:response-loc-signature)))
+ (=>! (purpose) purpose)
+ (=>! (expiration-time) expiration-time)
+ (=>slice! (signature) signature)
+ (=>slice! (peer) peer)))
+
+ (define-analyser analyse-response-loc-signature
+ /:msg:fs:response-loc-signature
+ "Return the expiration time (TODO type), signature (as a slice of the
message),
+peer identity (as a slice of the message) and the signature purpose
corresponding to
+the @code{/:msg:fs:response-loc-signature} message."
+ (values (r% expiration-time)
+ (s% signature)
+ (s% peer)
(r% purpose)))))
diff --git a/gnu/gnunet/fs/struct.scm b/gnu/gnunet/fs/struct.scm
index 12e9874..e9f550b 100644
--- a/gnu/gnunet/fs/struct.scm
+++ b/gnu/gnunet/fs/struct.scm
@@ -1,5 +1,5 @@
;; This file is part of Scheme-GNUnet.
-;; Copyright © 2003--2012, 2022 GNUnet e.V.
+;; Copyright © 2003--2012, 2022--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
diff --git a/gnu/gnunet/utils/records.scm b/gnu/gnunet/utils/records.scm
index becf263..a3839ff 100644
--- a/gnu/gnunet/utils/records.scm
+++ b/gnu/gnunet/utils/records.scm
@@ -19,16 +19,17 @@
(export define-record-type*)
;; keyword? cannot be used from (srfi srfi-88) because that sets
;; a reader option.
- (import (only (guile) define* keyword? error define-values pk)
+ (import (only (guile) define* keyword? error define-values pk syntax-error)
(only (ice-9 match) match)
(only (rnrs base)
begin define lambda define-syntax cons quasiquote quote unquote
unquote-splicing apply reverse append null? eq? and not if
- string? values map assert car cdr cadr cddr let or pair?)
+ string? values map assert car cdr cadr cddr let or pair?
+ => let*)
(only (rnrs control) when unless)
(only (rnrs syntax-case)
syntax quasisyntax unsyntax unsyntax-splicing syntax-case
- syntax->datum identifier? generate-temporaries)
+ syntax->datum identifier? generate-temporaries datum->syntax)
(only (rnrs records syntactic) define-record-type)
(only (srfi srfi-1) assoc)
;; in generated code
@@ -104,15 +105,15 @@
;; The generated code for 'constructor/copy*' expects
;; a 'copy' procedure to exist.
(if (and (eq? copy unset) (not (eq? constructor/copy unset)))
- (car (generate-temporaries '(copy)))
+ (values (car (generate-temporaries '(copy))) #false)
(maybe-identifier-maybe-with-docstring copy)))
(define-values (constructor/copy* constructor/copy-docstring)
(maybe-identifier-maybe-with-docstring constructor/copy))
(define (field-name field) ; -> identifier
(car field))
- (define (field-verify field)
+ (define (field-verify field-name/different field)
(if (field-set field #:predicate)
- #`(assert (#,(field-ref field #:predicate) #,(field-name field)))
+ #`(assert (#,(field-ref field #:predicate) #,field-name/different))
#'#true)) ; exact value doesn't matter
(define (field-compare field this that)
(define g (field-ref field #:getter)) ; always defined
@@ -127,19 +128,45 @@
#`(immutable #,(field-name field)
#,(field-ref field #:getter)))
;; TODO bail out if unrecognised field settings
- (define (field-preprocess field)
- (if (field-set field #:preprocess)
- #`(#,(field-ref field #:preprocess) #,(field-name field))
- (field-name field)))
+ (define (field-copy field object)
+ #`(#,(field-ref field #:copy) (#,(field-ref field #:getter) #,object)))
+
+ ;; The same symbols as in (map field-name fields*), but as different
+ ;; identifiers, to avoid field values from accidentbeing used before they
+ ;; have been preprocessed. They are equal as symbols, such that
+ ;; 'procedure-arguments' and the like produce something legible.
+ (define field-names/different
+ (map (lambda (f template-id)
+ (datum->syntax template-id (syntax->datum (field-name f))))
+ fields* (generate-temporaries fields*)))
+ (define (preprocess-arguments body)
+ ;; First, use field-names/different as constructor arguments.
+ ;; Otherwise, the preprocessors might accidentally use an
+ ;; un-preprocessed field. Then, gradually
+ ;; re-introduce the field names, but with their preprocessed
+ ;; values. Lastly, insert 'body'.
+ (define (preprocess field-name/different field)
+ #`(#,(field-name field)
+ #,(if (field-set field #:preprocess)
+ (syntax-case (field-ref field #:preprocess) (=>)
+ ((=> expr)
+ #`(let ((#,(field-name field) #,field-name/different))
+ expr))
+ (proc #`(proc #,field-name/different)))
+ ;; nothing to preprocess, just unstash things.
+ field-name/different)))
+ #`(let* #,(map preprocess field-names/different fields*)
+ #,body))
#`(begin
(define-record-type (#,<type> #,constructor* #,type?)
(fields #,@(map field-clause fields*))
(protocol
(lambda (%make)
- (lambda #,(map field-name fields*)
+ (lambda #,field-names/different
#,constructor-docstring
- #,@(map field-verify fields*)
- (%make #,@(map field-preprocess fields*)))))
+ #,@(map field-verify field-names/different fields*)
+ #,(preprocess-arguments
+ #`(%make #,@(map field-name fields*))))))
(sealed #true)
(opaque #true))
#,@(if (eq? equality* unset)
@@ -155,22 +182,26 @@
#,@(map field->analyse-fragment fields*)))))
#,@(if (eq? copy* unset)
#'()
- ;; Note: support for read-only-slice-wrapper = unset can be
- ;; implemented if needed with some work.
- (begin
- (assert (eq? #true (syntax->datum read-only-slice-wrapper)))
- #`((define (#,copy* slice)
- (#,constructor*
- (slice-copy/read-only
- (#,(field-ref (car fields*) #:getter) slice)))))))
+ ;; When possible, avoid having to define a #:copy
+ ;; procedure and sort-of 'batch' allocations a bit.
+ (syntax-case read-only-slice-wrapper ()
+ (#true
+ #`((define (#,copy* slice)
+ (#,constructor*
+ (slice-copy/read-only
+ (#,(field-ref (car fields*) #:getter) slice))))))
+ ;; If not, just copy fields one-by-one.
+ (#false
+ #`((define (#,copy* object)
+ (#,constructor
+ #,@(map (lambda (f) (field-copy f #'object))
+ fields*)))))))
#,@(if (eq? constructor/copy* unset)
#'()
- ;; Note: likewise.
- (begin
- (assert (eq? #true (syntax->datum read-only-slice-wrapper)))
- #`((define (#,constructor/copy* object)
- #,constructor/copy-docstring
- (#,copy* (#,constructor* object))))))))
+ #`((define (#,constructor/copy* #,@(map field-name fields*))
+ #,constructor/copy-docstring
+ (#,copy* (#,constructor*
+ #,@(map field-name fields*))))))))
(define (field-ref field keyword)
(match (assoc keyword (cdr field))
diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index fe6ba96..367d530 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"
@@ -266,9 +266,6 @@
(define (query=? x y)
(equal? (query->sexp x) (query->sexp y)))
-(define (datum=? x y)
- (equal? (datum->sexp x) (datum->sexp y)))
-
(define (search-result=? x y)
(equal? (search-result->sexp x) (search-result->sexp y)))
@@ -620,7 +617,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 +769,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.
- [gnunet-scheme] branch master updated (86e6038 -> 671b95d),
gnunet <=
- [gnunet-scheme] 04/08: utils/records: Give preprocessors access to previous fields., gnunet, 2023/02/09
- [gnunet-scheme] 02/08: utils/records: Fix auto-generated constructor/copy docstring., gnunet, 2023/02/09
- [gnunet-scheme] 03/08: utils/records: Support copying when #:read-only-slice-wrapper=#false., gnunet, 2023/02/09
- [gnunet-scheme] 01/08: WIP new construct + analyse, gnunet, 2023/02/09
- [gnunet-scheme] 07/08: dht/client: Define equality procedure for datums., gnunet, 2023/02/09
- [gnunet-scheme] 06/08: doc/distributed-hash-table: Normalise language for normalisation of type., gnunet, 2023/02/09
- [gnunet-scheme] 08/08: dht/client: Fix typo: € -> e., gnunet, 2023/02/09
- [gnunet-scheme] 05/08: dht/client: Rewrite <datum> in terms of cisw., gnunet, 2023/02/09