[gnunet-scheme] branch master updated (0ea9aa3 -> 8e9c3b8)

[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 0ea9aa3  fs/network: Define analyse-request-loc-signature.
     new 9878b98  Define arbitraries for generating bytevector slices.
     new bfd1b62  bv-slice-quickcheck: Implement xform.
     new 4894576  doc/bytevector-slices: Fix tenses.
     new 2eb02d8  Define arbitraries for generating hashcodes.
     new a6c2888  hashcode/quickcheck: Fix use of 
$sized-bytevector-slice/read-only.
     new 690f46e  fs/quickcheck: Define arbitraries for generating FS 
structures.
     new 776477a  fs/quickcheck: Correct module name.
     new 7b3097f  Extract test-roundtrip from tests/cadet.
     new 8e9c3b8  tests/file-sharing: Test request-loc-signature round-tripping.

The 9 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                                        |  3 ++
 doc/bytevector-slices.tm                           | 20 ++++++++++
 doc/scheme-gnunet.tm                               | 10 +++++
 .../gnunet/fs/quickcheck.scm                       | 34 ++++++++--------
 gnu/gnunet/hashcode/quickcheck.scm                 | 42 ++++++++++++++++++++
 gnu/gnunet/utils/bv-slice-quickcheck.scm           | 46 ++++++++++++++++++++++
 tests/cadet.scm                                    | 26 +++---------
 tests/file-sharing.scm                             | 36 ++++++++++++++++-
 tests/utils.scm                                    | 41 ++++++++++++++++++-
 9 files changed, 219 insertions(+), 39 deletions(-)
 copy tests/file-sharing.scm => gnu/gnunet/fs/quickcheck.scm (54%)
 create mode 100644 gnu/gnunet/hashcode/quickcheck.scm
 create mode 100644 gnu/gnunet/utils/bv-slice-quickcheck.scm

diff --git a/Makefile.am b/Makefile.am
index 05b5bf4..1c9fbe3 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -51,6 +51,7 @@ modules = \
   \
   gnu/gnunet/data-string.scm \
   gnu/gnunet/hashcode.scm \
+  gnu/gnunet/hashcode/quickcheck.scm \
   \
   gnu/gnunet/mq/envelope.scm \
   gnu/gnunet/mq/error-reporting.scm \
@@ -62,6 +63,7 @@ modules = \
   gnu/gnunet/mq-impl/stream.scm \
   \
   gnu/gnunet/utils/bv-slice.scm \
+  gnu/gnunet/utils/bv-slice-quickcheck.scm \
   gnu/gnunet/utils/hat-let.scm \
   gnu/gnunet/utils/cut-syntax.scm \
   gnu/gnunet/utils/netstruct.scm \
@@ -91,6 +93,7 @@ modules = \
   gnu/gnunet/fs/network.scm \
   gnu/gnunet/fs/struct.scm \
   gnu/gnunet/fs/uri.scm \
+  gnu/gnunet/fs/quickcheck.scm \
   \
   gnu/gnunet/util/cmsg.scm \
   gnu/gnunet/util/time.scm \
diff --git a/doc/bytevector-slices.tm b/doc/bytevector-slices.tm
index ca001bc..5b1019f 100644
--- a/doc/bytevector-slices.tm
+++ b/doc/bytevector-slices.tm
@@ -185,6 +185,26 @@
   <scm|&missing-capabilities> exception is raised. Likewise,
   <scm|slice-X-set!> requires the slice to be writable. Both require the part
   of the slice that is being read to be in-bounds.
+
+  <section|Quickcheck integration>
+
+  The module <scm|(gnu gnunet utils bv-slice-quickcheck)><index|(gnu gnunet
+  utils bv-slice-quickcheck)> defines a few <em|arbitraries> for use with
+  Guile-Quickcheck:
+
+  <\explain>
+    <scm|($sized-bytevector-slice/read-write
+    <var|size>)><index|$sized-bytevector-slice/read-write>
+  </explain|Arbitrary generating fresh read-write bytevector slices
+  consisting of <var|size> octets.>
+
+  <\explain>
+    <scm|($sized-bytevector-slice/read-only
+    <var|size>)><index|$sized-bytevector-slice/read-only>
+  </explain|Arbitrary generating fresh read-only bytevector slices consisting
+  of <var|size> octets.>
+
+  \ <todo|rename>
 </body>
 
 <\initial>
diff --git a/doc/scheme-gnunet.tm b/doc/scheme-gnunet.tm
index 5ef0851..9816852 100644
--- a/doc/scheme-gnunet.tm
+++ b/doc/scheme-gnunet.tm
@@ -399,6 +399,16 @@
   <var|slice> is not mutated. However, this imposes a small cost, as
   <var|slice> will then be copied behind the scenes.>
 
+  The module <scm|(gnu gnunet hashcode quickcheck)><index|(gnu gnunet
+  hashcode quickcheck)> defines a few <em|arbitraries> for use with
+  Guile-Quickcheck:
+
+  <\explain>
+    <scm|$hashcode:512><index|$hashcode:512>,
+    <scm|$hashcode:256><index|$hashcode:256>
+  </explain|Arbitraries generating hashcode:512 and hashcode:256
+  respectively.>
+
   <include|bytevector-slices.tm>
 
   <appendix|GNU Free Documentation License>
diff --git a/tests/file-sharing.scm b/gnu/gnunet/fs/quickcheck.scm
similarity index 54%
copy from tests/file-sharing.scm
copy to gnu/gnunet/fs/quickcheck.scm
index 986db6c..c7e1b4d 100644
--- a/tests/file-sharing.scm
+++ b/gnu/gnunet/fs/quickcheck.scm
@@ -15,20 +15,22 @@
 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 ;;
 ;; SPDX-License-Identifier: AGPL-3.0-or-later
-(define-module (test-file-sharing))
-(import (gnu gnunet fs client)
-       (srfi srfi-64)
-       (tests utils))
 
-(test-begin "file-sharing")
-
-;; Standard tests
-(test-assert "close, not connected --> all fibers stop, no callbacks called"
-  (close-not-connected-no-callbacks "fs" (pk connect) disconnect!))
-(test-assert "garbage collectable"
-  (garbage-collectable "fs" connect))
-(test-assert "notify disconnected after end-of-file, after 'connected'"
-  (disconnect-after-eof-after-connected "fs" connect))
-(test-assert "reconnects"
-  (reconnects "fs" connect))
-(test-end "file-sharing")
+(define-library (gnu gnunet fs quickcheck)
+  (export $content-hash-key $chk-uri)
+  (import (only (rnrs base) begin define)
+         (only (quickcheck arbitrary) $record $natural)
+         (only (gnu gnunet fs uri)
+               make-chk chk-key chk-query
+               make-chk-uri chk-uri-file-length chk-uri-chk)
+         (only (gnu gnunet hashcode quickcheck) $hashcode:512))
+  (begin
+    (define $content-hash-key
+      ($record make-chk (chk-key $hashcode:512) (chk-query $hashcode:512)))
+
+    ;; Can produce some impossible chk URIs, e.g. multiple
+    ;; chk URIs for length=0.
+    (define $chk-uri
+      ($record make-chk-uri
+              (chk-uri-file-length $natural) ; TODO: bounds
+              (chk-uri-chk $content-hash-key)))))
diff --git a/gnu/gnunet/hashcode/quickcheck.scm 
b/gnu/gnunet/hashcode/quickcheck.scm
new file mode 100644
index 0000000..d254a7d
--- /dev/null
+++ b/gnu/gnunet/hashcode/quickcheck.scm
@@ -0,0 +1,42 @@
+;#!r6rs
+;;   This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
+;;   Copyright © 2022 GNUnet e.V.
+;;
+;;   scheme-GNUnet is free software: you can redistribute it and/or modify it
+;;   under the terms of the GNU Affero General Public License as published
+;;   by the Free Software Foundation, either version 3 of the License,
+;;   or (at your option) any later version.
+;;
+;;   scheme-GNUnet is distributed in the hope that it will be useful, but
+;;   WITHOUT ANY WARRANTY; without even the implied warranty of
+;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;   Affero General Public License for more details.
+;;
+;;   You should have received a copy of the GNU Affero General Public License
+;;   along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;;   SPDX-License-Identifier: AGPL-3.0-or-later
+(define-library (gnu gnunet hashcode quickcheck)
+  (import (only (rnrs base) begin define)
+         (only (quickcheck arbitrary)
+               arbitrary $record)
+         (only (gnu gnunet hashcode)
+               make-hashcode:512/share make-hashcode:256/share
+               hashcode:512->slice hashcode:256->slice
+               hashcode:512-u8-length hashcode:256-u8-length)
+         (only (gnu gnunet utils bv-slice-quickcheck)
+               $sized-bytevector-slice/read-only))
+  (export $hashcode:512 $hashcode:256)
+  (begin
+    ;; TODO: give '000...' more weight
+    ;; (is it used as a special value somewhere?).
+    ;;
+    ;; The unshared variant would work too, but is less efficient.
+    (define $hashcode:512
+      ($record make-hashcode:512/share
+              (hashcode:512->slice
+               ($sized-bytevector-slice/read-only hashcode:512-u8-length))))
+    (define $hashcode:256
+      ($record make-hashcode:256/share
+              (hashcode:256->slice
+               ($sized-bytevector-slice/read-only hashcode:256-u8-length))))))
diff --git a/gnu/gnunet/utils/bv-slice-quickcheck.scm 
b/gnu/gnunet/utils/bv-slice-quickcheck.scm
new file mode 100644
index 0000000..d6b7069
--- /dev/null
+++ b/gnu/gnunet/utils/bv-slice-quickcheck.scm
@@ -0,0 +1,46 @@
+;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
+;; Copyright © 2022 GNUnet e.V.
+;;
+;; scheme-GNUnet is free software: you can redistribute it and/or modify it
+;; under the terms of the GNU Affero General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; scheme-GNUnet is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Affero General Public License for more details.
+;;
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; SPDX-License-Identifier: AGPL-3.0-or-later
+
+;; Arbitraries for bytevector slices (incomplete).
+;; TODO rename.
+(define-library (gnu gnunet utils bv-slice-quickcheck)
+  (export $sized-bytevector-slice/read-write
+         $sized-bytevector-slice/read-only)
+  (import (only (rnrs base) define begin)
+         (only (quickcheck arbitrary)
+               arbitrary arbitrary-xform $bytevector $record)
+         (only (quickcheck generator) choose-bytevector)
+         (only (gnu gnunet utils bv-slice)
+               bv-slice/read-write bv-slice/read-only slice-copy/bytevector))
+  (begin
+    ;; TODO upstream
+    (define ($sized-bytevector size)
+      (arbitrary
+       (gen (choose-bytevector size))
+       (xform (arbitrary-xform $bytevector))))
+
+    (define ($sized-bytevector-slice/read-write size)
+      "Arbitrary fresh read-write bytevector slices of @var{size} octets."
+      ($record bv-slice/read-write
+              (slice-copy/bytevector ($sized-bytevector size))))
+
+    (define ($sized-bytevector-slice/read-only size)
+      "Arbitrary read-only bytevector slices of @var{size} octets."
+      ;; Currently fresh, but not guaranteed.
+      ($record bv-slice/read-only
+              (slice-copy/bytevector ($sized-bytevector size))))))
diff --git a/tests/cadet.scm b/tests/cadet.scm
index 53eaeb2..162a666 100644
--- a/tests/cadet.scm
+++ b/tests/cadet.scm
@@ -22,6 +22,7 @@
              %minimum-local-channel-id
              /:msg:cadet:local:channel:create)
        (gnu gnunet utils bv-slice)
