[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 03/03: dht: Use 'query' data structure.
|
From: |
gnunet |
|
Subject: |
[gnunet-scheme] 03/03: dht: Use 'query' data structure. |
|
Date: |
Sun, 26 Dec 2021 18:37:21 +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.
commit c42d2ba1b56ebbaf443b628c28721aa61f8d1a8f
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sun Dec 26 17:52:38 2021 +0100
dht: Use 'query' data structure.
* gnu/gnunet/dht/client.scm
(<get>): Use '<query>'.
(send-get!): Adjust to new fields.
(start-get!): Likewise.
* examples/web.scm
(parameters->query): New procedure.
(process-search-dht): Adjust to new DHT API.
---
examples/web.scm | 81 +++++++++++++++++++++++++----------------------
gnu/gnunet/dht/client.scm | 35 +++++++-------------
2 files changed, 55 insertions(+), 61 deletions(-)
diff --git a/examples/web.scm b/examples/web.scm
index 2564dc4..71cf05f 100644
--- a/examples/web.scm
+++ b/examples/web.scm
@@ -139,6 +139,22 @@ for success is used."
(define as-string (try-utf8->string bv))
(or as-string (object->string bv)))
+(define (parameters->query parameters)
+ "Perform rudimentary validation on the paramaters @var{parameters}
+for a /search-dht form. If correct, return an appropriate query object.
+If incorrect, return @code{#false}. TODO more validation."
+ (let* ((type (and=> (assoc-ref parameters "type") string->number))
+ (key-encoding (assoc-ref parameters "key-encoding"))
+ (key (assoc-ref parameters "key"))
+ (replication-level (assoc-ref parameters "key"))
+ (desired-replication-level
+ (and=> (assoc-ref parameters "replication-level") string->number)))
+ (and type key-encoding key replication-level desired-replication-level
+ (dht:make-query type
+ (decode/key key-encoding key)
+ #:desired-replication-level
+ desired-replication-level))))
+
(define (process-search-dht dht-server parameters)
(define what)
(define found? (make-condition))
@@ -150,41 +166,31 @@ for success is used."
(slice-copy get-path)
(slice-copy put-path)))
(signal-condition! found?))
- ;; Perform rudimentary input parameter validation (TODO: more validation).
- (let* ((type (and=> (assoc-ref parameters "type") string->number))
- (key-encoding (assoc-ref parameters "key-encoding"))
- (key (assoc-ref parameters "key"))
- (replication-level (assoc-ref parameters "key"))
- (desired-replication-level
- (and=> (assoc-ref parameters "replication-level") string->number)))
- (if (and type key-encoding key replication-level desired-replication-level)
- (begin
- (dht:start-get! dht-server type
- (decode/key key-encoding key)
- found
- #:desired-replication-level
- desired-replication-level)
- (wait found?)
- ;; TODO: properly format the result, streaming, stop searching
- ;; 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)))))))))
- (respond/html `(p "Some fields were missing / invalid")
- #:status-code 400))))
+ (define query (parameters->query parameters))
+ (if query
+ (begin
+ (dht:start-get! dht-server query found)
+ (wait found?)
+ ;; TODO: properly format the result, streaming, stop searching
+ ;; 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)))))))))
+ (respond/html `(p "Some fields were missing / invalid")
+ #:status-code 400)))
(define-once started? #f)
@@ -235,8 +241,9 @@ for success is used."
(bv-slice/read-write (make-bytevector 64))
(bv-slice/read-write #vu8(#xde #xad #xbe #xef)))
(dht:start-get! dht-server
- (symbol-value block-type block:test)
- (bv-slice/read-write (make-bytevector 64)) pk)
+ (dht:make-query
+ (symbol-value block-type block:test)
+ (bv-slice/read-write (make-bytevector 64))) pk)
(let loop ()
(let-values (((client request body)
(read-client impl server)))
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index c2e3813..7ceb8fa 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -244,11 +244,8 @@ undocumented and untested."
(define-record-type (<get> %make-get get?)
(fields (immutable server get:server)
(immutable found get:iterator)
- (immutable key get:key) ; bytevector slice (/hashcode:512)
+ (immutable query get:query) ; <query>
(immutable unique-id get:unique-id)
- (immutable desired-replication-level
- get:desired-replication-level)
- (immutable type get:type)
(immutable options get:options)))
(define-record-type (<put> %make-put put?)
@@ -266,9 +263,10 @@ undocumented and untested."
(value->index (symbol-value message-type msg:dht:client:get)))
(set%! /:msg:dht:client:get '(options) s (get:options get))
(set%! /:msg:dht:client:get '(desired-replication-level) s
- (bound-replication-level (get:desired-replication-level get)))
- (set%! /:msg:dht:client:get '(type) s (get:type get))
- (slice-copy! (get:key get) (select /:msg:dht:client:get '(key) s))
+ (query-desired-replication-level (get:query get)))
+ (set%! /:msg:dht:client:get '(type) s (query-type (get:query get)))
+ (slice-copy! (query-key (get:query get))
+ (select /:msg:dht:client:get '(key) s))
(set%! /:msg:dht:client:get '(unique-id) s (get:unique-id get))
(send-message! mq s))
@@ -302,29 +300,18 @@ undocumented and untested."
(assert (block-type? type))
(value->index type))))
- (define* (start-get! server type key found
- #:key (desired-replication-level 3))
+ (define* (start-get! server query found)
"Perform an asynchronous GET operation on the DHT, and return a handle
-to control the GET operation. Search for a block of type @var{type} (a
-@code{block-type} or its numeric value) and key @var{key}, a readable
bytevector
-slice. Call the procedure @var{found} on every search result.
+to control the GET operation. Search for a block described by the query
+@var{found}. Call the unary procedure @var{found} on every search result.
-This procedure is called as @code((found type key data expiration get-path
put-path)w},
-where @var{key}, @var{data}, @var{get-path} and @var{put-path} are readable
-bytevector slices and @var{type} is the numeric value of the block type.
(TODO: why does the DHT service include the key and type?).
-These slices must not be used after @var{found} returns, as the underlying
buffer
-might be reused."
+(TODO: Document: These slices must not be used after @var{found} returns,
+as the underlying buffer might be reused.)"
;; TODO: options, xquery ...
- (unless (= (slice-length key) (sizeof /hashcode:512 '()))
- (error "length of key incorrect"))
(define id (fresh-id server))
- (define handle (%make-get server found (slice/read-only key)
- id
- desired-replication-level
- (canonical-block-type type)
- 0)) ; TODO
+ (define handle (%make-get server found query id 0)) ; TODO: options
;; Tell 'process-new-get-operations' about the new get operation.
;; That fiber will take care of putting it into the operation map.
(hashq-set! (server-new-get-operations server) handle #t)
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.