[gnunet-scheme] branch master updated (4e2ec50 -> 56c7d9a)

[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 4e2ec50  server: Add missing file to VC.
     new 3dc59d8  cadet/struct: Correct typo.
     new 56c7d9a  cadet: Define procedures for messages for opening/closing 
channels.

The 2 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:
 Makefile.am                 |  1 +
 gnu/gnunet/cadet/client.scm | 87 ++++++++++++++++++++++++++++++++++++++++++---
 gnu/gnunet/cadet/struct.scm |  2 +-
 tests/cadet.scm             | 53 ++++++++++++++++++++++++++-
 4 files changed, 136 insertions(+), 7 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index 3f19001..2346ed3 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -68,6 +68,7 @@ modules = \
   gnu/gnunet/block.scm \
   \
   gnu/gnunet/cadet/client.scm \
+  gnu/gnunet/cadet/network.scm \
   gnu/gnunet/cadet/struct.scm \
   \
   gnu/gnunet/config/parser.scm \
diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index f863d49..d3f267c 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -19,8 +19,24 @@
   (export connect disconnect!
          make-cadet-address cadet-address? cadet-address-peer 
cadet-address-port
          channel? open-channel! close-channel!
-         port? open-port! close-port!)
-  (import (only (gnu gnunet crypto struct)
+         port? open-port! close-port!
+
+         ;; Network manipulation procedures
+         ;; (these belong to (gnu gnunet cadet network)).
+         (rename (analyse-local-channel-create
+                  #{ analyse-local-channel-create}#)
+                 (construct-local-channel-create
+                  #{ construct-local-channel-create}#)
+                 (analyse-local-channel-destroy
+                  #{ analyse-local-channel-destroy}#)
+                 (construct-local-channel-destroy
+                  #{ construct-local-channel-destroy}#)))
+  (import (only (gnu extractor enum)
+               value->index symbol-value)
+         (only (gnu gnunet cadet struct)
+               /:msg:cadet:local:channel:create
+               /:msg:cadet:local:channel:destroy)
+         (only (gnu gnunet crypto struct)
                /peer-identity)
          (only (gnu gnunet concurrency lost-and-found)
                make-lost-and-found collect-lost-and-found-operation)
@@ -30,14 +46,20 @@
                maybe-send-control-message!* make-error-handler)
          (only (gnu gnunet hashcode struct)
                /hashcode:512)
+         (only (gnu gnunet message protocols) message-type)
          (only (gnu gnunet mq-impl stream) connect/fibers)
          (only (gnu gnunet netstruct syntactic)
-               sizeof)
+               sizeof select read% set%!)
          (only (gnu gnunet utils bv-slice)
-               slice-copy/read-only slice-length)
+               make-slice/read-write slice-copy/read-only slice-length
+               slice-copy!)
+         (only (gnu gnunet utils cut-syntax)
+               cut-syntax)
+         (only (gnu gnunet utils hat-let)
+               let^)
          (only (rnrs base)
                begin define lambda assert quote cons apply values
-               case else =)
+               case else = define-syntax)
          (only (rnrs records syntactic) define-record-type)
          (only (ice-9 match) match)
          (only (guile) define*)
@@ -134,6 +156,61 @@ do not have any impact on the cadet address."
                    (%make (slice-copy/read-only peer)
                           (slice-copy/read-only port))))))
 
+    (define* (construct-local-channel-create cadet-address channel-number
+                                            #:optional (options 0))
+      "Create a new @code{/:msg:cadet:channel:create} message for contacting
+the CADET addresss @var{cadet-address}, using the channel number
+@var{channel-number} and options @var{options}."
+      (define s
+       (make-slice/read-write (sizeof /:msg:cadet:local:channel:create '())))
+      (define-syntax set*
+       (cut-syntax set%! /:msg:cadet:local:channel:create <> s <>))
+      (define-syntax select*
+       (cut-syntax select /:msg:cadet:local:channel:create <> s))
+      (set* '(header size) (slice-length s))
+      (set* '(header type)
+           (value->index
+            (symbol-value message-type msg:cadet:local:channel:create)))
+      (set* '(channel-number) channel-number)
+      (slice-copy! (cadet-address-peer cadet-address) (select* '(peer)))
+      (slice-copy! (cadet-address-port cadet-address) (select* '(port)))
+      (set* '(options) options)
+      s)
+
+    (define (analyse-local-channel-create message)
+      "Return the CADET address, channel number and options corresponding to
+the @code{/:msg:cadet:channel:create} message @var{message}."
+      (define-syntax read*
+       (cut-syntax read% /:msg:cadet:local:channel:create <> message))
+      (define-syntax select*
+       (cut-syntax select /:msg:cadet:local:channel:create <> message))
+      (let^ ((! channel-number (read* '(channel-number)))
+            (! peer (select* '(peer)))
+            (! port (select* '(port)))
+            (! channel-number (read* '(channel-number)))
+            (! options (read* '(options)))
+            (! address (make-cadet-address peer port)))
+           (values address channel-number options)))
+
+    (define (construct-local-channel-destroy channel-number)
+      "Create a @code{/:msg:cadet:channel:destroy} message for closing the
+CADET channel with channel number @var{channel-number}."
+      (define s
+       (make-slice/read-write (sizeof /:msg:cadet:local:channel:destroy '())))
+      (define-syntax set*
+       (cut-syntax set%! /:msg:cadet:local:channel:destroy <> s <>))
+      (set* '(header size) (slice-length s))
+      (set* '(header type)
+           (value->index
+            (symbol-value message-type msg:cadet:local:channel:destroy)))
+      (set* '(channel-number) channel-number)
+      s)
+
+    (define (analyse-local-channel-destroy message)
+      "Return the channel number corresponding to the
+@code{/:msg:cadet:local:channel:destroy} message @var{message}."
+      (read% /:msg:cadet:local:channel:destroy '(channel-number) message))
+
     (define (stub . foo)
       (error "todo"))
     (define channel? stub)
diff --git a/gnu/gnunet/cadet/struct.scm b/gnu/gnunet/cadet/struct.scm
index cef257b..22c061c 100644
--- a/gnu/gnunet/cadet/struct.scm
+++ b/gnu/gnunet/cadet/struct.scm
@@ -51,7 +51,7 @@
     (define-type /:msg:cadet:port
       (structure/packed
        (synopsis
-       "Message from a client to the service, to create or destory a channel")
+       "Message from a client to the service, to create or destroy a port")
        (properties '((message-symbol msg:cadet:local:port:open
                                     msg:cadet:local:port:close)
                     (c-type . GNUNET_CADET_PortMessage)))
diff --git a/tests/cadet.scm b/tests/cadet.scm
index 5a395cc..e9dbc37 100644
--- a/tests/cadet.scm
+++ b/tests/cadet.scm
@@ -17,13 +17,19 @@
 ;; SPDX-License-Identifier: AGPL-3.0-or-later
 (define-module (test-distributed-hash-table))
 (import (gnu gnunet cadet client)
+       (gnu gnunet cadet network)
        (gnu gnunet utils bv-slice)
        (gnu gnunet netstruct syntactic)
        (gnu gnunet crypto struct)
        (gnu gnunet hashcode struct)
        (rnrs bytevectors)
+       (srfi srfi-8)
        (srfi srfi-64)
-       (tests utils))
+       (tests utils)
+       (quickcheck)
+       (quickcheck property)
+       (quickcheck generator)
+       (quickcheck arbitrary))
 
 (test-begin "CADET")
 (test-assert "(CADET) close, not connected --> all fibers stop, no callbacks 
called"
@@ -86,4 +92,49 @@
   (make-cadet-address (slice-copy/read-only %peer-identity)
                      (slice-copy/read-only %port)))
 
+;; TODO: integrate in guile-quickcheck, (tests utils)
+(define ($integer-in-range lower upper)
+  (arbitrary
+   (gen (choose-integer lower upper))
+   (xform #false)))
+(define ($sized-bytevector size)
+  (arbitrary
+   (gen (choose-bytevector size))
+   (xform #false)))
+(define ($arbitrary-lift f . a)
+  (arbitrary
+   (gen (apply generator-lift f (map arbitrary-gen a)))
+   (xform #false))) ; TODO
+(define ($sized-bytevector-slice/read-write size)
+  ($arbitrary-lift bv-slice/read-write ($sized-bytevector size)))
+(define ($sized-bytevector-slice/read-only size)
+  ($arbitrary-lift slice/read-only ($sized-bytevector-slice/read-write size)))
+
+(define $channel-number ($integer-in-range 0 (- (expt 2 32) 1)))
+(define $peer ($sized-bytevector-slice/read-only (sizeof /peer-identity '())))
+(define $port ($sized-bytevector-slice/read-only (sizeof /hashcode:512 '())))
+(define $options ($integer-in-range 0 (- (expt 2 32) 1)))
+(define $cadet-address ($arbitrary-lift make-cadet-address $peer $port))
+
+(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))))))
+;; header information will be tested elsewhere (TODO)
+
 (test-end "CADET")

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