;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2010-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

#lang syndicate

(provide heartbeat)

(module+ for-testing
  (provide heartbeats-enabled?))

(require "wire-protocol.rkt")

(require/activate syndicate/drivers/timer)

(define-logger syndicate/distributed)

(define heartbeats-enabled? (make-parameter #t))

;; TODO: move heartbeats to transport level, and use separate transport-activity timeouts from
;; message-activity timeouts. Using message-activity only has problems when messages are large
;; and links are slow. Also, moving to transport level lets us use e.g. WebSocket's ping
;; mechanism rather than a message-level mechanism.
(define (heartbeat who send-message teardown)
  (cond
    [(heartbeats-enabled?)
     (define period (ping-interval))
     (define grace (* 3 period))

     (log-syndicate/distributed-debug
      "Peer ~v heartbeat period ~ams; must not experience silence longer than ~ams"
      who period grace)

     (field [next-ping-time 0]) ;; when we are to send the next ping
     (field [last-received-traffic (current-inexact-milliseconds)]) ;; when we last heard from the peer

     (define (schedule-next-ping!)
       (next-ping-time (+ (current-inexact-milliseconds) period)))

     (on (asserted (later-than (next-ping-time)))
         (schedule-next-ping!)
         (send-message (Ping)))

     (on (asserted (later-than (+ (last-received-traffic) grace)))
         (log-syndicate/distributed-info "Peer ~v heartbeat timeout after ~ams of inactivity"
                                         who grace)
         (teardown))

     (lambda ()
       (schedule-next-ping!)
       (last-received-traffic (current-inexact-milliseconds)))]
    [else
     (log-syndicate/distributed-debug "Peer ~v heartbeats disabled" who)
     void]))