moar validation

Dockerfile

@@ -30,6 +30,7 @@ RUN apt-get update &&\
 
 WORKDIR /opt/quicklisp/local-projects/
 RUN git clone https://github.com/fukamachi/woo.git &&\
+    git clone https://github.com/fukamachi/fast-http.git &&\
     git clone https://github.com/fukamachi/lack.git &&\
     git clone https://github.com/fukamachi/clack.git &&\
     git clone https://github.com/fukamachi/myway.git &&\
@@ -40,4 +41,4 @@ COPY travels.asd *.lisp travels/
 RUN sbcl --eval '(ql:quickload :travels)' --eval '(sb-ext:quit)'
 
 EXPOSE 80
-CMD ["sbcl", "--eval", "(ql:quickload :travels)", "--eval", "(travels:main :port 80 :data \"/tmp/data/data.zip\")"]
+CMD ["sbcl", "--eval", "(ql:quickload :travels)", "--eval", "(travels:main :port 80 :data \"/tmp/data/data.zip\" :worker-num 4)"]

travels.lisp

@@ -40,6 +40,9 @@
     storage))
 
 (defvar *storage* nil "data store")
+(defvar *storage-users* nil "users store")
+(defvar *storage-locations* nil "locations store")
+(defvar *storage-visits* nil "visits store")
 
 (let ((keyword-package (find-package :keyword)))
   (defun getkey (place indicator)
@@ -57,7 +60,7 @@
            (type list data))
   (let ((content (jojo:to-json data)))
     `(200 (:content-type "application/json"
-                         :content-length ,(trivial-utf-8:utf-8-byte-length content))
+           :content-length ,(trivial-utf-8:utf-8-byte-length content))
           (,content))))
 
 (defun get-entity (params)
@@ -78,6 +81,14 @@
            (optimize (speed 3) (safety 0)))
   (loop for (k v) on item by #'cddr
      unless v return nil
+     when (and (eq k :|id|) (not (integerp v))) return nil
+     when (and (eq k :|distance|) (not (integerp v))) return nil
+     when (and (eq k :|visited_at|) (not (integerp v))) return nil
+     when (and (eq k :|country|) (> (length v) 50)) return nil
+     when (and (eq k :|city|) (> (length v) 50)) return nil
+     when (and (eq k :|mark|) (or (not (integerp v)) (not (<= 0 (the fixnum v) 5)))) return nil
+     when (and (eq k :|user|) (or (not (integerp v)) (not (gethash v *storage-users*)))) return nil
+     when (and (eq k :|location|) (or (not (integerp v)) (not (gethash v *storage-locations*)))) return nil
      finally (return t)))
 
 (defun post-entity (params)
@@ -94,25 +105,25 @@
                  (let ((item (jojo:parse body))
                        (entity-storage (gethash entity *storage*)))
                    (if (validate-item item)
-                       (if id
-                           (let ((existing (gethash id entity-storage)))
-                             (if existing
-                                 (progn
-                                   (when (eq entity :|visits|)
-                                     (update-indexes *storage* existing item))
-                                   (loop for (k v) on item by #'cddr
-                                      unless (eq k :|id|)
-                                      do (setf (getf existing k) v))
-                                   +200-EMPTY+)
-                                 +404+))
-                           (let ((e (gethash (getf item :|id|) entity-storage)))
-                             (if e
-                                 +400+
-                                 (progn
-                                   (when (eq entity :|visits|)
-                                     (update-indexes *storage* nil item))
-                                   (setf (gethash (getf item :|id|) entity-storage) item)
-                                   +200-EMPTY+))))
+                       (let ((item-id (getf item :|id|)))
+                         (if id
+                             (if item-id +400+
+                                 (let ((existing (gethash id entity-storage)))
+                                   (if existing
+                                       (progn
+                                         (when (eq entity :|visits|)
+                                           (update-indexes *storage* existing item))
+                                         (loop for (k v) on item by #'cddr
+                                            do (setf (getf existing k) v))
+                                         +200-EMPTY+)
+                                       +404+)))
+                             (let ((e (gethash item-id entity-storage)))
+                               (if e +400+
+                                   (progn
+                                     (when (eq entity :|visits|)
+                                       (update-indexes *storage* nil item))
+                                     (setf (gethash item-id entity-storage) item)
+                                     +200-EMPTY+)))))
                        +400+)))
              (error () +400+)))
           (otherwise +404+))
@@ -141,29 +152,28 @@
 (defun user-visits (params)
   (let ((id (parse-integer (getf params :id) :junk-allowed t)))
     (if id
-        (let ((user (gethash id (gethash :|users| *storage*))))
+        (let ((user (gethash id *storage-users*)))
           (if user
               (handler-case
                   (let* ((user-visit-ids (gethash id (gethash :user-visits *storage*)))
-                         (locations (gethash :|locations| *storage*))
-                         (visits (gethash :|visits| *storage*))
                          (query-string (getf myway:*env* :query-string))
                          (query-params (and query-string (quri:url-decode-params query-string))))
                     (let ((from-date (may-integer (aget query-params "fromDate")))
                           (to-date (may-integer (aget query-params "toDate")))
                           (to-distance (may-integer (aget query-params "toDistance")))
                           (country (aget query-params "country")))
+                      (assert (or (null country) (<= (length country) 50)))
                       ;; TODO: Smarter indexes
                       (let ((user-visits (loop for v-id in user-visit-ids
-                                            for visit = (gethash v-id visits)
-                                            for loc = (gethash (getf visit :|location|) locations)
+                                            for visit = (gethash v-id *storage-visits*)
+                                            for loc = (gethash (getf visit :|location|) *storage-locations*)
                                             when (and visit (matching-visit visit from-date to-date))
                                             when (and loc (matching-location loc country to-distance))
                                             collect (list :|mark| (getf visit :|mark|)
                                                           :|visited_at| (getf visit :|visited_at|)
                                                           :|place| (getf loc :|place|)))))
-                        (sort user-visits #'< :key (lambda (v) (getf v :|visited_at|)))
-                        (200-json (list :|visits| user-visits)))))
+                        (200-json (list :|visits|
+                                        (sort user-visits #'< :key (lambda (v) (getf v :|visited_at|))))))))
                 (error () +400+))
               +404+))
         +404+)))
@@ -207,8 +217,6 @@
           (if location
               (handler-case
                   (let* ((location-visit-ids (gethash id (gethash :location-visits *storage*)))
-                         (users (gethash :|users| *storage*))
-                         (visits (gethash :|visits| *storage*))
                          (query-string (getf myway:*env* :query-string))
                          (query-params (and query-string (quri:url-decode-params query-string))))
                     (let ((from-date (may-integer (aget query-params "fromDate")))
@@ -217,9 +225,10 @@
                           (from-age (may-integer (aget query-params "fromAge")))
                           (to-age (may-integer (aget query-params "toAge")))
                           (gender (aget query-params "gender")))
+                      (assert (or (null gender) (string= gender "m") (string= gender "f")))
                       (let ((marks (loop for v-id in location-visit-ids
-                                      for visit = (gethash v-id visits)
-                                      for user = (gethash (getf visit :|user|) users)
+                                      for visit = (gethash v-id *storage-visits*)
+                                      for user = (gethash (getf visit :|user|) *storage-users*)
                                       when (and visit (matching-visit visit from-date to-date))
                                       when (and user (matching-user user from-age to-age gender now))
                                       collect (getf visit :|mark|))))
@@ -246,6 +255,9 @@
                (debug nil)
                (use-thread nil) &allow-other-keys)
   (setf *storage* (load-data data))
+  (setf *storage-users* (gethash :|users| *storage*)
+        *storage-locations* (gethash :|locations| *storage*)
+        *storage-visits* (gethash :|visits| *storage*))
   (format t "Loaded ~A~%" data)
   (apply #'clack:clackup
          (myway:to-app *mapper*)