[gnunet-scheme] 177/324: nse/client: Implement connecting to the NSE service.

[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 529d7b589cc2a8a006475ac7a73acc71708e0ec1
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Aug 13 16:46:37 2021 +0200

    nse/client: Implement connecting to the NSE service.
    
    * Makefile.am
      (modules): Add new module.
      (SCM_TESTS): Add new tests.
    * README.org
      (GNUnet network structures): Move entry about 'nse/struct.scm' ...
      (Network size estimation): ... to here.
      (Network size estimation): New section.  Note existence of
      new module.
    * gnu/gnunet/nse/client.scm: New module
    * tests/network-size.scm: Test it.
---
 Makefile.am               |   3 +
 README.org                |   6 +-
 gnu/gnunet/nse/client.scm | 167 ++++++++++++++++++++++++++++++++++++++++++++++
 tests/network-size.scm    | 149 +++++++++++++++++++++++++++++++++++++++++
 4 files changed, 324 insertions(+), 1 deletion(-)

diff --git a/Makefile.am b/Makefile.am
index 8a4801c..8a1ad68 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -64,6 +64,8 @@ modules = \
   gnu/gnunet/util/struct.scm \
   gnu/gnunet/crypto/struct.scm \
   gnu/gnunet/hashcode/struct.scm \
+  \
+  gnu/gnunet/nse/client.scm \
   gnu/gnunet/nse/struct.scm \
   \
   gnu/gnunet/netstruct/procedural.scm \
@@ -105,6 +107,7 @@ SCM_TESTS = \
   tests/message-handler.scm \
   tests/mq.scm \
   tests/mq-stream.scm \
+  tests/network-size.scm \
   tests/update.scm \
   tests/repeated-condition.scm \
   tests/bv-slice.scm \
diff --git a/README.org b/README.org
index 0ab13ca..3abde4c 100644
--- a/README.org
+++ b/README.org
@@ -175,7 +175,6 @@
      are created when accessing network structures with
      (gnu gnunet netstruct syntactic).
 ** GNUnet network structures                                           :good:
-   + gnu/gnunet/nse/struct.scm: network size estimation
    + gnu/gnunet/hashcode/struct.scm: hashes
    + gnu/gnunet/crypto/struct.scm: signatures, keys, nonces ...
    + gnu/gnunet/util/struct.scm: various things
@@ -190,6 +189,11 @@
    TODO: nice abstraction for network errors
 ** Relative time manipulation                                     :test:good:
    + gnu/gnunet/time.scm: Time units and exponential back-off.
+** Network size estimation                                    :test:good:wart:
+   + gnu/gnunet/nse/client.scm: API for the network size estimation
+     service.  Doesn't currently support automatic reconnection.
+   + gnu/gnunet/nse/struct.scm: Network structures for the network size
+     estimation service.
 * Conventions
 ** Fibers, capabilities and ambient authority
    Modules are expected to use ‘fibers’ for concurrency.
diff --git a/gnu/gnunet/nse/client.scm b/gnu/gnunet/nse/client.scm
new file mode 100644
index 0000000..8ac0d8e
--- /dev/null
+++ b/gnu/gnunet/nse/client.scm
@@ -0,0 +1,167 @@
+;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
+;; Copyright (C) 2021 Maxime Devos
+;;
+;; 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
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; scheme-GNUnet is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Affero General Public License for more details.
+;;
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; SPDX-License-Identifier: AGPL3.0-or-later
+
+;; Brief: Interface to the network size estimation service.
+;; C author: Nathan Evans
+;; Scheme author: Maxime Devos
+;;
+;; The Scheme implementation is _not_ based on the C implementation,
+;; though the Scheme API is structured after the C API and slightly
+;; extended.
+
+(define-library (gnu gnunet nse client)
+  (export estimate?
+         estimate:logarithmic-number-peers
+         estimate:number-peers
+         estimate:standard-deviation
+         estimate:timestamp
+         server?
+         connect
+         ;; TODO: disconnect
+         estimate)
+  (import (only (rnrs base)
+               begin define quote lambda case values expt = else)
+         (only (rnrs control)
+               when)
+         (only (rnrs records syntactic)
+               define-record-type)
+          (only (ice-9 atomic)
+               make-atomic-box atomic-box-ref atomic-box-set!)
+          (only (fibers)
+               spawn-fiber)
+         (only (gnu extractor enum)
+               symbol-value value->index)
+         (only (guile)
+               define* const)
+         (only (gnu gnunet util struct)
+               /:message-header)
+         (only (gnu gnunet utils bv-slice)
+               make-slice/read-write slice-length)
+          (only (gnu gnunet netstruct syntactic)
+               read% set%! sizeof)
+          (only (gnu gnunet mq handler)
+               make-message-handler
+               message-handlers)
+          (only (gnu gnunet mq)
+               send-message!)
+          (only (gnu gnunet mq-impl stream)
+               connect/fibers)
+          (gnu gnunet message protocols)
+          (only (gnu gnunet nse struct)
+               /:msg:nse:estimate))
+  (begin
+    (define-record-type (<estimate> %make-estimate estimate?)
+      (fields (immutable logarithmic-number-peers
+                        %estimate:logarithmic-number-peers)
+             (immutable standard-deviation %estimate:standard-deviation)
+             (immutable timestamp %estimate:timestamp))
+      (sealed #t)
+      (opaque #t))
+
+    (define-record-type (<server> %make-server server?)
+      (fields (immutable estimate/box server-estimate/box) ; atomic box of 
flonum
+             (immutable mq nse-mq) ; message queue
+             (immutable config server-config)
+             (immutable connected-callback server-connected-callback)
+                                       ; TODO
+                                       ; (immutable disconnected-callback 
nse-disconnected-callback)
+             (immutable estimate-update-callback server-update-callback)))
+
+    (define (estimate server)
+      "Return the current estimate of the number of peers on the network,
+in some unspecified format.  Alternatively, if no estimate is available
+yet, return @code{#false}."
+      (atomic-box-ref (server-estimate/box server)))
+
+    (define (estimate:logarithmic-number-peers estimate)
+      "Return the logarithm (base 2) of the number of peers on the network
+in @var{estimate} as a positive (possibly zero) number.  As the estimate
+is an estimate, the return value is inexact.
+
+XXX: if the server is broken, it could return a negative number, or NaN!
+Maybe +inf.0 as well?"
+      (%estimate:logarithmic-number-peers estimate))
+
+    (define (estimate:standard-deviation estimate)
+      "Return the standard deviation of the logarithmic estimate
+of the number of peers of the last 64 rounds, as a positive, possibly
+zero flonum.
+
+XXX: if the server is broken, it could be negative!"
+      (%estimate:standard-deviation estimate))
+
+    (define (estimate:number-peers estimate)
+      "Return the estimate of the number of peers on the network in
+@var{estimate} as a positive flonum.  It is not necessarily integral.
+
+XXX: if the server is broken, it could return a negative number, or NaN!
+Maybe +inf.0 as well?"
+      (expt 2.0 (estimate:logarithmic-number-peers estimate)))
+
+    (define (estimate:timestamp estimate)
+      "Return when the estimate @var{estimate} was made, as a standard GNUnet
+timestamp."
+      (%estimate:timestamp estimate))
+
+    (define* (connect config #:key updated connected (spawn spawn-fiber))
+      "Connect to the NSE service in the background.
+
+When connected, the thunk @var{connected} is called and estimates
+will become available (but possibly not immediately).  When a new
+estimate is available, the procedure @var{updated} is called.  This
+procedure should accept the new estimate."
+      (define estimate/box (make-atomic-box #f))
+      (define (handle-estimate! estimate-slice)
+       (define estimate
+         (%make-estimate
+          (read% /:msg:nse:estimate '(size-estimate) estimate-slice)
+          (read% /:msg:nse:estimate '(std-deviation) estimate-slice)
+          (read% /:msg:nse:estimate '(timestamp) estimate-slice)))
+       (atomic-box-set! estimate/box estimate)
+       (updated estimate))
+      (define handlers
+       (message-handlers
+        (make-message-handler (symbol-value message-type msg:nse:estimate)
+                              (lambda (p) (p))
+                              (lambda (s)
+                                (= (slice-length s)
+                                   (sizeof /:msg:nse:estimate '())))
+                              handle-estimate!)))
+      (define (send-start!)
+       ;; The service only starts sending estimates once
+       ;; /:msg:nse:start is sent.
+       (define s (make-slice/read-write (sizeof /:message-header '())))
+       (set%! /:message-header '(size) s (sizeof /:message-header '()))
+       (set%! /:message-header '(type) s
+              (value->index (symbol-value message-type msg:nse:start)))
+       (send-message! mq s))
+      (define (error-handler error)
+       (case error
+         ;; TODO report input errors?
+         ((connection:connected)
+          (send-start!)
+          (when connected (connected)))
+         ;; TODO not yet available ...
+         ;; (connection:lost
+         ;; (when disconnected (disconnected))
+         ;; ;; TODO reconnect!)
+         ((input:regular-end-of-file)
+          (values))))
+      (define mq (connect/fibers config "nse" handlers error-handler
+                                #:spawn spawn))
+      (%make-server estimate/box mq config connected updated))))
diff --git a/tests/network-size.scm b/tests/network-size.scm
new file mode 100644
index 0000000..85efb9b
--- /dev/null
+++ b/tests/network-size.scm
@@ -0,0 +1,149 @@
+;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
+;; Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be>
+;;
+;; 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
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; scheme-GNUnet is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Affero General Public License for more details.
+;;
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; SPDX-License-Identifier: AGPL-3.0-or-later
+(define-module (test-network-size))
+(import (gnu gnunet util time)
+       (gnu gnunet mq)
+       (gnu gnunet mq-impl stream)
+       (gnu gnunet mq handler)
+       (gnu extractor enum)
+       (gnu gnunet message protocols)
+       (only (rnrs base)
+             assert)
+       (prefix (gnu gnunet nse client) #{nse:}#)
+       (gnu gnunet nse struct)
+       (only (gnu gnunet utils bv-slice)
+             slice-length make-slice/read-write)
+       (only (tests utils) call-with-services/fibers)
+       (gnu gnunet netstruct syntactic)
+       (srfi srfi-26)
+       (srfi srfi-43)
+       (srfi srfi-64)
+       (fibers conditions))
+
+(test-begin "network-size")
+
+(define (no-error-handler . e)
+  (pk 'e e)
+  (error "no error handler"))
+
+;; The C implementation of the service requires the client
+;; to sent this message.
+(test-assert "Client sends msg:nse:start"
+  (let* ((start-sent? #f)
+        (start-sent-condition (make-condition))
+        (server-handlers
+         (message-handlers
+          (make-message-handler
+           (symbol-value message-type msg:nse:start)
+           (lambda (p) (p))
+           (lambda (s)
+             (= (slice-length s) 4))
+           (lambda (slice)
+             (assert (not start-sent?))
+             (set! start-sent? #t)
+             (signal-condition! start-sent-condition))))))
+    (call-with-services/fibers
+     `(("nse" . ,(lambda (port spawn-fiber)
+                  (define mq (port->message-queue port server-handlers
+                                                  no-error-handler
+                                                  #:spawn spawn-fiber))
+                  (values))))
+     (lambda (config spawn-fiber)
+       (nse:connect config #:spawn spawn-fiber)
+       (wait start-sent-condition)
+       #t))))
+
+(define %estimates
+  `((0. ,(expt 2.0 0.) 0.1 0)
+    (1. ,(expt 2.0 1.) 0.11 10)
+    (2. ,(expt 2.0 2.) 0.111 100)
+    (3. ,(expt 2.0 3.) 0.1111 1000)))
+
+(define (port->nse-client-message-queue port spawn-fiber)
+  (define h (message-handlers
+            (make-message-handler
+             (symbol-value message-type msg:nse:start)
+             (lambda (p) (p))
+             (lambda (s) (= (slice-length s) 4))
+             (lambda (slice) (values)))))
+  (port->message-queue port h no-error-handler #:spawn spawn-fiber))
+
+(test-equal "Client calls call-back (and sets estimates) in-order"
+  (list %estimates %estimates)
+  (call-with-services/fibers
+   `(("nse" . ,(lambda (port spawn-fiber)
+                (define mq
+                  (port->nse-client-message-queue port spawn-fiber))
+                ;; Send the client a few fake estimates.
+                ;; This code would be incorrect if there were
+                ;; multiple clients!
+                (define (send! estimate)
+                  (define s (make-slice/read-write
+                             (sizeof /:msg:nse:estimate '())))
+                  ;; Set the headers
+                  (set%! /:msg:nse:estimate '(header size) s
+                         (sizeof /:msg:nse:estimate '()))
+                  (set%! /:msg:nse:estimate '(header type) s
+                         (value->index
+                          (symbol-value message-type msg:nse:estimate)))
+                  ;; Set the data
+                  (set%! /:msg:nse:estimate '(timestamp) s
+                         (list-ref estimate 3))
+                  (set%! /:msg:nse:estimate '(size-estimate) s
+                         (list-ref estimate 0))
+                  (set%! /:msg:nse:estimate '(std-deviation) s
+                         (list-ref estimate 2))
+                  ;; Send the estimate
+                  (send-message! mq s))
+                (for-each send! %estimates))))
+   (lambda (config spawn-fiber)
+     (define estimates/update/reverse '())
+     (define estimates/poll/reverse '())
+     (define connected? #f)
+     (define (estimate->list estimate)
+       `(,(nse:estimate:logarithmic-number-peers estimate)
+        ,(nse:estimate:number-peers estimate)
+        ,(nse:estimate:standard-deviation estimate)
+        ,(nse:estimate:timestamp estimate)))
+     (define done (make-condition))
+     (define (updated estimate)
+       (assert connected?)
+       (assert (nse:estimate? estimate))
+       (set! estimates/update/reverse
+            (cons (estimate->list estimate) estimates/update/reverse))
+       (set! estimates/poll/reverse
+            (cons (estimate->list (nse:estimate server))
+                  estimates/poll/reverse))
+       (when (= (length estimates/update/reverse)
+               (length %estimates))
+        (signal-condition! done))
+       (when (> (length estimates/update/reverse)
+               (length %estimates))
+        (error "too many estimates!")))
+     (define (connected)
+       (assert (not connected?))
+       (set! connected? #t))
+     (define server
+       (nse:connect config #:connected connected #:updated updated
+                   #:spawn spawn-fiber))
+     (wait done)
+     (assert connected?)
+     (list (reverse estimates/update/reverse)
+          (reverse estimates/poll/reverse)))))
+
+(test-end "network-size")

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