From bb30b8257b15688070f21ddcc04752699e60a3ba Mon Sep 17 00:00:00 2001
From: "Jakob L. Kreuze" <jakob.kreuze@us.af.mil>
Date: Fri, 18 Nov 2022 21:33:24 -0500
Subject: [dynamic] Refactor queue operations

---
 haunt/jakob/dynamic/captcha.scm | 52 ++++++++++++++++++++---------------------
 1 file changed, 25 insertions(+), 27 deletions(-)

diff --git a/haunt/jakob/dynamic/captcha.scm b/haunt/jakob/dynamic/captcha.scm
index faa6006..2e185d3 100644
--- a/haunt/jakob/dynamic/captcha.scm
+++ b/haunt/jakob/dynamic/captcha.scm
@@ -50,6 +50,25 @@
 (define (make-queue n)
   (make-id-queue (make-mutex) (iota n) (list)))
 
+(define (append-to-free-queue! id queue)
+  (set-id-queue-free!
+   queue
+   (append! (id-queue-free queue) (list id))))
+
+(define (remove-from-free-queue! id queue)
+  (set-id-queue-free! queue (delete! id (id-queue-free queue))))
+
+(define (append-to-allocated-queue! id queue)
+  (set-id-queue-allocated!
+   queue
+   (append! (id-queue-allocated queue) (list (list id (current-time))))))
+
+(define (remove-from-allocated-queue! id queue)
+  (set-id-queue-allocated!
+   queue
+   (filter! (lambda (x) (not (equal? id (car x))))
+            (id-queue-allocated queue))))
+
 (define max-challenges 1024)
 (define min-free-id-threshold 32)
 (define time-to-live-seconds (* 20 60))
@@ -57,47 +76,26 @@
 
 (define (release-id! id queue)
   (with-mutex (id-queue-mutex queue)
-    (display (id-queue-allocated queue))
-    (newline)
-    (display (find (lambda (x) (equal? id (car x))) (id-queue-allocated queue)))
-    (newline)
     (assert (find (lambda (x) (equal? id (car x))) (id-queue-allocated queue)))
     (assert (not (member id (id-queue-free queue))))
-    (set-id-queue-free!
-     queue
-     (append! (id-queue-free queue) (list id)))
-    (set-id-queue-allocated!
-     queue
-     (filter! (lambda (x) (not (equal? id (car x))))
-              (id-queue-allocated queue)))))
+    (append-to-free-queue! id queue)
+    (remove-from-allocated-queue! id queue)))
 
 (define (dequeue-id! queue)
   (with-mutex (id-queue-mutex queue)
     (when (< (length (id-queue-free queue)) min-free-id-threshold)
       (for-each
        (match-lambda
-         ((cons id created-time)
+         ((id created-time)
           (when (>= (- (time-second (current-time))
                        (time-second created-time))
                     time-to-live-seconds)
-            (assert (not (member id (id-queue-free queue))))
-            (set-id-queue-free!
-             queue
-             (append! (id-queue-free queue) (list id)))
-            (set-id-queue-allocated!
-             queue
-             (filter! (lambda (x) (not (equal? id (car x))))
-                      (id-queue-allocated queue))))))
+            (remove-from-allocated-queue! id queue))))
        (list-copy (id-queue-allocated queue))))
     (let* ((n (random (length (id-queue-free queue))))
            (id (list-ref (id-queue-free queue) n)))
-      (set-id-queue-free!
-       queue
-       (delete! id (id-queue-free queue)))
-      (set-id-queue-allocated!
-       queue
-       (append! (id-queue-allocated queue)
-                (list (cons id (current-time)))))
+      (remove-from-free-queue! id queue)
+      (append-to-allocated-queue! id queue)
       id)))
 
 
-- 
cgit v1.3