+       (gnu gnunet utils bv-slice-quickcheck)
        (gnu gnunet utils hat-let)
        (gnu gnunet netstruct syntactic)
        (gnu gnunet crypto struct)
@@ -130,18 +131,10 @@
   (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 '())))
@@ -158,34 +151,25 @@
         (foo foo))
        list))
 
-(define-syntax-rule
-  (test-roundtrip testcase analyse construct (name $arbitrary) ...)
-  (test-assert testcase
-    (quickcheck
-     (property ((name $arbitrary) ...)
-              (let^ ((! expected (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
+               normalise
                (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
+               normalise
                (channel-number $channel-number))
 (test-roundtrip "analyse + construct round-trips (local-data)"
                analyse-local-data construct-local-data
+               normalise
                (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
+               normalise
                (channel-number $channel-number))
 
 ;; header information will be tested elsewhere (TODO)
diff --git a/tests/file-sharing.scm b/tests/file-sharing.scm
index 986db6c..b3cdbf0 100644
--- a/tests/file-sharing.scm
+++ b/tests/file-sharing.scm
@@ -18,11 +18,45 @@
 (define-module (test-file-sharing))
 (import (gnu gnunet fs client)
        (srfi srfi-64)
+       (gnu gnunet fs client)
+       (gnu gnunet fs network)
+       (gnu gnunet fs quickcheck)
+       (gnu gnunet fs uri)
+       (gnu gnunet hashcode)
+       (quickcheck arbitrary)
+       (ice-9 match)
        (tests utils))
 
 (test-begin "file-sharing")
 
-;; Standard tests
+(define (normalise list)
+  (pk list)
+  (map (match-lambda
+       ((? chk? #;content-hash-key? k)
+        (make-chk
+         (copy-hashcode:512 (chk-key k))
+         (copy-hashcode:512 (chk-query k))))
+       (foo foo))
+       list))
+
+(define (construct-request-loc-signature* x y z w)
+  (construct-request-loc-signature x y z #:purpose w))
+
+;; Network messages
+(define $file-length $natural) ; TODO bounds
+(define $purpose $natural) ; TODO bounds
+(define $expiration-time $natural) ; TODO bounds
+(test-expect-fail 1)
+(test-roundtrip "analyse + construct round-trips (request-loc-signature)"
+               analyse-request-loc-signature construct-request-loc-signature*
+               normalise
+               (content-hash-key $content-hash-key)
+               (file-length $file-length)
+               (expiration-time $expiration-time)
+               (purpose $purpose))
+
+
+;; Standard service tests
 (test-assert "close, not connected --> all fibers stop, no callbacks called"
   (close-not-connected-no-callbacks "fs" (pk connect) disconnect!))
 (test-assert "garbage collectable"
diff --git a/tests/utils.scm b/tests/utils.scm
index 40329c9..09524af 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -16,7 +16,12 @@
 ;;
 ;; SPDX-License-Identifier: AGPL-3.0-or-later
 (define-module (tests utils)
+  #:use-module (quickcheck)
+  #:use-module (quickcheck property)
+  #:use-module (quickcheck generator)
+  #:use-module (quickcheck arbitrary)
   #:use-module (srfi srfi-8)
+  #:use-module (srfi srfi-64)
   #:use-module (ice-9 match)
   #:use-module (ice-9 weak-vector)
   #:use-module ((rnrs hashtables) #:prefix |rnrs:|)
@@ -24,11 +29,14 @@
                #:select (bitwise-ior))
   #:use-module ((rnrs base) #:select (assert))
   #:use-module ((fibers) #:prefix |fibers:|)
+  #:use-module (gnu gnunet utils hat-let)
   #:autoload (fibers conditions) (make-condition signal-condition! wait)
   #:autoload (fibers timers) (sleep)
   #:autoload (gnu gnunet config db)
   (hash->configuration hash-key key=? set-value!)
   #:autoload (gnu gnunet mq error-reporting) (error-reporter)
+  #:autoload (gnu gnunet utils bv-slice)
+  (slice-readable? slice-writable?)
   #:export (conservative-gc? calls-in-tail-position?
                             call-with-services
                             call-with-services/fibers
@@ -44,7 +52,8 @@
                             garbage-collectable
                             disconnect-after-eof-after-connected
                             reconnects
-                            determine-reported-errors))
+                            determine-reported-errors
+                            test-roundtrip))
 
 (define (make-nonblocking! sock)
   (fcntl sock F_SETFL
@@ -421,3 +430,33 @@ connection port as seen by the server and can e.g. write 
to the port or close it
        (and (not currently-connected?)
            (= times-connected n-connections) errors)))
    `((,service . ,proc))))
+
+;; TODO export
+(define make-property (@@ (quickcheck property) make-property))
+
+(define (round-trip-property analyse construct normalise names gen/arbs)
+  (make-property
+   names gen/arbs
+   (lambda expected
+     (let^ ((! constructed (apply construct expected))
+           (<-- analysed (analyse constructed))
+           (! analysed (normalise analysed)))
+          (and (slice-readable? constructed)
+               (slice-writable? constructed)
+               (equal? expected analysed))))))
+
+;; This test construct network messages by generating @var{name} ...
+;; with the quickcheck arbitraries @var{$arbitrary} ...
+;; and passing them to the construction procedure
+;; @var{construct}.  @var{testcase} is the name of this test.
+;;
+;; TODO: don't assume @code{equal?} / normalisation
+;; and explain why.  TODO document construct/analyse
+;; pattern.
+(define-syntax-rule
+  (test-roundtrip testcase analyse construct normalise
+                 (name $arbitrary) ...)
+  (test-assert testcase
+    (quickcheck (round-trip-property analyse construct normalise
+                                    '(name ...)
+                                    (list $arbitrary ...)))))

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