[gnunet-scheme] branch master updated (0a8098e -> c42d2ba)

[gnunet]

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 0a8098e  doc: Have some ideas for data structures for accessing the 
DHT.
     new cdf59a7  doc: Correct/improve language in DHT documentation.
     new e0c9caf  dht: Implement documented data structures.
     new c42d2ba  dht: Use 'query' data structure.

The 3 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/scheme-gnunet.tm      |  32 +++++------
 examples/web.scm          |  81 ++++++++++++++-------------
 gnu/gnunet/dht/client.scm | 137 +++++++++++++++++++++++++++++++++++++---------
 3 files changed, 172 insertions(+), 78 deletions(-)

diff --git a/doc/scheme-gnunet.tm b/doc/scheme-gnunet.tm
index b6316cc..4900b7f 100644
--- a/doc/scheme-gnunet.tm
+++ b/doc/scheme-gnunet.tm
@@ -1080,28 +1080,28 @@
   <|explain>
     Make a datum object of block type <var|type> (or its corresponding
     numeric value), with key <var|key> (a readable <scm|/hashcode:512>
-    bytevector slice), value <var|value> (a readable bytevector slice)
+    bytevector slice), value <var|value> (a readable bytevector slice) and
     expiring at <var|expiration> (<todo|type, epoch>). The keyword argument
     <var|expiration> is optional, see <reference|???>.
 
-    The type can be retrieved with the accessor <scm|datum-type>, returning
-    the numeric value of the block type. The accessors <scm|datum-key>,
-    <scm|datum-value> and <scm|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?>.
+    The numeric value of the block type can be retrieved with the accessor
+    <scm|datum-type>. The accessors <scm|datum-key>, <scm|datum-value> and
+    <scm|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?>.
   </explain>
 
   <\explain>
     <scm|(datum-\<gtr\>insertion <var|datum> #:desired-replication-level)>
   <|explain>
     Make an insertion object for inserting the datum <var|datum>, desiring a
-    certain replication level <var|desired-replication-level>. This keyword
-    argument is optional, see <reference|???>. <todo|various options>.
+    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> and
-    <var|desired-replication-level>. It can be tested if an object is a datum
-    object with the predicate <scm|insertion?>.
+    <var|insertion-desired-replication-level>. It can be tested if an object
+    is an insertion object with the predicate <scm|insertion?>.
   </explain>
 
   <\explain>
@@ -1110,13 +1110,13 @@
     Make a query object for searching for a value of block type <var|type>
     (or its corresponding numeric value), with key <var|key> (a readable
     <scm|/hashcode:512> bytevector slice), at desired replication level
-    <scm|desired-replication-level>. This keyword argument is optional, see
-    <reference|???>. <todo|various options, xquery>
+    <scm|desired-replication-level> (see <reference|replication levels???>).
+    <todo|various options, xquery>
 
-    The type (as a numeric value), the key and the desired replication level
-    can be recovered with the accessors <scm|query-type>, <scm|query-key> and
-    <scm|query-desired-replication-level>. It can be tested if an object is a
-    query object with the predicate <scm|query?>.
+    The numeric value of the block type, the key and the desired replication
+    level can be recovered with the accessors <scm|query-type>,
+    <scm|query-key> and <scm|query-desired-replication-level>. It can be
+    tested if an object is a query object with the predicate <scm|query?>.
   </explain>
 
   <\explain>
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 7055458..7ceb8fa 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -26,6 +26,15 @@
          %minimum-replication-level
          %maximum-replication-level
          bound-replication-level
+
+         ;; Non-interactive data structures
+         make-datum datum? 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
+
          connect
          disconnect!
          put!
@@ -45,7 +54,7 @@
          (gnu gnunet mq-impl stream)
          (gnu gnunet mq envelope)
          (only (guile)
-               pk define-syntax-rule define* error
+               pk define-syntax-rule define* lambda* error
                make-hash-table hashq-set! hashq-remove! hashv-set! hashv-ref
                hash-map->list)
          (only (ice-9 atomic)
@@ -107,6 +116,97 @@ valid replication to the level, to the range the DHT 
service likes."
       (max %effective-minimum-replication-level
           (min %effective-maximum-replication-level replication-level)))
 
+    (define (validate-key key)
+      "If @var{key} is, in-fact, a readable /hashcode:512, return it as a
+readable bytevector slice. If not, raise an appropriate exception. "
+      (if (= (slice-length key) (sizeof /hashcode:512 '()))
+         (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")))
+
+    ;; 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)
+             (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
+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 ???.
+
+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 keyn value and expiration time respectively.
+It can be tested if an object is a datum object with the predicate 
@code{datum?}."
+          (%make (canonical-block-type type)
+                 (validate-key key)
+                 (slice/read-only value) ; TODO: max size
+                 expiration))))) ; TODO validate 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},
+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-record-type (<query> make-query query?)
+      (fields (immutable type query-type)
+             (immutable key query-key)
+             (immutable desired-replication-level 
query-desired-replication-level))
+      (protocol
+       (lambda (%make)
+        (lambda* (type key #:key (desired-replication-level 3))
+          "Make a query object for searching for a value of block type 
@var{type}
+(or its corresponding numeric value), with key @var{key} (a readable
+@code{/hashcode:512} bytevector slice), at desired replication level
+@var{desired-replication-level}.
+
+The numeric value of the block type, the key and the desired replication level
+can be recovered with the accessors @code{query-type}, @code{query-key} and
+@code{query-desired-replication-level}. It can be tested if an object is a
+query object with the predicate @code{query?}."
+          (%make (canonical-block-type type)
+                 (validate-key key)
+                 (bound-replication-level desired-replication-level))))))
+
+    (define-record-type (<search-result> datum->search-result search-result?)
+      (fields (immutable datum search-result->datum)
+             (immutable get-path search-result-get-path)
+             (immutable put-path search-result-put-path))
+      (protocol
+       (lambda (%make)
+        (lambda* (datum #:key (get-path #f) (put-path #f))
+          "Make a search result object for the datum @var{datum}. The datum can
+be recovered with the accessor @code{search-result->datum}. It can be tested if
+an object is a search result with the predicate @code{search-result?}. The
+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)))))
+    
+
     ;; New get or put operations are initially in new-get-operations or
     ;; new-put-operation, and not in id->operation-map.  They are moved
     ;; in the background by 'process-new-get-operations' and
@@ -144,11 +244,8 @@ valid replication to the level, to the range the DHT 
service likes."
     (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?)
@@ -166,9 +263,10 @@ valid replication to the level, to the range the DHT 
service likes."
             (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))
 
@@ -202,29 +300,18 @@ valid replication to the level, to the range the DHT 
service likes."
             (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.