# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1516047979 18000
# Node ID 90c855f298b87ee1c2047dedb43590cccb0d8c02
# Parent  4ce62327f4bd2a724fe0578f45d37732b06a4c8b
Add request locking

diff -r 4ce62327f4bd -r 90c855f298b8 cl-ggp.asd
--- a/cl-ggp.asd	Mon Apr 03 23:52:37 2017 +0200
+++ b/cl-ggp.asd	Mon Jan 15 15:26:19 2018 -0500
@@ -7,11 +7,16 @@
   :license "MIT"
   :version "1.0.0"
 
-  :depends-on (:clack
+  :depends-on (
+
+               :bordeaux-threads
+               :clack
+               :fare-quasiquote-optima
+               :fare-quasiquote-readtable
                :flexi-streams
                :optima
-               :fare-quasiquote-optima
-               :fare-quasiquote-readtable)
+
+               )
 
   :serial t
   :components ((:file "package")
diff -r 4ce62327f4bd -r 90c855f298b8 src/ggp.lisp
--- a/src/ggp.lisp	Mon Apr 03 23:52:37 2017 +0200
+++ b/src/ggp.lisp	Mon Jan 15 15:26:19 2018 -0500
@@ -77,6 +77,9 @@
      :type (or null (integer 0))
      :initform nil
      :documentation "The (internal-real) timestamp of when the current GGP message was received.  **Do not touch this.**  Use the `timeout` value passed to your methods instead.")
+   (request-lock
+     :initform (bt:make-lock "ggp-player request lock")
+     :documentation "A lock used to prevent concurrent GGP request processing.  **Do not touch this.**")
    (current-match
      :initform nil
      :documentation "The ID of the current match the player is playing, or `nil` if it is waiting.  **Do not touch this.**")
@@ -316,24 +319,25 @@
     (_ t)))
 
 (defun app (player env)
-  (setf (slot-value player 'message-start) (get-internal-real-time))
-  (unwind-protect
-      (let* ((body (get-body env))
-             (request (safe-read-from-string body))
-             (should-log (should-log-p request)))
-        (when should-log
-          (l "~%~%Got a request ====================================~%")
-          ; (l "~S~%" body)
-          (l "~A~%" request)
-          (l "==================================================~%"))
-        (let* ((response (route player request))
-               (rendered-response (render-to-string response)))
+  (bt:with-lock-held ((slot-value player 'request-lock))
+    (setf (slot-value player 'message-start) (get-internal-real-time))
+    (unwind-protect
+        (let* ((body (get-body env))
+               (request (safe-read-from-string body))
+               (should-log (should-log-p request)))
           (when should-log
-            (l "==================================================~%")
-            (l "Responding with:~%~A~%" rendered-response)
+            (l "~%~%Got a request ====================================~%")
+            ; (l "~S~%" body)
+            (l "~A~%" request)
             (l "==================================================~%"))
-          (resp rendered-response)))
-    (setf (slot-value player 'message-start) nil)))
+          (let* ((response (route player request))
+                 (rendered-response (render-to-string response)))
+            (when should-log
+              (l "==================================================~%")
+              (l "Responding with:~%~A~%" rendered-response)
+              (l "==================================================~%"))
+            (resp rendered-response)))
+      (setf (slot-value player 'message-start) nil))))
 
 
 ;;;; Spinup/spindown ----------------------------------------------------------