[gnunet-scheme] 02/02: cadet: Define procedure for /:msg:cadet:local:data.

[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 260d46b2bce9ff6394ac133bafbb88cf1fd424ae
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Feb 26 13:26:40 2022 +0000

    cadet: Define procedure for /:msg:cadet:local:data.
    
    * gnu/gnunet/cadet/client.scm
      (analyse-local-data,construct-local-data): New procedures.
    * gnu/gnunet/cadet/network.scm
      (analyse-local-data,construct-local-data): Export new procedures.
    * tests/cadet.scm
      ("analyse + construct round-trips (local-data)"): Test new procedures.
      ($priority-preference,analyse-local-data*): New variables for tests.
---
 gnu/gnunet/cadet/client.scm  | 49 ++++++++++++++++++++++++++++++++++++++++----
 gnu/gnunet/cadet/network.scm |  7 +++++--
 tests/cadet.scm              | 23 +++++++++++++++++++++
 3 files changed, 73 insertions(+), 6 deletions(-)

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/cadet/network.scm b/gnu/gnunet/cadet/network.scm
index 3a2574f..31bf849 100644
--- a/gnu/gnunet/cadet/network.scm
+++ b/gnu/gnunet/cadet/network.scm
@@ -17,7 +17,8 @@
 ;; SPDX-License-Identifier: AGPL-3.0-or-later
 (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-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)
@@ -26,4 +27,6 @@
                  (#{ construct-local-channel-destroy}#
                   construct-local-channel-destroy)
                  (#{ analyse-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.