[gnunet-scheme] 03/03: cadet/client: Define the record type for CADET addresses.

[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 079243f8c8a9616dbf160554c3aa6cd517f1cd04
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Feb 22 19:33:48 2022 +0000

    cadet/client: Define the record type for CADET addresses.
    
    * gnu/gnunet/cadet/client.scm (<cadet-address>): Unstub record type.
    * tests/cadet.scm (%peer-identity,%port): New variables.
      ("cadet-address?")
      ("cadet-address, deconstruct")
      ("cadet-address, wrong peer identity size (1)")
      ("cadet-address, wrong peer identity size (2)")
      ("cadet-address, wrong peer identity size (3)")
      ("cadet-address, wrong port size (1)")
      ("cadet-address, wrong port size (2)")
      ("cadet-address, wrong port size (3)")
      ("cadet-address, read-only port")
      ("cadet-address, read-only peer")
      ("cadet-address, independent slices")
      ("cadet-address, equal?"): New tests.
---
 gnu/gnunet/cadet/client.scm | 31 ++++++++++++++++++-----
 tests/cadet.scm             | 61 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 86 insertions(+), 6 deletions(-)

diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index ab57e8b..f863d49 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -20,16 +20,24 @@
          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 concurrency lost-and-found)
+  (import (only (gnu gnunet crypto struct)
+               /peer-identity)
+         (only (gnu gnunet concurrency lost-and-found)
                make-lost-and-found collect-lost-and-found-operation)
          (only (gnu gnunet mq handler) message-handlers)
          (only (gnu gnunet mq) close-queue!)
          (only (gnu gnunet server)
                maybe-send-control-message!* make-error-handler)
+         (only (gnu gnunet hashcode struct)
+               /hashcode:512)
          (only (gnu gnunet mq-impl stream) connect/fibers)
+         (only (gnu gnunet netstruct syntactic)
+               sizeof)
+         (only (gnu gnunet utils bv-slice)
+               slice-copy/read-only slice-length)
          (only (rnrs base)
                begin define lambda assert quote cons apply values
-               case else)
+               case else =)
          (only (rnrs records syntactic) define-record-type)
          (only (ice-9 match) match)
          (only (guile) define*)
@@ -111,12 +119,23 @@
       ;; Start the main event loop.
       (control))
 
+    (define-record-type (<cadet-address> make-cadet-address cadet-address?)
+      (fields (immutable peer cadet-address-peer)
+             (immutable port cadet-address-port))
+      (protocol (lambda (%make)
+                 "Make a CADET address for contacting the peer @var{peer}
+(a readable bytevector slice containing a @code{/peer-identity}) at port
+@var{port} (a readable bytevector slice containing a @code{/hashcode:512}).
+The slices @var{peer} and @var{port} are copied, so future changes to them
+do not have any impact on the cadet address."
+                 (lambda (peer port)
+                   (assert (= (sizeof /peer-identity '()) (slice-length peer)))
+                   (assert (= (sizeof /hashcode:512 '()) (slice-length port)))
+                   (%make (slice-copy/read-only peer)
+                          (slice-copy/read-only port))))))
+
     (define (stub . foo)
       (error "todo"))
-    (define make-cadet-address stub)
-    (define cadet-address? stub)
-    (define cadet-address-peer stub)
-    (define cadet-address-port stub)
     (define channel? stub)
     (define open-channel! stub)
     (define close-channel! stub)
diff --git a/tests/cadet.scm b/tests/cadet.scm
index b509ccf..5a395cc 100644
--- a/tests/cadet.scm
+++ b/tests/cadet.scm
@@ -17,6 +17,11 @@
 ;; SPDX-License-Identifier: AGPL-3.0-or-later
 (define-module (test-distributed-hash-table))
 (import (gnu gnunet cadet client)
+       (gnu gnunet utils bv-slice)
+       (gnu gnunet netstruct syntactic)
+       (gnu gnunet crypto struct)
+       (gnu gnunet hashcode struct)
+       (rnrs bytevectors)
        (srfi srfi-64)
        (tests utils))
 
@@ -25,4 +30,60 @@
   (close-not-connected-no-fallbacks "cadet" connect disconnect!))
 (test-assert "(CADET) garbage collectable"
   (garbage-collectable "cadet" connect))
+
+(define %peer-identity
+  (bv-slice/read-write (u8-list->bytevector (iota (sizeof /peer-identity 
'())))))
+(define %port
+  (bv-slice/read-write
+   (u8-list->bytevector (map (lambda (x) (- 255 x))
+                            (iota (sizeof /hashcode:512 '()))))))
+(test-assert "cadet-address?"
+  (and (cadet-address? (make-cadet-address %peer-identity %port))
+       (not (cadet-address? 'foobar))))
+
+(test-equal "cadet-address, deconstruct"
+  '(#true #true)
+  (let ((cadet (make-cadet-address %peer-identity %port)))
+    ;; TODO: extend 'bytevector=?' to accept ranges, then define
+    ;; 'slice=?'.
+    (list (equal? (cadet-address-peer cadet) (slice/read-only %peer-identity))
+         (equal? (cadet-address-port cadet) (slice/read-only %port)))))
+
+(test-error "cadet-address, wrong peer identity size (1)" #f
+           (make-cadet-address (make-slice/read-write 0) %port))
+(test-error "cadet-address, wrong peer identity size (2)" #f
+           (make-cadet-address
+            (make-slice/read-write (- (sizeof /peer-identity '()) 1)) %port))
+(test-error "cadet-address, wrong peer identity size (3)" #f
+           (make-cadet-address
+            (make-slice/read-write (+ (sizeof /peer-identity '()) 1)) %port))
+
+(test-error "cadet-address, wrong port size (1)" #f
+           (make-cadet-address %peer-identity (make-slice/read-write 0)))
+(test-error "cadet-address, wrong port size (2)" #f
+           (make-cadet-address
+            %peer-identity
+            (make-slice/read-write (- (sizeof /hashcode:512 '()) 1))))
+(test-error "cadet-address, wrong port size (3)" #f
+           (make-cadet-address
+            %peer-identity
+            (make-slice/read-write (+ (sizeof /hashcode:512 '()) 1))))
+
+(test-assert "cadet-address, read-only port"
+  (let ((slice (cadet-address-port (make-cadet-address %peer-identity %port))))
+    (and (slice-readable? slice) (not (slice-writable? slice)))))
+(test-assert "cadet-address, read-only peer"
+  (let ((slice (cadet-address-peer (make-cadet-address %peer-identity %port))))
+    (and (slice-readable? slice) (not (slice-writable? slice)))))
+
+(test-assert "cadet-address, independent slices"
+  (let ((struct (make-cadet-address %peer-identity %port)))
+    (and (slice-independent? %peer-identity (cadet-address-peer struct))
+        (slice-independent? %port (cadet-address-port struct)))))
+
+(test-equal "cadet-address, equal?"
+  (make-cadet-address %peer-identity %port)
+  (make-cadet-address (slice-copy/read-only %peer-identity)
+                     (slice-copy/read-only %port)))
+
 (test-end "CADET")

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