scheme-gnunet/tests/message-handler.scm

;; This file is part of scheme-GNUnet.
;; Copyright (C) 2021 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

(use-modules (gnu gnunet mq handler)
	     (gnu gnunet message protocols)
	     (gnu extractor enum)
	     (rnrs base))

(test-begin "mq-handler")

(test-assert "constructor docstring"
  (procedure-documentation make-message-handler))

(define (bogus-verifier x)
  (throw 'what #:verifier))
(define (bogus-interposition thunk)
  (thow 'what #:interposition))
(define (bogus-handler x)
  (throw 'what #:handler))

(define bogus-handler
  (cute make-message-handler <> bogus-interposition
	bogus-verifier bogus-handler))

(define (uninteresting-interposition thunk)
  (thunk))

;; Message indices
(test-equal "message handler index (0)"
  0 (message-handler-index (bogus-handler 0)))

(test-equal "message handler index (65535)"
  65535 (message-handler-index (bogus-handler 65535)))

(test-error "message handler OOB (< 0)" #t
	    (message-handler-index (bogus-handler -1)))

(test-error "message handler OOB (> 65535)" #t
	    (message-handler-index (bogus-handler -1)))

(test-error "message handler inexact" #t
	    (message-handler-index (bogus-handler -1)))

(test-equal "message handler enum value"
	    777
	    (message-handler-index
	     (bogus-handler (integer->value message-type 777))))

(define %arbitrary-index #xdead)



(define-syntax ^vals
  (syntax-rules ()
    ((_ exp) (call-with-values (lambda () exp) list))))

;; Handlers may return multiple values.
;;
;;  (Currently, handle-message! is even tail-recursive,
;;  but that's not guaranteed)
(test-equal "handlers with zero values"
  '()
  (^vals (handle-message!
	  (make-message-handler %arbitrary-index
				uninteresting-interposition
				bogus-verifier
				(lambda (message)
				  (values)))
	  'message)))
(test-equal "handlers with three values"
  '(x y z)
  (^vals (handle-message!
	  (make-message-handler %arbitrary-index
				uninteresting-interposition
				bogus-verifier
				(lambda (message)
				  (values 'x 'y 'z)))
	  'dont-care)))


;; Dynamic environment tests
(let* ((nestedness (make-parameter 0))
       (is-set? #f)
       (return-nestedness
	(lambda (message)
	  (nestedness)))
       (interposition (lambda (thunk)
			(assert (not is-set?))
			(set! is-set? #t)
			(parameterize ((nestedness (1+ (nestedness))))
			  (thunk)))))
  (test-equal "dynamic environment adjusted exactly once (verifier)"
    1
    (verify-message?
     (make-message-handler %arbitrary-index interposition
			   return-nestedness bogus-handler)
     "message"))
  (set! is-set? #f)
  (test-equal "dynamic environment adjusted exactly once (handler)"
    1
    (handle-message!
     (make-message-handler %arbitrary-index interposition
			   bogus-verifier return-nestedness)
     'anything))
  (set! is-set? #f))


;; Multiple handler tests
(test-equal "message handler OOB (0,0)"
  #f
  (message-handler-for (message-handlers) 0))

(test-equal "message handler OOB (0,high)"
  #f
  (message-handler-for (message-handlers) 9))

;; 0, 65535: two extreme values
;; 777: something else entirely
(let* ((indices `(0 777 65535))
       (all-handlers (map bogus-handler indices))
       (handlers (apply message-handlers all-handlers)))
  (for-each
   (lambda (i handler)
     ;; Both numeric and typed value are acceptable.
     ;; Whatever's convenient to the caller.
     (test-eq "message handler (non-empty, numeric)"
       handler
       (message-handler-for handlers i))
     (test-eq "message handler (non-empty, enum value)"
       handler
       (message-handler-for handlers (integer->value message-type i))))
   indices all-handlers))

(test-end "mq-handler")