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

[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 56c7d9a  cadet: Define procedures for messages for opening/closing 
channels.
     new ff71f6e  cadet/network: Add missing module to VC.
     new 260d46b  cadet: Define procedure for /:msg:cadet:local:data.

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:
 gnu/gnunet/cadet/client.scm           | 49 ++++++++++++++++++++++++++++++++---
 gnu/gnunet/{dht => cadet}/network.scm | 29 +++++++++++----------
 tests/cadet.scm                       | 23 ++++++++++++++++
 3 files changed, 84 insertions(+), 17 deletions(-)
 copy gnu/gnunet/{dht => cadet}/network.scm (51%)

diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index d3f267c..d467aa4 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -20,6 +20,7 @@
          make-cadet-address cadet-address? cadet-address-peer 
cadet-address-port
          channel? open-channel! close-channel!
          port? open-port! close-port!
+         %max-cadet-message-size
 
          ;; Network manipulation procedures
          ;; (these belong to (gnu gnunet cadet network)).
@@ -30,12 +31,15 @@
                  (analyse-local-channel-destroy
                   #{ analyse-local-channel-destroy}#)
                  (construct-local-channel-destroy
-                  #{ construct-local-channel-destroy}#)))
+                  #{ construct-local-channel-destroy}#)
+                 (analyse-local-data #{ analyse-local-data}#)
+                 (construct-local-data #{ construct-local-data}#)))
   (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:channel:destroy
+               /:msg:cadet:local:data)
          (only (gnu gnunet crypto struct)
                /peer-identity)
          (only (gnu gnunet concurrency lost-and-found)
@@ -52,14 +56,14 @@
                sizeof select read% set%!)
          (only (gnu gnunet utils bv-slice)
                make-slice/read-write slice-copy/read-only slice-length
-               slice-copy!)
+               slice-copy! slice-slice)
          (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 = define-syntax)
+               case else = define-syntax + expt -)
          (only (rnrs records syntactic) define-record-type)
          (only (ice-9 match) match)
          (only (guile) define*)
@@ -211,6 +215,43 @@ CADET channel with channel number @var{channel-number}."
 @code{/:msg:cadet:local:channel:destroy} message @var{message}."
       (read% /:msg:cadet:local:channel:destroy '(channel-number) message))
 
+    ;; TODO: determine maximum length
+    (define %max-cadet-message-size
+      (- (- (expt 2 16) 1) (sizeof /:msg:cadet:local:data '())))
+
+    ;; would be nice to avoid copying
+    ;; TODO: direction (service->client, client->service?)
+    (define (construct-local-data channel-number priority-preference data)
+      "Create a @code{/:msg:cadet:local:data} message ???"
+      (define header-size (sizeof /:msg:cadet:local:data '()))
+      (define s (make-slice/read-write (+ header-size (slice-length data))))
+      (define header (slice-slice s 0 header-size))
+      (define rest (slice-slice s header-size))
+      (define-syntax set*
+       (cut-syntax set%! /:msg:cadet:local:data <> header <>))
+      (set* '(header size) (slice-length s))
+      (set* '(header type)
+           (value->index
+            (symbol-value message-type msg:cadet:local:data)))
+      (set* '(channel-number) channel-number)
+      (set* '(priority-preference) priority-preference)
+      (slice-copy! data rest)
+      s)
+
+    (define (analyse-local-data message)
+      "Return the channel number, the numeric priority-preference value and 
data
+in the @code{/:msg:cadet:local:data} message @var{message}."
+      (define header
+       (slice-slice message 0 (sizeof /:msg:cadet:local:data '())))
+      (define-syntax read*
+       (cut-syntax read% /:msg:cadet:local:data <> header))
+      (define-syntax select*
+       (cut-syntax select /:msg:cadet:local:data <> header))
+      (values (read* '(channel-number))
+             (read* '(priority-preference))
+             (slice-slice message
+                          (sizeof /:msg:cadet:local:data '()))))
+
     (define (stub . foo)
       (error "todo"))
     (define channel? stub)
diff --git a/gnu/gnunet/dht/network.scm b/gnu/gnunet/cadet/network.scm
similarity index 51%
copy from gnu/gnunet/dht/network.scm
copy to gnu/gnunet/cadet/network.scm
index 79b16fe..31bf849 100644
--- a/gnu/gnunet/dht/network.scm
+++ b/gnu/gnunet/cadet/network.scm
@@ -1,4 +1,4 @@
-;; This file is part of Scheme-GNUnet
+;; This file is part of Scheme-GNUnet.
 ;; Copyright © 2022 GNUnet e.V.
 ;;
 ;; Scheme-GNUnet is free software: you can redistribute it and/or modify it
@@ -15,15 +15,18 @@
 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 ;;
 ;; SPDX-License-Identifier: AGPL-3.0-or-later
-(define-library (gnu gnunet dht network)
-  (export construct-client-get construct-client-put construct-client-result
-         analyse-client-get analyse-client-put analyse-client-result)
-  (import (rename (gnu gnunet dht client)
-                 (#{ construct-client-get}# construct-client-get)
-                 (#{ construct-client-get-stop}# construct-client-get-stop)
-                 (#{ construct-client-put}# construct-client-put)
-                 (#{ construct-client-result}# construct-client-result)
-                 (#{ analyse-client-get}# analyse-client-get)
-                 (#{ analyse-client-get-stop}# analyse-client-get-stop)
-                 (#{ analyse-client-put}# analyse-client-put)
-                 (#{ analyse-client-result}# analyse-client-result))))
+(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)
+  (import (rename (gnu gnunet cadet client)
+                 (#{ construct-local-channel-create}#
+                  construct-local-channel-create)
+                 (#{ analyse-local-channel-create}#
+                  analyse-local-channel-create)
+                 (#{ construct-local-channel-destroy}#
+                  construct-local-channel-destroy)
+                 (#{ analyse-local-channel-destroy}#
+                  analyse-local-channel-destroy)
+                 (#{ construct-local-data}# construct-local-data)
+                 (#{ analyse-local-data}# analyse-local-data))))
diff --git a/tests/cadet.scm b/tests/cadet.scm
index e9dbc37..3bbaf1e 100644
--- a/tests/cadet.scm
+++ b/tests/cadet.scm
@@ -23,6 +23,7 @@
        (gnu gnunet crypto struct)
        (gnu gnunet hashcode struct)
        (rnrs bytevectors)
+       (ice-9 match)
        (srfi srfi-8)
        (srfi srfi-64)
        (tests utils)
@@ -115,6 +116,9 @@
 (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))
+(define $priority-preference ($integer-in-range 0 (- (expt 2 32) 1)))
+;; 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
@@ -135,6 +139,25 @@
             (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))))))
+
 ;; header information will be tested elsewhere (TODO)
 
 (test-end "CADET")

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