Message deduplicator
This commit is contained in:
parent
9566830bc1
commit
e237b49bb0
|
@ -0,0 +1,36 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide (struct-out deduplicator)
|
||||||
|
make-deduplicator
|
||||||
|
deduplicator-accept
|
||||||
|
deduplicator-expire)
|
||||||
|
|
||||||
|
(require racket/set)
|
||||||
|
(require racket/match)
|
||||||
|
(require "functional-queue.rkt")
|
||||||
|
|
||||||
|
(struct deduplicator (queue table ttl) #:transparent)
|
||||||
|
|
||||||
|
(define (make-deduplicator [ttl 10000])
|
||||||
|
(deduplicator (make-queue) (set) ttl))
|
||||||
|
|
||||||
|
(define (deduplicator-expire d)
|
||||||
|
(define now (current-inexact-milliseconds))
|
||||||
|
(let loop ((d d))
|
||||||
|
(match-define (deduplicator queue table ttl) d)
|
||||||
|
(if (queue-empty? queue)
|
||||||
|
d
|
||||||
|
(let-values (((v q1) (dequeue queue)))
|
||||||
|
(if (<= (car v) now)
|
||||||
|
(loop (deduplicator q1 (set-remove table (cdr v)) ttl))
|
||||||
|
d)))))
|
||||||
|
|
||||||
|
(define (deduplicator-accept d incoming)
|
||||||
|
(let* ((d (deduplicator-expire d)))
|
||||||
|
(match-define (deduplicator queue table ttl) d)
|
||||||
|
(if (set-member? table incoming)
|
||||||
|
(values #f d)
|
||||||
|
(values #t (deduplicator (enqueue queue
|
||||||
|
(cons (+ (current-inexact-milliseconds) ttl) incoming))
|
||||||
|
(set-add table incoming)
|
||||||
|
ttl)))))
|
Loading…
Reference in New Issue