scheme-gnunet/tests/network-size.scm

;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
;; Copyright © 2021, 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-module (test-network-size))
(import (gnu gnunet util time)
	(gnu gnunet mq)
	(gnu gnunet mq-impl stream)
	(gnu gnunet mq handler)
	(gnu extractor enum)
	(gnu gnunet message protocols)
	(gnu gnunet config db)
	(gnu gnunet utils cut-syntax)
	(only (rnrs base)
	      assert)
	(prefix (gnu gnunet nse client) #{nse:}#)
	(gnu gnunet nse struct)
	(only (gnu gnunet utils bv-slice)
	      slice-length make-slice/read-write)
	(only (tests utils) call-with-services/fibers)
	(only (fibers) sleep)
	(gnu gnunet netstruct syntactic)
	(ice-9 match)
	(ice-9 suspendable-ports)
	(ice-9 control)
	(prefix (rnrs hashtables) #{rnrs:}#)
	(srfi srfi-1)
	(srfi srfi-26)
	(srfi srfi-43)
	(srfi srfi-64)
	(fibers conditions)
	(tests utils))

(test-begin "network-size")

(define (no-error-handler . e)
  (pk 'e e)
  (error "no error handler"))

;; The C implementation of the service requires the client
;; to sent this message.
(test-assert "Client sends msg:nse:start"
  (let* ((start-sent? #f)
	 (start-sent-condition (make-condition))
	 (server-handlers
	  (message-handlers
	   (make-message-handler
	    (symbol-value message-type msg:nse:start)
	    (lambda (p) (p))
	    (lambda (s)
	      (= (slice-length s) 4))
	    (lambda (slice)
	      (assert (not start-sent?))
	      (set! start-sent? #t)
	      (signal-condition! start-sent-condition))))))
    (call-with-services/fibers
     `(("nse" . ,(lambda (port spawn-fiber)
		   (define mq (port->message-queue port server-handlers
						   no-error-handler
						   #:spawn spawn-fiber))
		   (values))))
     (lambda (config spawn-fiber)
       (nse:connect config #:spawn spawn-fiber)
       (wait start-sent-condition)
       #t))))

(define %estimates
  `((0. ,(expt 2.0 0.) 0. 0) ; stddev can theoretically be zero
    (0. ,(expt 2.0 0.) +nan.0 0) ; see <https://bugs.gnunet.org/view.php?id=7021#c18399>
    (0. ,(expt 2.0 0.) +inf.0 0) ; likewise
    (0. ,(expt 2.0 0.) 0.1 0)
    (1. ,(expt 2.0 1.) 0.11 10)
    (2. ,(expt 2.0 2.) 0.111 100)
    (3. ,(expt 2.0 3.) 0.1111 1000)))

(define (port->nse-client-message-queue port spawn-fiber)
  (define h (message-handlers
	     (make-message-handler
	      (symbol-value message-type msg:nse:start)
	      (lambda (p) (p))
	      (lambda (s) (= (slice-length s) 4))
	      (lambda (slice) (values)))))
  (port->message-queue port h no-error-handler #:spawn spawn-fiber))

(define (act-as-the-server port spawn-fiber estimates)
  (define mq
    (port->nse-client-message-queue port spawn-fiber))
  ;; Send the client a few fake estimates.
  ;; This code would be incorrect if there were
  ;; multiple clients!
  (define (send! estimate)
    (define s (make-slice/read-write
	       (sizeof /:msg:nse:estimate '())))
    (define-syntax set%!/estimate
      (cut-syntax set%! /:msg:nse:estimate <> s <>))
    ;; Set the headers
    (set%!/estimate '(header size) (sizeof /:msg:nse:estimate '()))
    (set%!/estimate '(header type)
		    (value->index
		     (symbol-value message-type msg:nse:estimate)))
    ;; Set the data
    (set%!/estimate '(timestamp) (list-ref estimate 3))
    (set%!/estimate '(size-estimate) (list-ref estimate 0))
    (set%!/estimate '(std-deviation) (list-ref estimate 2))
    ;; Send the estimate
    (send-message! mq s))
  (for-each send! %estimates))

(define (estimate->list estimate)
  "Represent ESTIMATE as a list that can be compared with equal?."
  `(,(nse:estimate:logarithmic-number-peers estimate)
    ,(nse:estimate:number-peers estimate)
    ,(nse:estimate:standard-deviation estimate)
    ,(nse:estimate:timestamp estimate)))

(define protected-against-gc)

(test-equal "Client calls call-back (and sets estimates) in-order"
  (list %estimates %estimates)
  (call-with-services/fibers
   `(("nse" . ,(lambda (port spawn-fiber)
		 ;; Make sure that the GC doesn't cause buffered messages
		 ;; to be discarded.
		 (set! protected-against-gc port)
		 (act-as-the-server port spawn-fiber %estimates))))
   (lambda (config spawn-fiber)
     (define estimates/update/reverse '())
     (define estimates/poll/reverse '())
     (define connected? #f)
     (define done (make-condition))
     (define (updated estimate)
       (assert connected?)
       (assert (nse:estimate? estimate))
       (set! estimates/update/reverse
	     (cons (estimate->list estimate) estimates/update/reverse))
       (set! estimates/poll/reverse
	     (cons (estimate->list (nse:estimate server))
		   estimates/poll/reverse))
       (when (= (length estimates/update/reverse)
		(length %estimates))
	 (signal-condition! done))
       (when (> (length estimates/update/reverse)
		(length %estimates))
	 (error "too many estimates!")))
     (define (connected)
       (assert (not connected?))
       (set! connected? #t))
     (define server
       (nse:connect config #:connected connected #:updated updated
		    #:spawn spawn-fiber))
     (wait done)
     (assert connected?)
     (list (reverse estimates/update/reverse)
	   (reverse estimates/poll/reverse)))))

;; See <https://notabug.org/maximed/scheme-gnunet/issues/4>.
;; Only the last estimate is tested.

(test-assert "likewise, without 'updated' or 'connected' (issue 4)"
  (call-with-services/fibers
   `(("nse" . ,(lambda (port spawn-fiber)
		 (set! protected-against-gc port)
		 (act-as-the-server port spawn-fiber %estimates))))
   (lambda (config spawn-fiber)
     (define server
       (nse:connect config #:spawn spawn-fiber))
     (let loop ((time-delta 0))
       (unless (equal? (and=> (nse:estimate server) estimate->list)
		       (last %estimates))
	 (sleep (/ time-delta time-unit:second))
	 (loop (standard-back-off time-delta))))
     #t)))

(test-assert "notify disconnected after end-of-file, after 'connected'"
  (call-with-services/fibers
   `(("nse" . ,(lambda (port spawn-fiber)
		 (close-port port))))
   (lambda (config spawn-fiber)
     (define disconnected? #f)
     (define connected? #f)
     (define c (make-condition))
     (define (connected)
       (set! connected? #t))
     (define (disconnected)
       (assert connected?)
       ;; Because (gnu gnunet nse client) automatically reconnects,
       ;; the following commented-out assertion can be false.
       #;(assert (not disconnected?))
       (set! disconnected? #t)
       (signal-condition! c))
     (define server
       (nse:connect config #:spawn spawn-fiber #:connected connected
		    #:disconnected disconnected))
     (wait c)
     ;; Give (gnu gnunet nse client) a chance to (incorrectly) call
     ;; disconnected again.
     (sleep 0.001)
     #t)))

(define forever (make-condition))

(test-assert "reconnects"
  (let ((n 9)
	(too-many? #f)
	(done (make-condition)))
    (call-with-services/fibers
     `(("nse" . ,(lambda (port spawn-fiber)
		   (if (> n 0)
		       (begin
			 (set! n (- n 1))
			 (close-port port))
		       (wait forever)))))
     (lambda (config spawn-fiber)
       (define disconnected? #f)
       (define connected? #f)
       (define connected-again (make-condition))
       (define disconnect-count 0)
       (define (connected)
	 (match (cons disconnected? connected?)
	   ((#t . #f)
	    (set! disconnected? #f)
	    (set! connected? #t)
	    (when (= disconnect-count 9)
	      (signal-condition! connected-again))
	    (values))
	   ((#t . #t) (error "impossible"))
	   ((#f . #f)
	    (set! connected? #t)
	    (values)) ; first connect
	   ((#f . #t) (error "doubly connected"))))
       (define (disconnected)
	 (match (cons connected? disconnected?)
	   ((#t . #f)
	    (set! connected? #f)
	    (set! disconnected? #t)
	    (set! disconnect-count (+ 1 disconnect-count))
	    (cond
	     ((= disconnect-count 9)
	      (signal-condition! done))
	     ((> disconnect-count 9)
	      (set! too-many? #t)
	      (error "too many disconnects")))
	    (values))
	   ((#t . #t) (error "impossible"))
	   ((#f . #f)
	    (error "disconnected before connecting"))
	   ((#f . #t)
	    (error "doubly disconnected"))))
       (define server
	 (nse:connect config #:spawn spawn-fiber #:connected connected
		      #:disconnected disconnected))
       (wait done)
       (assert (not too-many?))
       ;; We used to do (sleep 0.01) here but this was
       ;; (rarely) insufficient.
       (wait connected-again)
       (assert connected?)
       #t))))

(test-assert "close, not connected --> all fibers stop, no callbacks called"
  (close-not-connected-no-fallbacks
   "nse" nse:connect nse:disconnect!
   #:rest (list #:disconnected #{don't-call-me}#)))

(test-assert "close, connected --> all fibers stop, two callbacks called"
  (call-with-spawner/wait
   (lambda (spawn)
     (call-with-temporary-directory
      (lambda (somewhere)
	(define where (in-vicinity somewhere "sock.et"))
	(define config (trivial-service-config "nse" where))
	(define (#{don't-call-me}# . rest)
	  (error "oops ~a" rest))
	(define connected? #f)
	(define disconnected? #f)
	(define connected-cond (make-condition))
	(define disconnected-cond (make-condition))
	(define (connected)
	  (assert (not connected?))
	  (set! connected? #t)
	  (signal-condition! connected-cond))
	(define done (make-condition))
	(define (disconnected)
	  (assert (not disconnected?))
	  (assert connected?)
	  (signal-condition! disconnected-cond)
	  (set! disconnected? #t))
	(define server (nse:connect config #:spawn spawn
				    #:connected connected
				    #:disconnected disconnected
				    #:updated #{don't-call-me}#))
	(define listening (socket AF_UNIX SOCK_STREAM 0))
	(make-nonblocking! listening)
	(bind listening AF_UNIX where)
	(listen listening 1)
	(define connection (accept listening))
	(wait connected-cond)
	(nse:disconnect! server)
	(wait disconnected-cond)
	(define old-waiter (current-read-waiter))
	(sleep 0.01) ;; give the NSE client a chance to accidentally connect
	(let/ec ec
	  (parameterize ((current-read-waiter
			  (lambda (p)
			    (if (eq? p listening)
				(ec)
				(old-waiter p)))))
	    (set! connection (accept listening))
	    (error "client tried to connect again")))
	#t)))
   ;; call-with-spawner/wait is more reliable without parallelism
   #:parallelism 1))

(test-end "network-size")