fix content-encoding via content-length

.dockerignore

@@ -0,0 +1,5 @@
+.git
+data*.zip
+data/
+hlcupdocs/
+logs/

.gitignore

@@ -1,4 +1,4 @@
-__MACOSX/
-data.zip
+data*.zip
 data/
 hlcupdocs/
+logs/

Dockerfile

@@ -1,13 +1,43 @@
-FROM ubuntu
-RUN apt-get update && \
-    apt-get install -y gcc make wget sbcl libev-dev && \
-    mkdir -p /opt &&\
-    wget -O /tmp/quicklisp.lisp https://beta.quicklisp.org/quicklisp.lisp && \
-    echo | sbcl --load /tmp/quicklisp.lisp --eval '(quicklisp-quickstart:install :path "/opt/quicklisp")' --eval '(quicklisp:add-to-init-file)' --eval '(sb-ext:quit)'
-
-RUN mkdir -p /opt/quicklisp/local-projects/travels
-ADD travels.asd *.lisp /opt/quicklisp/local-projects/travels/
+FROM debian:latest
+
+ENV SBCL_VERSION 1.3.20
+ENV DOWNLOAD_URL http://prdownloads.sourceforge.net/sbcl
+ENV DOWNLOAD_PACKAGE sbcl-${SBCL_VERSION}-x86-64-linux-binary.tar.bz2
+ENV SHA256_SUM cda8d3f36eaaa52e0bda8042cf2e49a2ca1b71e5076eb78104de012cff91c95d
+
+RUN apt-get update &&\
+    apt-get install -y \
+      bzip2 \
+      gcc \
+      git \
+      curl \
+      make \
+      libev-dev &&\
+    cd /tmp &&\
+    curl -OL $DOWNLOAD_URL/$DOWNLOAD_PACKAGE &&\
+    echo "$SHA256_SUM $DOWNLOAD_PACKAGE" | sha256sum -c &&\
+    tar xvf ${DOWNLOAD_PACKAGE} &&\
+    cd sbcl-${SBCL_VERSION}-x86-64-linux &&\
+    INSTALL_ROOT=/usr sh install.sh &&\
+    mkdir -p /usr/local/lib &&\
+    ln -s /usr/lib/sbcl /usr/local/lib/sbcl &&\
+    rm -rf /tmp/sbcl* &&\
+    rm -rf /var/lib/apt/lists/* && \
+    cd ~ &&\
+    echo "Finished installing SBCL. Now it's time for Quicklisp." &&\
+    curl -o /tmp/quicklisp.lisp https://beta.quicklisp.org/quicklisp.lisp &&\
+    echo | sbcl --load /tmp/quicklisp.lisp --eval '(quicklisp-quickstart:install :path "/opt/quicklisp")' --eval '(quicklisp:add-to-init-file)' --eval '(sb-ext:quit)' &&\
+    mkdir -p /opt/quicklisp/local-projects/travels
+
+WORKDIR /opt/quicklisp/local-projects/
+RUN git clone https://github.com/fukamachi/woo.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 &&\
+    git clone https://github.com/fukamachi/quri.git
+
+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\")"]

travels.lisp

@@ -51,7 +51,14 @@
 
 (defparameter +400+ '(400 nil nil))
 (defparameter +404+ '(404 nil nil))
-(defparameter +200-empty+ '(200 (:content-type "application/json") ("{}")))
+(defparameter +200-empty+ '(200 (:content-type "application/json" :content-length 2) ("{}")))
+(defun 200-json (data)
+  (declare (optimize (speed 3) (safety 0))
+           (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))))
 
 (defun get-entity (params)
   (let ((id (parse-integer (getf params :id) :junk-allowed t))
@@ -61,11 +68,18 @@
           ((:|users| :|visits| :|locations|)
            (let ((entity (gethash id (gethash entity *storage*))))
              (if entity
-                 `(200 (:content-type "application/json") (,(jojo:to-json entity)))
+                 (200-json entity)
                  +404+)))
           (otherwise +404+))
         +404+)))
 
+(defun validate-item (item)
+  (declare (type list item)
+           (optimize (speed 3) (safety 0)))
+  (loop for (k v) on item by #'cddr
+     unless v return nil
+     finally (return t)))
+
 (defun post-entity (params)
   (let ((id (parse-integer (getf params :id) :junk-allowed t))
         (entity (getkey params :entity)))
@@ -79,22 +93,27 @@
                                       :external-format :utf8))
                  (let ((item (jojo:parse body))
                        (entity-storage (gethash entity *storage*)))
-                   (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+))
-                       (progn
-                         (when (eq entity :|visits|)
-                           (update-indexes *storage* nil item))
-                         (setf (gethash (getf item :|id|) entity-storage) item)
-                         +200-EMPTY+))))
+                   (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+))))
+                       +400+)))
              (error () +400+)))
           (otherwise +404+))
         +400+)))
@@ -144,7 +163,7 @@
                                                           :|visited_at| (getf visit :|visited_at|)
                                                           :|place| (getf loc :|place|)))))
                         (sort user-visits #'< :key (lambda (v) (getf v :|visited_at|)))
-                        `(200 (:content-type "application/json") (,(jojo:to-json (list :|visits| user-visits)))))))
+                        (200-json (list :|visits| user-visits)))))
                 (error () +400+))
               +404+))
         +404+)))
@@ -204,11 +223,10 @@
                                       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|))))
-                        `(200 (:content-type "application/json")
-                              (,(jojo:to-json (list :|avg|
-                                                    (if marks
-                                                        (/ (apply #'+ marks) (length marks))
-                                                        0.0))))))))
+                        (200-json (list :|avg|
+                                        (if marks
+                                            (/ (apply #'+ marks) (length marks))
+                                            0.0))))))
                 (error () +400+))
               +404+))
         +404+)))