[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] branch master updated: dht/client: Use the <search-resul
From: |
gnunet |
Subject: |
[gnunet-scheme] branch master updated: dht/client: Use the <search-result> data structure. |
Date: |
Sun, 26 Dec 2021 21:53:26 +0100 |
This is an automated email from the git hooks/post-receive script.
maxime-devos pushed a commit to branch master
in repository gnunet-scheme.
The following commit(s) were added to refs/heads/master by this push:
new 53a3f91 dht/client: Use the <search-result> data structure.
53a3f91 is described below
commit 53a3f91a4da6bdff20a727b7b7f1ddeaf84826e9
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sun Dec 26 20:45:21 2021 +0000
dht/client: Use the <search-result> data structure.
* gnu/gnunet/dht/client.scm
(validate-datum): Validate data, not /hashcode:512.
(<datum>): Add 'type' field.
(slice-copy,copy-datum,copy-search-result): New procedures.
(<get>)[found]: Document its type.
(reconnect)[process-client-result]: Use <search-result> objects.
* examples/web.scm (process-search-dht): Adjust to new DHT API.
---
examples/web.scm | 45 +++++++++++++++++++------------------
gnu/gnunet/dht/client.scm | 57 +++++++++++++++++++++++++++++++++++------------
2 files changed, 66 insertions(+), 36 deletions(-)
diff --git a/examples/web.scm b/examples/web.scm
index 71cf05f..13a0916 100644
--- a/examples/web.scm
+++ b/examples/web.scm
@@ -156,15 +156,11 @@ If incorrect, return @code{#false}. TODO more validation."
desired-replication-level))))
(define (process-search-dht dht-server parameters)
- (define what)
+ (define search-result)
(define found? (make-condition))
- (define (found type key data expiration get-path put-path)
- (set! what (list type
- (slice-copy key)
- (slice-copy data)
- expiration
- (slice-copy get-path)
- (slice-copy put-path)))
+ (define (found %search-result)
+ ;; TODO: document necessity of copies and this procedure
+ (set! search-result (dht:copy-search-result %search-result))
(signal-condition! found?))
(define query (parameters->query parameters))
(if query
@@ -175,20 +171,25 @@ If incorrect, return @code{#false}. TODO more validation."
;; after something has been found or if the client closes the
connection ...
(respond/html `(div (p "Found! ")
;; TODO: better output, determine why the data is
bogus
- (dl ,@(match what
- ((type key data expiration get-path
put-path)
- `((dt "Type: ")
- (dd ,type)
- (dt "Key: ")
- (dd ,(data->string key))
- (dt "Data: ")
- (dd ,(data->string data))
- (dt "Expiration: ")
- (dd ,(object->string expiration))
- (dt "Get path: ") ; TODO as list
- (dd ,(object->string get-path))
- (dt "Put path: ")
- (dd ,(object->string put-path)))))))))
+ (dl (dt "Type: ")
+ (dd ,(dht:datum-type
+ (dht:search-result->datum search-result)))
+ (dt "Key: ")
+ (dd ,(data->string
+ (dht:datum-key
+ (dht:search-result->datum
search-result))))
+ (dt "Value: ")
+ (dd ,(data->string
+ (dht:datum-value
+ (dht:search-result->datum
search-result))))
+ (dt "Expiration: ")
+ (dd ,(object->string
+ (dht:datum-expiration
+ (dht:search-result->datum
search-result))))
+ (dt "Get path: ") ; TODO as list
+ (dd ,(dht:search-result-get-path search-result))
+ (dt "Put path: ")
+ (dd ,(dht:search-result-put-path
search-result))))))
(respond/html `(p "Some fields were missing / invalid")
#:status-code 400)))
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 7ceb8fa..bd2b226 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -28,13 +28,15 @@
bound-replication-level
;; Non-interactive data structures
- make-datum datum? datum-key datum-value datum-expiration
+ make-datum 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
datum->search-result search-result? search-result->datum
search-result-get-path search-result-put-path
+ copy-datum copy-search-result
+
connect
disconnect!
put!
@@ -123,23 +125,23 @@ readable bytevector slice. If not, raise an appropriate
exception. "
(slice/read-only key)
(error "length of key incorrect")))
- (define (validate-datum key)
- "If @var{key} is, in-fact, a datum, return it. Otherwise, raise an
appropriate exception."
- (if (= (slice-length key) (sizeof /hashcode:512 '()))
- (slice/read-only key)
- (error "length of key incorrect")))
+ (define (validate-datum datum)
+ "If @var{datum} is, in-fact, a datum, return it. Otherwise, raise an
+appropriate exception."
+ (if (datum? datum) datum (error "not a datum")))
;; TODO: use the data structures below and test them
;; An key-value entry in the DHT.
(define-record-type (<datum> make-datum datum?)
- (fields (immutable key datum-key)
+ (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 ad datum object of block type @var{type} (or its corresponding
+ "Make a datum object of block type @var{type} (or its corresponding
numeric value), with key @var{key} (a readable @code{/hashcode:512} bytevector
slice), value @var{value} (a readable bytevector slice) and expiring at
@var{expiration}.
The keyword argument @var{expiration} is optional, see ???.
@@ -153,6 +155,20 @@ It can be tested if an object is a datum object with the
predicate @code{datum?}
(slice/read-only value) ; TODO: max size
expiration))))) ; TODO validate expiration
+ ;; XXX deduplicate
+ (define (slice-copy slice)
+ (define new (make-slice/read-write (slice-length slice)))
+ (slice-copy! slice new)
+ new)
+
+ (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)
+ (slice-copy (datum-key old))
+ (slice-copy (datum-value old))
+ #:expiration (datum-expiration old)))
+
;; A request to insert something in the DHT.
(define-record-type (<insertion> datum->insertion insertion?)
(fields (immutable datum insertion->datum)
@@ -205,6 +221,16 @@ optional keyword arguments @code{get-path} and
@code{put-path} are currently
undocumented and untested."
;; TODO: get-path and put-path
(%make (validate-datum 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 (search-result->datum old)
+ #:get-path (and get-path (slice-copy get-path))
+ #:put-path (and put-path (slice-copy put-path))))
+
;; New get or put operations are initially in new-get-operations or
@@ -243,7 +269,7 @@ undocumented and untested."
(define-record-type (<get> %make-get get?)
(fields (immutable server get:server)
- (immutable found get:iterator)
+ (immutable found get:iterator) ; procedure accepting
<search-result>
(immutable query get:query) ; <query>
(immutable unique-id get:unique-id)
(immutable options get:options)))
@@ -423,11 +449,14 @@ structure) to the get request @var{handle}."
(+ put-path-length get-path-length))))
;; TODO: maybe validate 'key' and 'type'
((get:iterator handle)
- (read% /:msg:dht:client:result '(type) header)
- (select /:msg:dht:client:result '(key) header)
- data
- (read% /:msg:dht:client:result '(expiration) header)
- get-path put-path))
+ (datum->search-result
+ (make-datum
+ (read% /:msg:dht:client:result '(type) header)
+ (select /:msg:dht:client:result '(key) header)
+ data
+ #:expiration
+ (read% /:msg:dht:client:result '(expiration) header))
+ #:get-path get-path #:put-path put-path)))
(define handlers
(message-handlers
(message-handler
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [gnunet-scheme] branch master updated: dht/client: Use the <search-result> data structure.,
gnunet <=