[gnunet-scheme] 63/324: Define message envelope type and procedures.

[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 a55cc7e79dfb836344c33161ebeb95c034bf1095
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Jan 30 15:25:53 2021 +0100

    Define message envelope type and procedures.
    
    The message envelope is a nice Scheme record wrapped
    around the ‘real’ duocentehexaquinquagesimal network
    messages, and includes some niceties such as a ‘notify
    on sent’ hook and a priority-preference value.
    
    FIXME: the test found a bug in bv-slice.scm.
    
    * README.org (Modules): note that
      gnu/gnunet/message/envelope.scm exists.
    * gnu/gnunet/message/envelope.scm: new records and
      associated procedures.
    * tests/envelope.scm: test it.
---
 README.org                      |   2 +
 gnu/gnunet/message/envelope.scm | 118 ++++++++++++++++++++++++++++++++++++
 tests/envelope.scm              | 129 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 249 insertions(+)

diff --git a/README.org b/README.org
index ab1d5f9..e075eef 100644
--- a/README.org
+++ b/README.org
@@ -30,6 +30,8 @@
   + gnu/gnunet/util/mq.scm and friends: message queues for
     network messages, and calling an appropriate handler for
     each message type.
+  + gnu/gnunet/message/envelope.scm: some program data around
+    message types (e.g. priority, notify on sent hook)
 * Conventions
 ** Fiddling with options
    Options like ‘priority’, ‘anonymity’, ‘replication’
diff --git a/gnu/gnunet/message/envelope.scm b/gnu/gnunet/message/envelope.scm
new file mode 100644
index 0000000..cf2fc41
--- /dev/null
+++ b/gnu/gnunet/message/envelope.scm
@@ -0,0 +1,118 @@
+;; This file is part of scheme-GNUnet.
+;; Copyright (C) 2012-2019 GNUnet e.V.
+;; Copyright (C) 2021 Maxime Devos
+;;
+;; 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: AGPL3.0-or-later
+
+;; Upstream GNUnet:
+;; @author Florian Dold
+;; @file util/mq.c
+;; @brief general purpose request queue
+;;
+;; Scheme-GNUnet:
+;; @author Maxime Devos
+;; @file gnu/gnunet/message/envelope.scm
+
+(library (gnu gnunet message envelope)
+  (export <envelope> make-envelope envelope?
+         <envelope/dll> make-envelope/dll envelope/dll?
+         envelope-message-slice envelope-priority
+         notify-sent! envelope-dll-check envelope-dll)
+  (import (gnu gnunet utils bv-slice)
+         (srfi srfi-26)
+         (rnrs base)
+         (ice-9 optargs)
+         (rnrs records syntactic))
+  (begin
+    (define-record-type (<envelope> make-envelope envelope?)
+      (fields (immutable message-slice envelope-message-slice)
+             (immutable message-prio  envelope-priority)
+             ;; Set to #t once the message is sent.
+             (mutable notify-sent! %envelope-notify-sent!
+                      %set-envelope-notify-sent!!))
+      (protocol
+       (lambda (%make)
+        (lambda* (mh #:key
+                     (notify-sent! #f)
+                     (priority 0))
+          "Make a message envelope for the message @var{mh}
+(a readable bytevector slice) and priority @var{priority}
+(a numeric value from @code{gnu gnunet util mq-enum}).
+
+When the message has been sent to the network (and thus
+cannot be cancelled anymore), the thunk @var{notify-sent!}
+should be called if present."
+          ;; FIXME also check if @var{mh} is large enough?
+          (assert (slice-readable? mh))
+          (assert (or (not notify-sent!)
+                      (procedure? notify-sent!)))
+          (assert (and (integer? priority)
+                       (exact? priority)
+                       (<= 0 priority)
+                       ;; XXX magic number
+                       (< priority 512)))
+          (%make mh priority notify-sent!))))
+      (sealed #f)
+      (opaque #t))
+
+    (define (notify-sent! ev)
+      "Call the ‘notify sent’ callback thunk of @var{ev}, if any.
+This may only be done once."
+      (let ((ev:notify-sent! (%envelope-notify-sent! ev)))
+       ;; Detect casual violations of the ‘only once’ rule.
+       ;; Won't always work in all MT scenario's, but this
+       ;; is ‘merely’ a rather convenient debugging and testing
+       ;; aid, not a protection against an attacker.
+       (assert (not (eq? #t ev:notify-sent!)))
+       (%set-envelope-notify-sent!! ev #t)
+       ;; First call %set-envelope-notify-sent!,
+       ;; and only then call the ev:notify-sent! thunk,
+       ;; to detect cases where ev:notify-sent! calls
+       ;; notify-sent! with @var{ev} again, and in
+       ;; case ev:notify-sent! throws an exception.
+       (and ev:notify-sent! (ev:notify-sent!))))
+
+    (define-record-type (<envelope/dll> make-envelope/dll envelope/dll?)
+      (fields (immutable capability %envelope/dll-capability)
+             (mutable left %envelope/dll-previous
+                      %set-envelope/dll-previous!)
+             (mutable right %envelope/dll-next
+                      %set-envelope/dll-next!))
+      (protocol
+       (lambda (%make)
+        (lambda (cap . args)
+          "A variant of @code{make-envelope}, that organises envelopes
+in a linked list.  The capability @var{cap} will be required for accessing
+and modifying this list."
+          (apply %make cap #f #f args))))
+      (sealed #f)
+      (opaque #t))
+
+    (define (envelope-dll-check ev/dll cap)
+      "Verify whether the capability @var{cap} can be used
+for accessing the underlying DLL of the envelope @var{ev}.
+If not, raise an exception."
+      ;; FIXME &bad-capability exception?
+      (assert (eq? (%envelope/dll-capability ev/dll) cap)))
+
+    (define (envelope-dll ev/dll cap)
+      "Return the DLL procedures of the DLL envelope @var{ev/dll},
+using the capability @var{cap}."
+      (envelope-dll-check ev/dll cap)
+      (values (cute %envelope/dll-previous ev/dll)
+             (cute %set-envelope/dll-previous! ev/dll <>)
+             (cute %envelope/dll-next ev/dll)
+             (cute %set-envelope/dll-next! ev/dll <>)))))
diff --git a/tests/envelope.scm b/tests/envelope.scm
new file mode 100644
index 0000000..06906bb
--- /dev/null
+++ b/tests/envelope.scm
@@ -0,0 +1,129 @@
+;; This file is part of scheme-GNUnet.
+;; Copyright (C) 2021 Maxime Devos
+;;
+;; 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: AGPL3.0-or-later
+
+(use-modules (gnu gnunet message envelope)
+            (gnu gnunet utils bv-slice)
+            (ice-9 control)
+            (rnrs bytevectors)
+            (srfi srfi-26))
+
+(test-begin "envelope")
+
+(define %arbitrary-slice (make-slice/read-write 50))
+(define %arbitrary-bv (make-bytevector 50))
+(define %arbitrary-priority 7)
+(define (%bogus-notify-sent!) (throw 'what))
+
+;; Priorities (represented by raw integers)
+(let ((mk-prio (cute make-envelope %arbitrary-slice
+                    #:priority <>))
+      (acceptable-priorities
+       '(0 1 511)))
+  (test-equal "priorities are preserved"
+    acceptable-priorities
+    (map (compose envelope-priority mk-prio)
+        acceptable-priorities))
+  (test-error "priorities ≥ 512 are rejected" #t
+             (mk-prio 512))
+  (test-error "priorities < 0 are rejected" #t
+             (mk-prio -1))
+  (test-error "inexact priorities are rejected" #t
+             (mk-prio 0.))
+  (test-error "fractional priorities are rejected" #t
+             (mk-prio 1/2)))
+
+;; Notify sent callbacks
+(let ((mk-notify-sent (cute make-envelope %arbitrary-slice
+                           #:notify-sent! <>)))
+  (test-assert "allow #f as notify-sent!"
+    (begin (notify-sent! (mk-notify-sent #f)) #t))
+  (test-error "notify-sent! can only be called once (#f)"
+    #t
+    (let ((ev (mk-notify-sent #f)))
+      (notify-sent! ev)
+      (notify-sent! ev)))
+  (test-assert "notify-sent! thunk is called exactly once"
+    (let* ((count 0)
+          (thunk (lambda () (set! count (+ 1 count)))))
+      (notify-sent! (mk-notify-sent thunk))
+      (= count 1)))
+  (test-error "no recursion in notify-sent! allowed"
+    #t
+    (let/ec success
+      (letrec* ((recursive (make-parameter #f))
+               (thunk (lambda ()
+                        (if (recursive)
+                            (success)
+                            (parameterize ((recursive #t))
+                              (notify-sent! ev)))))
+               (ev (mk-notify-sent thunk)))
+       (notify-sent! ev)))))
+
+;; Message slice
+(let ((mk-slice (cute make-envelope <>)))
+  (test-error "message must be a slice (bv)"
+    #t
+    (mk-slice %arbitrary-bv))
+  (test-error "message must be a slice (#f)"
+    #t
+    (mk-slice #f))
+  (test-error "slice must be readable"
+    #t
+    (mk-slice (slice/write-only (make-slice/read-write 50))))
+  (test-expect-fail 1)
+  (test-error "slice may be writable"
+    #t
+    (mk-slice (make-slice/read-write 50)))
+  ;; It isn't required that they be eq?, per se,
+  ;; but rather, it should point to the same
+  ;; memory region.
+  (test-eq "slice is preserved"
+    %arbitrary-slice
+    (envelope-message-slice (mk-slice %arbitrary-slice))))
+
+;; Envelope DLL
+(let ((mk-dll (cute make-envelope/dll <> %arbitrary-slice)))
+  (mk-dll 'stuff)
+  (test-assert "make-envelope/dll allows #:notify-sent!"
+    (let/ec ec
+      (notify-sent!
+       (make-envelope/dll 'cap %arbitrary-slice
+                         #:notify-sent! (lambda () (ec #t))))
+      #f))
+  (test-equal "make-envelope/dll allows #:priority"
+    444
+    (envelope-priority
+     (make-envelope/dll 'cap %arbitrary-slice
+                       #:priority 444)))
+  (test-assert "envelope/dll? implies envelope?"
+    (envelope? (mk-dll 'check)))
+  (test-assert "envelope? does not imply envelope/dll?"
+    (not (envelope/dll? (make-envelope %arbitrary-slice))))
+
+  (test-assert "capability check success"
+    (envelope-dll-check (mk-dll 'cap) 'cap))
+  (test-error "capability check failure" #t
+             (envelope-dll-check (mk-dll 'cap) 'imposter))
+
+  (test-error "envelope-dll checks capability (failure)" #t
+             (envelope-dll (mk-dll 'cap) 'imposter))
+  (test-assert "envelope-dll checks capability (success)"
+              (envelope-dll (mk-dll 'cap) 'cap)))
+;; XXX test DLL, this requires a DLL library
+
+(test-end "envelope")

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