[gnunet-scheme] branch master updated (260d46b -> b643d2a)

[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 260d46b  cadet: Define procedure for /:msg:cadet:local:data.
     new dddeb6f  cadet/struct: Improve documentation of 
/:msg:cadet:local:acknowledgement.
     new ba837c7  tests/cadet: Unify analyse+construct tests.
     new a4e991a  cadet: Define procedures for 
/:msg:cadet:local:acknowledgement.
     new b643d2a  tests/cadet: Test read-writability.

The 4 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:
 gnu/gnunet/cadet/client.scm  | 29 ++++++++++++++++--
 gnu/gnunet/cadet/network.scm |  9 ++++--
 gnu/gnunet/cadet/struct.scm  |  4 +--
 tests/cadet.scm              | 73 ++++++++++++++++++++++----------------------
 4 files changed, 72 insertions(+), 43 deletions(-)

diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index d467aa4..d14fe66 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -33,13 +33,18 @@
                  (construct-local-channel-destroy
                   #{ construct-local-channel-destroy}#)
                  (analyse-local-data #{ analyse-local-data}#)
-                 (construct-local-data #{ construct-local-data}#)))
+                 (construct-local-data #{ construct-local-data}#)
+                 (analyse-local-acknowledgement
+                  #{ analyse-local-acknowledgement}#)
+                 (construct-local-acknowledgement
+                  #{ construct-local-acknowledgement}#)))
   (import (only (gnu extractor enum)
                value->index symbol-value)
          (only (gnu gnunet cadet struct)
                /:msg:cadet:local:channel:create
                /:msg:cadet:local:channel:destroy
-               /:msg:cadet:local:data)
+               /:msg:cadet:local:data
+               /:msg:cadet:local:acknowledgement)
          (only (gnu gnunet crypto struct)
                /peer-identity)
          (only (gnu gnunet concurrency lost-and-found)
@@ -252,6 +257,26 @@ in the @code{/:msg:cadet:local:data} message 
@var{message}."
              (slice-slice message
                           (sizeof /:msg:cadet:local:data '()))))
 
+    (define (construct-local-acknowledgement channel-number)
+      "Create a @code{/:msg:cadet:local:acknowledgement} message,
+to inform the client that more data can be sent across the channel
+identified by @var{channel-number}."
+      (define s
+       (make-slice/read-write (sizeof /:msg:cadet:local:acknowledgement '())))
+      (define-syntax set*
+       (cut-syntax set%! /:msg:cadet:local:acknowledgement <> s <>))
+      (set* '(header size) (slice-length s))
+      (set* '(header type)
+           (value->index
+            (symbol-value message-type msg:cadet:local:acknowledgement)))
+      (set* '(client-channel-number) channel-number)
+      s)
+
+    (define (analyse-local-acknowledgement message)
+      "Return the channel number in the @code{/:msg:cadet:local:data}
+message @var{message}."
+      (read% /:msg:cadet:local:acknowledgement '(client-channel-number) 
message))
+
     (define (stub . foo)
       (error "todo"))
     (define channel? stub)
diff --git a/gnu/gnunet/cadet/network.scm b/gnu/gnunet/cadet/network.scm
index 31bf849..9e51482 100644
--- a/gnu/gnunet/cadet/network.scm
+++ b/gnu/gnunet/cadet/network.scm
@@ -18,7 +18,8 @@
 (define-library (gnu gnunet cadet network)
   (export construct-local-channel-create analyse-local-channel-create
          construct-local-channel-destroy analyse-local-channel-destroy
-         construct-local-data analyse-local-data)
+         construct-local-data analyse-local-data
+         construct-local-acknowledgement analyse-local-acknowledgement)
   (import (rename (gnu gnunet cadet client)
                  (#{ construct-local-channel-create}#
                   construct-local-channel-create)
@@ -29,4 +30,8 @@
                  (#{ analyse-local-channel-destroy}#
                   analyse-local-channel-destroy)
                  (#{ construct-local-data}# construct-local-data)
-                 (#{ analyse-local-data}# analyse-local-data))))
+                 (#{ analyse-local-data}# analyse-local-data)
+                 (#{ construct-local-acknowledgement}#
+                  construct-local-acknowledgement)
+                 (#{ analyse-local-acknowledgement}#
+                  analyse-local-acknowledgement))))
diff --git a/gnu/gnunet/cadet/struct.scm b/gnu/gnunet/cadet/struct.scm
index 22c061c..8c851b6 100644
--- a/gnu/gnunet/cadet/struct.scm
+++ b/gnu/gnunet/cadet/struct.scm
@@ -99,8 +99,8 @@
 
     (define-type /:msg:cadet:local:acknowledgement
       (structure/packed
-       (synopsis "Mesage to allow the client to send more data to the service \
-(service -> client)")
+       (synopsis "Message sent from the service to the client, to inform the
+client that more data can be sent across a channel.")
        (properties '((c-type . GNUNET_CADET_LocalAck)
                     (message-symbol . msg:cadet:local:acknowledgement)))
        (field (header /:message-header))
diff --git a/tests/cadet.scm b/tests/cadet.scm
index 3bbaf1e..9eaae2c 100644
--- a/tests/cadet.scm
+++ b/tests/cadet.scm
@@ -19,6 +19,7 @@
 (import (gnu gnunet cadet client)
        (gnu gnunet cadet network)
        (gnu gnunet utils bv-slice)
+       (gnu gnunet utils hat-let)
        (gnu gnunet netstruct syntactic)
        (gnu gnunet crypto struct)
        (gnu gnunet hashcode struct)
@@ -120,43 +121,41 @@
 ;; Actual sizes can be a lot larger
 (define $cadet-data ($sized-bytevector-slice/read-only 500))
 
-(test-assert "analyse + construct round-trips (local-channel-create)"
-  (quickcheck
-   (property ((channel-number $channel-number)
-             (cadet-address $cadet-address)
-             (options $options))
-            (receive (cadet-address* channel-number* options*)
-                (analyse-local-channel-create
-                 (construct-local-channel-create
-                  cadet-address channel-number  options))
-              (and (equal? channel-number channel-number*)
-                   (equal? cadet-address cadet-address*)
-                   (equal? options options*))))))
-
-(test-assert "analyse + construct round-trips (local-channel-destroy)"
-  (quickcheck
-   (property ((channel-number $channel-number))
-            (equal? channel-number
-                    (analyse-local-channel-destroy
-                     (construct-local-channel-destroy channel-number))))))
-
-(define (analyse-local-data* . foo)
-  (define (fix . stuff)
-    (map (match-lambda
-          ((? slice? s) (slice-copy/read-only s))
-          (foo foo))
-        stuff))
-  (call-with-values (lambda () (apply analyse-local-data foo)) fix))
-
-(test-assert "analyse + construct round-trips (local-data)"
-  (quickcheck
-   (property ((channel-number $channel-number)
-             (priority-preference $priority-preference)
-             (data $cadet-data))
-            (equal? (list channel-number priority-preference data)
-                    (analyse-local-data*
-                     (construct-local-data
-                      channel-number priority-preference data))))))
+(define (normalise list)
+  (map (match-lambda
+        ((? slice? s) (slice-copy/read-only s))
+        (foo foo))
+       list))
+
+(define-syntax-rule
+  (test-roundtrip testcase analyse construct (name $arbitrary) ...)
+  (test-assert testcase
+    (quickcheck
+     (property ((name $arbitrary) ...)
+              (let^ ((! expected (pk 'e (list name ...)))
+                     (! constructed (construct name ...))
+                     (<-- analysed (analyse constructed))
+                     (! analysed (normalise analysed)))
+                    (and (slice-readable? constructed)
+                         (slice-writable? constructed)
+                         (equal? expected analysed)))))))
+
+(test-roundtrip "analyse + construct round-trips (local-channel-create)"
+               analyse-local-channel-create construct-local-channel-create
+               (cadet-address $cadet-address)
+               (channel-number $channel-number)
+               (options $options))
+(test-roundtrip "analyse + construct round-trips (local-channel-destroy)"
+               analyse-local-channel-destroy construct-local-channel-destroy
+               (channel-number $channel-number))
+(test-roundtrip "analyse + construct round-trips (local-data)"
+               analyse-local-data construct-local-data
+               (channel-number $channel-number)
+               (priority-preference $priority-preference)
+               (data $cadet-data))
+(test-roundtrip "analyse + construct round-tripes (local-acknowledgement)"
+               analyse-local-acknowledgement construct-local-acknowledgement
+               (channel-number $channel-number))
 
 ;; header information will be tested elsewhere (TODO)
 

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