~benaiah/fennel-openresty

1cc043525c44145a67adff0e4efa56ac16273c90 — Benaiah Mischenko 2 years ago 70d93ed
this was really messy
M .gitignore => .gitignore +1 -0
@@ 2,4 2,5 @@
*_temp
server/*.lua
app/src/*.lua
app/src/**/*.lua
app/node_modules
\ No newline at end of file

M Dockerfile => Dockerfile +14 -7
@@ 8,16 8,20 @@ COPY . /app

EXPOSE 80

# Setup nginx config
RUN echo "include /app/nginx/conf/nginx.conf;" > /etc/nginx/nginx.conf \
    && echo "include /app/nginx/conf/nginx.conf;" > /usr/local/openresty/nginx/conf/nginx.conf

    
# Install tooling from apt, including OpenResty Package Manager
RUN DEBIAN_FRONTEND=noninteractive apt-get update \
    && DEBIAN_FRONTEND=noninteractive apt-get install -y --no-install-recommends \
       apt-utils make openresty-opm rlwrap wget

# Add fennel to PATH
RUN printf '#!/usr/bin/env bash\nexec rlwrap /app/modules/fennel/fennel "$@"\n' | tee /usr/local/bin/fennel \
    && chmod +x /usr/local/bin/fennel

# Install node
ENV NVM_DIR /usr/local/nvm
ENV NODE_VERSION 10.15.1
RUN mkdir $NVM_DIR \


@@ 29,6 33,7 @@ RUN mkdir $NVM_DIR \
ENV NODE_PATH $NVM_DIR/v$NODE_VERSION/lib/node_modules
ENV PATH $NVM_DIR/versions/node/v$NODE_VERSION/bin:$PATH

# Install yarn (node package installer, npm alternative)
RUN curl -sS https://dl.yarnpkg.com/debian/pubkey.gpg | DEBIAN_FRONTEND=noninteractive apt-key add - \
    && echo "deb https://dl.yarnpkg.com/debian/ stable main" | tee /etc/apt/sources.list.d/yarn.list \
    && DEBIAN_FRONTEND=noninteractive apt-get remove -y cmdtest \


@@ 36,13 41,15 @@ RUN curl -sS https://dl.yarnpkg.com/debian/pubkey.gpg | DEBIAN_FRONTEND=noninter
    && DEBIAN_FRONTEND=noninteractive apt-get update \
    && DEBIAN_FRONTEND=noninteractive apt-get install -y --no-install-recommends yarn

# Install opm packages
RUN opm get leafo/pgmoon && opm get SkyLothar/lua-resty-jwt

# openresty doesn't have any program named "lua" by default, but the
# fennel script uses that as its shebang. luajit works just fine to
# run fennel.
# OpenResty doesn't have any program named "lua" by default, but the
# fennel script uses that as its shebang. LuaJit works just fine to
# run fennel in the build process.
RUN ln -sf /usr/local/openresty/luajit/bin/luajit /usr/local/bin/lua \
    && make
    
RUN ln -sf /dev/stdout /app/nginx/logs/access.log \
    && ln -sf /dev/stderr /app/nginx/logs/error.log

# Setup nginx logs
# RUN ln -sf /app/nginx/logs/access.log /dev/stdout \
#     && ln -sf /app/nginx/logs/error.log /dev/stderr

M app/makefile => app/makefile +8 -5
@@ 10,14 10,17 @@ clean:

dist/app.html: src/app.html.fnl
	modules/fennel/fennel $< > $@
dist/app.js: src/react-helpers.lua src/app.lua src/index.js
dist/app.js: src/react-helpers.lua src/http-helpers.lua src/app.lua src/index.js
	yarn && yarn run build
COMPONENTS_SRC = $(wildcard src/components/*.fnl)
COMPONENTS_OBJ = $(patsubst src/components/%.fnl, src/components/%.lua, $(COMPONENTS_SRC))
src/components/%.lua: src/components/%.fnl
lib/fennel/fennelview.lua: lib/fennel/fennelview.fnl
	modules/fennel/fennel --compile $< > $@
src/app.lua: src/app.fnl src/react-macros.fnl $(COMPONENTS_OBJ)
src/react-helpers.lua: src/react-helpers.fnl
	modules/fennel/fennel --compile $< > $@
src/react-helpers.lua: src/react-helpers.fnl src/react-macros.fnl
src/http-helpers.lua: src/http-helpers.fnl
	modules/fennel/fennel --compile $< > $@
src/components/%.lua: src/components/%.fnl src/react-macros.fnl
	modules/fennel/fennel --compile $< > $@
src/app.lua: src/app.fnl src/react-macros.fnl $(COMPONENTS_OBJ)
	modules/fennel/fennel --compile $< > $@


A app/modules => app/modules +1 -0
@@ 0,0 1,1 @@
../modules
\ No newline at end of file

M app/src/app.fnl => app/src/app.fnl +269 -74
@@ 1,96 1,291 @@
(require-macros :src.react-macros)
(local React (require "react"))
(local ReactDOM (require "react-dom"))
(local React (require :react))
(local ReactDOM (require :react-dom))
(local lume (require "./lib/lume.lua"))
(local merge lume.merge)
(local fennelview (require "./lib/fennelview.lua"))
(fn fennelview-oneline [thing options]
  (let [result
        (string.gsub
         (fennelview thing (merge (or options {}) {:indent ""}))
         "\n" " ")]
    result))
(local ljson (require "./lib/json.lua"))
(local <> React.Fragment)
(local {:use-state use-state
        :use-reducer use-reducer
        :use-effect use-effect
        :use-layout-effect use-layout-effect
        :use-ref use-ref
        :use-previous use-previous
        :create-context create-context
        :use-context use-context
        :get-children-as-array get-children-as-array}
        :create-context create-context}
       (require "./react-helpers.lua"))
(local Log (require "./components/Log.lua"))

(local console {:log (fn [...] (: js.global.console :log ...))})

(component! WebSocketDebugForm
  [{:connect connect :disconnect disconnect :on-message on-message}]
  (let [input-element (use-ref nil)
        (current-message set-current-message) (use-state "")
        maybe-prev-message (use-previous current-message)
        prev-message (if maybe-prev-message maybe-prev-message "")]
    (use-effect
     (fn [] (when input-element.current (: input-element.current :focus)) nil))
    (c! [:div {}
         [:form {:onSubmit
                 (fn [_ e]
                   (: e :preventDefault)
                   (on-message current-message)
                   (set-current-message ""))}
          [:button {:type :button :onClick connect} :Connect]
          [:button {:type :button :onClick disconnect} :Disconnect]
          [:input {:id :text
                   :type :text
                   :value current-message
                   :ref input-element
                   :onChange
                   (fn [] (set-current-message input-element.current.value))
                   }]
          [:button {:type :submit} :Send]]])))
(local DispatchContext (require "./components/DispatchContext.lua"))
(local AppHeader (require "./components/AppHeader.lua"))
(local LoginForm (require "./components/LoginForm.lua"))
(local WebSocketDebugForm
       (require "./components/WebSocketDebugForm.lua"))
(local ScrollingContainer
       (require "./components/ScrollingContainer.lua"))
(local LogLine (require "./components/LogLine.lua"))

(local console {:log (fn [...] (: js.global.console :log ...))
                :error (fn [...] (: js.global.console :error ...))
                :group
                (fn [...] (: js.global.console :groupCollapsed ...))
                :group-end
                (fn [...] (: js.global.console :groupEnd ...))})

(local Promise js.global.Promise)
(local JSON js.global.JSON)

(fn map-to-js [seq fun]
  (local ret (js! []))
  (each [i el (pairs seq)]
    (let [key (if (= (type i) :number) (- i 1) i)]
      (tset ret key (fun el i))))
  ret)

(local initial-app-state
       {:user {:loading? nil
               :email nil
               :id nil
               :token nil
               :from-cache? nil}
        :ws {:connected? nil :authenticated? nil}
        :log-messages []})

(fn first-line-of [str] (. (lume.split str "\n") 1))
(fn get-action-preview [a]
  (let [{:type t} a]
    (match t
      :login-complete (.. t ": " (first-line-of a.user.email))
      :log-message (.. t ": " (first-line-of a.message))
      nil "<unknown action>"
      _ t)))

;; can return an optional second value, which indicates how to merge
;; the new state. this defaults to :merge which performs a shallow
;; merge with the current state. it can be set to :replace to replace
;; the entire state instead.
(local concat lume.concat)
(fn get-action-patch [s a]
  (match a.type
    :login-begin
    {:user {:loading? true}}
    :login-complete
    {:user (merge s.user a.user
                  {:loading? false :from-cache? false})}
    :login-failed
    {:user {:err a.err}}
    :logout
    (values (merge initial-app-state {:user {:clear-cache true}})
            :replace)
    
    :user-restored
    {:user (merge s.user a.user {:from-cache? true})}
    :user-unrestorable
    {:user (merge s.user {:from-cache? false})}
    :user-cache-cleared
    {:user {:clear-cache false :from-cache? false}}

    :ws-connecting
    {:ws {:connection a.ws :connecting? true}}
    :ws-connected
    {:ws (merge s.ws {:connected? true :connecting? false})}
    :ws-disconnected
    {:ws {}}
    :ws-authenticated
    {:ws (merge s.ws {:authenticated? true})}

    :log-message
    {:log-messages (concat s.log-messages
                           [{:message a.message
                             :message-type a.message-type}])}

    _ {}))

(fn app-reducer [state action]
  (console.group (get-action-preview action))
  (print (.. "action: " (fennelview action)))
  (let [(state-patch state-action) (get-action-patch state action)
        state-action (or state-action :merge)
        new-state
        (if (= state-action :merge) (merge state state-patch)
            (= state-action :replace) state-patch
            state)]
    (console.group "old state")
    (print (fennelview state))
    (console.group-end)
    (console.group "new state")
    (print (fennelview new-state))
    (console.group-end)
    (console.group-end)
    (set js.global.fennel_openresty_state new-state)
    new-state))

(fn log-with [dispatch message-type message]
  (let [m-type (or message-type :info)]
    (if (and message-type (not message))
        (dispatch {:type :log-message
                   :message message-type
                   :message-type :info})

        (and message-type message)
        (dispatch {:type :log-message
                   :message message
                   :message-type message-type})
        
        dispatch
        (fn [a-message a-message-type]
          (log-with dispatch a-message a-message-type))
        

        log-with)))

(fn create-websocket
  [{:ws-url ws-url
  [{:url url
    :on-open onopen
    :on-close onclose
    :on-error onerror
    :on-message onmessage}]
  (let [ws (js.new js.global.WebSocket ws-url)]
  (let [ws (js.new js.global.WebSocket url)]
    (set ws.onopen onopen)
    (set ws.onerror onerror)
    (set ws.onmessage onmessage)
    (set ws.onclose onclose)
    ws))

(local ws-url "ws://localhost:8090/wss")
(fn ws-when-open [state-ref dispatch e]
  (let [state state-ref.current]
    (when state
      (log-with dispatch :info "connected")
      (dispatch {:type :ws-connected})
      (when state.user.token
        (: state.ws.connection :send
           (: JSON :stringify
              (js! {:action :auth :token state.user.token})))))))

(fn ws-when-error [_ dispatch event]
  (log-with dispatch :info "websocket error!")
  (dispatch {:type :ws-disconnected}))

(fn ws-when-message [_ dispatch event]
  (let [decoded-message (ljson.decode event.data)
        log (log-with dispatch)]
    (match decoded-message
      nil (log :info "received message without valid JSON!")

      {:re :auth :action :success}
      (dispatch {:type :ws-authenticated})

      {:re :compile :action :success :value value}
      (log :reply value)

      _ (log :info (.."unrecognized message: " event.data)))))

(fn ws-when-close [_ dispatch event]
  (log-with dispatch :info (.. "disconnected: " (or event.reason "")))
  (dispatch {:type :ws-disconnected}))

(local ws-url "ws://localhost:8080/wss")
(fn ws-connect [state dispatch callbacks]
  (let [log (log-with dispatch)]
    (if state.ws.connected? (log :info "already connected")
        state.ws.connecting? (log :info "already connecting")
        (dispatch {:type :ws-connecting
                   :ws (create-websocket
                        {:url ws-url
                         :on-open callbacks.open
                         :on-close callbacks.close
                         :on-error callbacks.error
                         :on-message callbacks.message})}))))

(fn ws-disconnect [state dispatch]
  (let [log (log-with dispatch)]
    (if (not (or state.ws.connected? state.ws.connecting?))
        (log :info "already disconnected")
        (do (dispatch {:type :ws-disconnected})
            (: state.ws.connection :close)))))

(fn ws-send-message [state dispatch message]
  (let [log (log-with dispatch)]
    (if (not state.ws.connected?) (log :info "not connected")
        (let [json-message
              (ljson.encode {:action :compile :src message})]
          (log :send message)
          (: state.ws.connection :send json-message)))))

(fn ws-get-callbacks [state-ref dispatch]
  {:open (fn [_ e] (ws-when-open state-ref dispatch e))
   :error (fn [_ e] (ws-when-error state-ref dispatch e))
   :message (fn [_ e] (ws-when-message state-ref dispatch e))
   :close (fn [_ e] (ws-when-close state-ref dispatch e))})

(local container-style
       (js! {:backgroundColor :#444
             :color :#eee
             :minHeight :100vh
             :fontFamily :sans-serif}))

(local inner-container-style
       (js! {:paddingLeft :1em
             :paddingRight :1em}))

(fn use-cached-user [state dispatch]
  (use-effect
   (fn []
     (local ls js.global.localStorage)
     (if (not state.user.token)
         (let [cached-user (: ls :getItem :fennel-openresty-user)
               parsed-user
               (when (and cached-user
                          (not (= cached-user js.null)))
                 (ljson.decode cached-user))]
           (if state.user.clear-cache
               (do (: ls :removeItem :fennel-openresty-user)
                   (dispatch {:type :user-cache-cleared}))
               parsed-user
               (dispatch {:type :user-restored :user parsed-user})
               (dispatch {:type :user-unrestorable})))
         (: ls :setItem :fennel-openresty-user
            (ljson.encode state.user))))
   (js! [(or state.user.token js.null)])))

(fn render-messages [messages]
  (c! ScrollingContainer {}
      (map-to-js
       messages
       (fn [msg i]
         (c! LogLine
             {:key i :message-type msg.message-type}
             msg.message)))))

(component! App []
  (let [(log-messages set-log-messages) (use-state (js! []))
        (pending-messages set-pending-messages) (use-state (js! []))
        (ws set-ws) (use-state nil)
        log (fn [message]
              (console.log message)
              (set-log-messages
               (fn [_ prev-messages] (: prev-messages :concat message))))
        ws-on-open (fn [] (log "connected"))
        ws-on-error (fn [] (log "websocket error!"))
        ws-on-message (fn [_ e] (log (.. "recv: " e.data)))
        ws-on-close (fn [_ e]
                      (log (.."disconnected: " (if e.reason e.reason "")))
                      (set-ws nil))
        connect
        (fn []
          (if ws (log "already connected")
              (set-ws (fn [_ ws]
                        (if ws ws
                            (create-websocket
                             {:ws-url ws-url
                              :on-open ws-on-open
                              :on-error ws-on-error
                              :on-message ws-on-message
                              :on-close ws-on-close}))))))
        disconnect (fn [] (print "App.disconnect")
                     (if (not ws) (log "already disconnected") (: ws :close)))
        send-message (fn [message] (print "App.send-message")
                       (if (not ws) (log "please connect first")
                           (log (.. "send: " message) (: ws :send message))))
        debug-form (c! [WebSocketDebugForm {:connect connect
                                            :disconnect disconnect
                                            :on-message send-message}])]
    (c! [<> {}
         [:div {} (if ws "WebSocket connected" "Websocket not connected")]
         debug-form
         [Log {} log-messages]])))
  (let [(state dispatch) (use-reducer app-reducer initial-app-state)
        state-ref (use-ref nil)
        _ (set state-ref.current state)
        log (fn [...] (log-with dispatch ...))
        ws-callbacks (ws-get-callbacks state-ref dispatch)
        connect (fn [] (ws-connect state dispatch ws-callbacks))
        disconnect (fn [] (ws-disconnect state dispatch))
        send-message (fn [m] (ws-send-message state dispatch m))]
    (use-cached-user state dispatch)
    (c! [DispatchContext.Provider {:value dispatch}
         [:div {:style container-style}
          [AppHeader {:user state.user}]
          [:div {:style inner-container-style}
           (if (= state.user.from-cache? nil) (c! <> {})
               state.user.token
               (c! [<> {}
                    [:div {}
                     (if state.ws.connected?
                         "WebSocket connected"
                         "WebSocket not connected")]
                    [WebSocketDebugForm
                     {:connect connect
                      :disconnect disconnect
                      :on-message send-message}]
                    (render-messages state.log-messages)])
               (c! LoginForm {:loading? state.user.loading?}))]]])))

(: ReactDOM :render
   (c! App {})

M app/src/app.html.fnl => app/src/app.html.fnl +8 -4
@@ 19,9 19,9 @@
             (let [attr-str (table.concat (map-kv to-attr attrs) " ")]
               (.. "<" tag-name " " attr-str">"))))

(fn html [doc]
  (if (= (type doc) "string")
      doc
(fn html [doctype]
  (if (= (type doctype) "string")
      doctype
      (let [[tag-name attrs & body] doc]
        (.. (tag tag-name attrs)
            (table.concat (map html body) " ")


@@ 32,7 32,11 @@
           (html [:html {}
                  [:head {}
                   [:meta {:charset "UTF-8"}]]
                  [:body {}
                  [:style {}
                   (.. "body {margin:0;}"
                       " html {box-sizing: border-box;}"
                       " *, *:before, *:after {box-sizing: inherit;}")]
                  [:body {:style "margin:0;"}
                   [:div {:id :react-root}]
                   [:script {:src "app.js"}]]])))


A app/src/components/AppHeader.fnl => app/src/components/AppHeader.fnl +34 -0
@@ 0,0 1,34 @@
(require-macros :src.react-macros)
(local React (require :react))
(local {:use-context use-context} (require "../react-helpers.lua"))
(local DispatchContext (require "./DispatchContext.lua"))

(local header-style
       (js! {:width :100%
             :backgroundColor :#222222
             :color :#EEEEEE
             :paddingLeft :1em
             :paddingRight :1em
             :paddingTop :1ex
             :paddingBottom :1ex
             :marginBottom :2ex
             :height :37px
             :display :flex
             :flexFlow "row nowrap"
             :justifyContent :space-between
             :alignItems :center}))

(component! AppHeader [{:user user}]
  (let [dispatch (use-context DispatchContext)]
    (c! [:div {:style header-style}
         [:span {}
          (if (= user.from-cache? nil) ""
              user.loading? "Logging in..."
              user.token (if user.email user.email "<unknown email>")
              "Logged out")]
         (when user.token
             (c! [:a {:href "#"
                      :onClick (fn [] (dispatch {:type :logout}))}
                  :Logout]))])))

AppHeader

A app/src/components/DispatchContext.fnl => app/src/components/DispatchContext.fnl +4 -0
@@ 0,0 1,4 @@
(local {:create-context create-context}
       (require "../react-helpers.lua"))

(create-context)

D app/src/components/Log.fnl => app/src/components/Log.fnl +0 -29
@@ 1,29 0,0 @@
(require-macros :src.react-macros)
(local React (require "react"))
(local {:use-effect use-effect
        :use-ref use-ref
        :get-children-as-array get-children-as-array}
       (require "../react-helpers.lua"))
(local LogLine (require "./LogLine.lua"))

(component! Log [{:children maybe-children}]
  (let [children (get-children-as-array maybe-children)
        container-ref (use-ref nil)]
    ;; scroll to bottom on change
    (use-effect
     (fn []
       (when (and container-ref.current
                  (not (= container-ref.current js.null))
                  container-ref.current.lastChild
                  (not (= container-ref.current.lastChild js.null)))
         (: container-ref.current.lastChild :scrollIntoView (js! {}))))
     (js! [children.length]))
    (c! :div {:style {:color :#EEEEEE
                      :backgroundColor :#222222
                      :overflowY :scroll
                      :width :100%
                      :height "calc(100vh - 200px)"}
              :ref container-ref}
        (: children :map (fn [_ child i] (c! LogLine {:key i} child))))))

Log

M app/src/components/LogLine.fnl => app/src/components/LogLine.fnl +57 -2
@@ 1,7 1,62 @@
(require-macros :src.react-macros)
(local React (require "react"))

(component! LogLine [{:children message}]
  (c! :pre {:className :log-message} message))
(local bubble-style
       (js! {:position :relative
             :backgroundColor :#555555
             :borderRadius :.4em
             :marginBottom :1em
             :padding "1em 1em"
             :whiteSpace :pre}))

(local bubble-inner-style
       (js! {:overflowX :auto
             :width :100%
             :height :100%}))

(local after-left-bubble-style
       (js! {:position :absolute
             :left 0
             :top :50%
             :width 0
             :height 0
             :borderTop "0.625em solid transparent"
             :borderRight "0.625em solid #555555"
             :borderLeft 0
             :borderBottom 0
             :marginTop :-0.312em
             :marginLeft :-0.625em}))

(local after-right-bubble-style
       (js! {:position :absolute
             :right 0
             :top :50%
             :width 0
             :height 0
             :borderTop "0.625em solid transparent"
             :borderLeft "0.625em solid #555555"
             :borderRight 0
             :borderBottom 0
             :marginTop :-0.312em
             :marginRight :-0.625em}))

(local info-style
       (js! {:fontSize :75%
             :textAlign :center
             :color :#DDDDDD
             :marginBottom :1em}))

(component! LogLine [{:children message :message-type message-type}]
  (c! :div {}
      (if (or (not message-type) (= message-type :info))
          (c! :div {:style info-style} message)

          (or (= message-type :send) (= message-type :reply))
          (c! [:div {:style bubble-style}
               [:div {:style bubble-inner-style} message]
               [:div {:style
                      (if (= message-type :reply)
                          after-right-bubble-style
                          after-left-bubble-style)}]]))))

LogLine

A app/src/components/LoginForm.fnl => app/src/components/LoginForm.fnl +77 -0
@@ 0,0 1,77 @@
(require-macros :src.react-macros)
(local React (require "react"))
(local jwtDecode (require "jwt-decode"))
(local jwt-decode (fn [token] (jwtDecode nil token)))
(local {:then then
        :fetch-json fetch-json} (require "../http-helpers.lua"))
(local {:use-state use-state
        :use-context use-context} (require "../react-helpers.lua"))
(local DispatchContext (require "./DispatchContext.lua"))

(local console {:log (fn [...] (: js.global.console :log ...))
                :error (fn [...] (: js.global.console :error ...))})

(local JSON js.global.JSON)

(fn perform-login [dispatch {:email email :password password}]
  (dispatch {:type :login-begin})
  (-> (fetch-json
       "/api/authenticate"
       (js! {:method :POST
             :body (: JSON :stringify
                      (js! {:email email :password password}))}))
      (then (fn [{:token token}]
              (let [{:email email :sub id :confirmed confirmed}
                    (jwt-decode token)]
                {:token token :email email
                 :id id :confirmed confirmed})))
      (then (fn [user]
              (dispatch {:type :login-complete :user user}))
            (fn [err]
              (dispatch {:type :login-failed :err err})))))

(component! Input
  [{:type input-type :label label :onChange onChange :value value}]
  (local input
         (c! :input {:type input-type
                     :value value
                     :onChange onChange
                     :style {:width :auto}}))
  (c! :div {}
      (if label
          (c! [:label {:style {:display :block}}
               [:span {:style {:width :100px
                               :display :inline-block}} label " "]
               input])
          input)))

(component! LoginForm [{:loading? loading?}]
  (let [dispatch (use-context DispatchContext)
        (current-email set-current-email) (use-state "")
        (current-password set-current-password) (use-state "")
        (logging-in? set-logging-in) (use-state false)]
    (if loading?
        (c! [:div {:style {:marginBottom :50px}} "Logging in..."])
        (c! [:form
             {:className :login
              :style {:marginBottom :50px}
              :onSubmit
              (fn [_ e]
                (when (not loading?)
                  (perform-login
                   dispatch {:email current-email
                             :password current-password})))}
             [:p {} "Please log in: "]
             [Input {:label :Email:
                     :type :email
                     :value current-email
                     :onChange (fn [_ {:target {:value v}}]
                                    (set-current-email v))}]
             [Input {:label :Password:
                     :type :password
                     :value current-password
                     :onChange (fn [_ {:target {:value v}}]
                                    (set-current-password v))}]
             [:button {:type :submit} :Login]]))))

LoginForm

A app/src/components/ScrollingContainer.fnl => app/src/components/ScrollingContainer.fnl +35 -0
@@ 0,0 1,35 @@
(require-macros :src.react-macros)
(local React (require "react"))
(local {:use-effect use-effect
        :use-ref use-ref}
       (require "../react-helpers.lua"))
(local LogLine (require "./LogLine.lua"))

;; scrolls to the last child of container-ref.current when deps change
(fn use-scroll-to-last-child [deps]
  (let [container-ref (use-ref nil)]
    (use-effect
     (fn []
       (when (and container-ref.current
                  (not (= container-ref.current js.null))
                  container-ref.current.lastChild
                  (not (= container-ref.current.lastChild js.null)))
         (: container-ref.current.lastChild
            :scrollIntoView (js! {}))))
     deps)
    container-ref))

(component! ScrollingContainer [{:children children}]
  (let [container-ref (use-scroll-to-last-child
                       (js! [(or (and children children.length) 0)]))]
    (c! :div {:style {:overflowY :auto
                      :width :100%
                      :height "calc(100vh - 200px)"
                      :marginBottom 0
                      :marginTop :1rem
                      :padding "0 1rem"
                      :paddingBottom :1rem}
              :ref container-ref}
        children)))

ScrollingContainer

D app/src/components/TestComponent.fnl => app/src/components/TestComponent.fnl +0 -4
@@ 1,4 0,0 @@
(require-macros :src.react-macros)

(component! TestComponent []
  (c! [:div {} "Hello, world!"]))

A app/src/components/WebSocketDebugForm.fnl => app/src/components/WebSocketDebugForm.fnl +35 -0
@@ 0,0 1,35 @@
(require-macros :src.react-macros)
(local React (require :react))
(local {:use-state use-state
        :use-ref use-ref
        :use-effect use-effect} (require "../react-helpers.lua"))

(component! WebSocketDebugForm
  [{:connect connect :disconnect disconnect :on-message on-message}]
  (let [input-element (use-ref nil)
        (current-message set-current-message) (use-state "")]
    (use-effect
     (fn []
       (when input-element.current (: input-element.current :focus))
       nil))
    (c! [:form {:onSubmit
                (fn [_ e]
                  (: e :preventDefault)
                  (on-message current-message)
                  (set-current-message ""))}
         [:div {}
          [:button {:type :button :onClick connect} :Connect]
          [:button {:type :button :onClick disconnect} :Disconnect]]
         [:div {}
          [:textarea {:style {:width :100%
                              :minWidth :100%
                              :height :50px}
                      :value current-message
                      :ref input-element
                      :onChange
                      (fn [] (set-current-message
                              input-element.current.value))}]]
         [:div {:className :buttons}
          [:button {:type :submit} :Send]]])))

WebSocketDebugForm

A app/src/http-helpers.fnl => app/src/http-helpers.fnl +24 -0
@@ 0,0 1,24 @@
(local Promise js.global.Promise)

(fn then [p f c] (: p :then (fn [_ a] (f a))
                    (when c (fn [_ a] (c a)))))

;; assumes all responses, even errors, contain a json body. rejects
;; http errors.
(fn fetch [url options] (: js.global :fetch url options))

(fn get-json-fetcher [fetch-fn]
  (fn [...]
    (then (fetch ...)
          (fn [res]
            (then (: res :json)
                  (fn [json]
                    (if res.ok json
                        (: Promise :reject
                           {:res res :err json}))))))))
(local fetch-json (get-json-fetcher fetch))

{:then then
 :fetch fetch
 :get-json-fetcher get-json-fetcher
 :fetch-json fetch-json}

A app/src/modules => app/src/modules +1 -0
@@ 0,0 1,1 @@
../modules
\ No newline at end of file

M app/src/react-helpers.fnl => app/src/react-helpers.fnl +16 -2
@@ 8,6 8,13 @@
        set-state (. val 1)]
    (values state (fn [new-state] (set-state nil new-state)))))

(fn use-reducer [reducer initial]
  (let [val (React.useReducer
             nil (fn [_ ...] (reducer ...)) initial)
        state (. val 0)
        dispatch (fn [...] ((. val 1) nil ...))]
    (values state dispatch)))

(fn use-ref [initial] (React.useRef nil initial))

(fn create-context [initial] (React.createContext nil initial))


@@ 24,12 31,19 @@
    (use-effect (fn [] (set ref.current value)))
    ref.current))

(fn table-to-array [tab]
  (local ret (js! []))
  (each [_ el (ipairs tab)]
    (: ret :push el))
  ret)

(fn get-children-as-array [maybe-children]
  (if (: js.global.Array :isArray maybe-children)
      maybe-children
  (if (: js.global.Array :isArray maybe-children) maybe-children
      (= (type maybe-children) :table) (table-to-array maybe-children)
      (js! [maybe-children])))

{:use-state use-state
 :use-reducer use-reducer
 :use-effect use-effect
 :use-layout-effect use-layout-effect
 :use-ref use-ref

M app/src/react-macros.fnl => app/src/react-macros.fnl +19 -19
@@ 10,15 10,15 @@
          dolist `(do)]
      (if (sequence? val)
          (do
            (push dolist `(local @RETURN (js.new js.global.Array)))
            (push dolist `(local ,RETURN (js.new js.global.Array)))
            (each [i v (ipairs val)]
              (push dolist `(tset @RETURN @(- i 1) @(js! v))))
              (push dolist `(tset ,RETURN ,(- i 1) ,(js! v))))
            (push dolist RETURN)
            dolist)

          (do (push dolist `(local @RETURN (js.new js.global.Object)))
          (do (push dolist `(local ,RETURN (js.new js.global.Object)))
              (each [k v (pairs val)]
                (push dolist `(tset @RETURN @(tostring k) @(js! v))))
                (push dolist `(tset ,RETURN ,(tostring k) ,(js! v))))
              (push dolist RETURN)
              dolist)))
    val))


@@ 29,10 29,10 @@
        children [...]
        child-list []]
    (each [i v (ipairs children)]
      (push child-list `@(js! v)))
    `(do (local @ATTRS @(js! (or attrs {})))
         (: React :createElement @el @ATTRS
            @(unpack child-list)))))
      (push child-list `,(js! v)))
    `(do (local ,ATTRS ,(js! (or attrs {})))
         (: React :createElement ,el ,ATTRS
            ,(unpack child-list)))))

(fn c! [arg1 ...]
  (if (sequence? arg1)


@@ 60,18 60,18 @@
        fun (gensym)
        index-fun (gensym)
        new-index-fun (gensym)]
    `(local @name
            (let [@fun (fn [_ _ @(unpack args)] @...)
                  @tab {:displayName @(tostring name)
                        :name @(tostring name)
                        :length @(# args)}
                  @index-fun (fn [_ @key] (rawget @tab @key))
                  @new-index-fun (fn [_ @key @val] (rawset @tab @key @val))]
    `(local ,name
            (let [,fun (fn [_# _# ,(unpack args)] ,...)
                  ,tab {:displayName ,(tostring name)
                        :name ,(tostring name)
                        :length ,(# args)}
                  ,index-fun (fn [_# ,key] (rawget ,tab ,key))
                  ,new-index-fun (fn [_# ,key ,val] (rawset ,tab ,key ,val))]
              (setmetatable
               @tab {:__index @index-fun
                     :__newindex @new-index-fun
                     :__call @fun})
              (js.createproxy @tab :arrow_function)))))
               ,tab {:__index ,index-fun
                     :__newindex ,new-index-fun
                     :__call ,fun})
              (js.createproxy ,tab :arrow_function)))))


{:js! js!

M app/yarn.lock => app/yarn.lock +5 -0
@@ 1474,6 1474,11 @@ json5@^1.0.1:
  dependencies:
    minimist "^1.2.0"

jwt-decode@^2.2.0:
  version "2.2.0"
  resolved "https://registry.yarnpkg.com/jwt-decode/-/jwt-decode-2.2.0.tgz#7d86bd56679f58ce6a84704a657dd392bba81a79"
  integrity sha1-fYa9VmefWM5qhHBKZX3TkruoGnk=

kind-of@^3.0.2, kind-of@^3.0.3, kind-of@^3.2.0:
  version "3.2.2"
  resolved "https://registry.yarnpkg.com/kind-of/-/kind-of-3.2.2.tgz#31ea21a734bab9bbb0f32466d893aea51e4a3c64"

M db/makefile => db/makefile +1 -0
@@ 5,6 5,7 @@ all: config.lua migrations/create-users-table.lua migrations/create-messages-tab
clean:
	rm -f ./config.lua
	rm -f ./migrations/*.lua
	rm -rf ./data

config.lua: config.fnl
	../modules/fennel/fennel --compile $< > $@

M db/migrations/create-messages-table.fnl => db/migrations/create-messages-table.fnl +3 -2
@@ 1,11 1,12 @@
(local pgmoon (require :pgmoon))
(local dbconfig (require :db.config))
(local fennelview (require :modules.fennel.fennelview))
(local pg (pgmoon.new dbconfig))

(local pg-status (assert (: pg :connect)))

(local messages-created (assert (: pg :query "
create table messages (
create table if not exists messages (
  id bigserial primary key,
  message text,
  response text,


@@ 13,6 14,6 @@ create table messages (
);
")))

(print (.. "creating messages table - success?: " messages-created))
(print (.. "creating messages table - success?: " (fennelview messages-created)))

messages-created

M db/migrations/create-users-table.fnl => db/migrations/create-users-table.fnl +14 -3
@@ 9,11 9,22 @@
create extension if not exists pgcrypto;
create table if not exists users (
  id uuid not null default gen_random_uuid() primary key,
  email text not null,
  password text not null
  email text not null unique,
  password text not null,
  confirmed boolean default false
);
")))

(print (.. "creating users table: " (fennelview users-table-created)))

users-table-created
(local test-user-created
       (when users-table-created
         (assert (: pg :query "
insert into users (email, password, confirmed) values (
  'test@example.com',
  crypt('test-password', gen_salt('bf')),
  true
);
"))))

(print (.. "creating test user: " (fennelview test-user-created)))

M docker-compose.yml => docker-compose.yml +1 -1
@@ 5,7 5,7 @@ services:
    depends_on:
      - db
    ports:
      - "8090:80"
      - "8080:80"
    volumes:
      - .:/app
    environment:

M makefile => makefile +2 -1
@@ 5,7 5,7 @@ all: server app db
clean: clean-server clean-app

.PHONY: server
server: server/server.lua server/html.lua server/wss.lua
server: server/server.lua server/html.lua server/wss.lua server/jwt.lua

.PHONY: clean-server
clean-server:


@@ 13,6 13,7 @@ clean-server:

server/server.lua: server/server.fnl ; modules/fennel/fennel --compile $^ > $@
server/html.lua: server/html.fnl ; modules/fennel/fennel --compile $^ > $@
server/jwt.lua: server/jwt.fnl ; modules/fennel/fennel --compile $^ > $@
server/wss.lua: server/wss.fnl ; modules/fennel/fennel --compile $^ > $@

.PHONY: app

M modules/fennel => modules/fennel +1 -1
@@ 1,1 1,1 @@
Subproject commit ae9b079d63d887ef450559fc0d658016f8977528
Subproject commit 687dd94b240f12a636441ebe0a92ddafe8b2fe34

M nginx/conf/nginx.conf => nginx/conf/nginx.conf +10 -0
@@ 5,7 5,13 @@ events {
}
http {
    include /usr/local/openresty/nginx/conf/mime.types;
    lua_package_path "/app/modules/lua-resty-http/lib/?.lua;;";
    access_log /app/nginx/logs/access.log;
    error_log /app/nginx/logs/error.log;
    server {
        set $fennel_proxy_host 'httpbin.org';
        set $fennel_proxy_port '80';
        set $fennel_proxy_path '/get';
        resolver 127.0.0.1;
        listen 80;
        location / {


@@ 19,6 25,10 @@ http {
            content_by_lua_file /app/server/server.lua;
            lua_code_cache off;
        }
        location /proxy {
            resolver 1.1.1.1;
            proxy_pass http://$fennel_proxy_host:$fennel_proxy_port$fennel_proxy_path;
        }
        location /wss {
            content_by_lua_file /app/server/wss.lua;
            lua_code_cache off;

M server/html.fnl => server/html.fnl +4 -4
@@ 24,10 24,10 @@
             (let [attr-str (table.concat (map-kv to-attr attrs) " ")]
               (.. "<" tag-name " " attr-str">"))))

(fn html [doc]
  (if (= (type doc) "string")
      doc
      (let [[tag-name attrs & body] doc]
(fn html [doctype]
  (if (= (type doctype) "string")
      doctype
      (let [[tag-name attrs & body] doctype]
        (.. (tag tag-name attrs)
            (table.concat (map html body) " ")
            "</" tag-name ">"))))

M server/jwt.fnl => server/jwt.fnl +14 -6
@@ 1,15 1,23 @@
(local jwt (require :resty.jwt))
(local jwt-secret (os.getenv :FENNEL_OPENRESTY_JWT_SECRET))

(fn get-jwt-token [{:id id :email email}]
(fn get-token [{:id id :email email :confirmed confirmed}]
  (: jwt :sign jwt-secret
     {:header {:typ :JWT :alg :HS512}
      :payload {:sub id :email email :iat (ngx.time)}}))
      :payload {:sub id
                :email email
                :confirmed confirmed
                :iat (ngx.time)}}))

(fn verify-jwt-token [token]
(fn verify-token [token]
  (let [jwt-obj (: jwt :load_jwt token)]
    (: jwt :verify_jwt_obj jwt-secret jwt-obj)))

(fn verify-token-and-retrieve-payload [token]
  (let [jwt-obj (: jwt :load_jwt token)
        verified? (: jwt :verify_jwt_obj jwt-secret jwt-obj)]
    (when verified? jwt-obj.payload)))
    (if verified? jwt-obj.payload false)))

{:get-token get-jwt-token
 :verify-token verify-jwt-token}
{:get-token get-token
 :verify-token verify-token
 :verify-token-and-retrieve-payload verify-token-and-retrieve-payload}

A server/queries.fnl => server/queries.fnl +0 -0
M server/server.fnl => server/server.fnl +143 -34
@@ 1,73 1,182 @@
(global ngx ngx)
(local pgmoon (require :pgmoon))
(local cjson (require :cjson))
(local html (fn [...] (.. "<!doctype html>" ((require :server.html) ...))))
(local html (fn [...] (.. "<!doctype html>"
                          ((require :server.html) ...))))
(global _G (. (getmetatable _G) :__index))
(local fennel (require :modules.fennel.fennel))
(local fennelview (require :modules.fennel.fennelview))
(local lume (require :modules.lume.lume))
(local jwt (require :server.jwt))

(local merge lume.merge)

(local pg (pgmoon.new (require :db.config)))
(local pg-status (assert (: pg :connect)))

(local (h h-err) (ngx.req.get_headers))
(local (headers headers-err) (ngx.req.get_headers))
(local method (ngx.req.get_method))

(fn say-serialized [tab]
  (if (and h (= h.Accept "text/x-fennelview"))
  (if (and h (= headers.Accept "text/x-fennelview"))
      (do (set ngx.header.Content-Type "text/x-fennelview")
          (ngx.say (fennelview tab {:indent ""})))
      (do (set ngx.header.Content-Type "application/json")
          (ngx.say (cjson.encode tab)))))

;; middleware
(fn jwt-payload-key [] nil)
(fn user-key [] nil)
(fn with-verified-bearer-jwt [route-fn]
  (fn [context]
    (let [verified-payload (get-verified-jwt-payload)]
      (if verified-payload
          (route-fn
           (merge (if context context {})
                  {jwt-payload-key verified-payload
                   user-key {:id verified-payload.sub
                             :email verified-payload.email
                             :confirmed verified-payload.confirmed}}))
          (do (set ngx.status ngx.HTTP_UNAUTHORIZED)
              (say-serialized
               {:error {:message "Not authorized" :code 401}}))))))
(fn with-confirmed-user [route-fn]
  (-> (fn [context]
        (let [{:confirmed confirmed} (. context user-key)]
          (if confirmed (route-fn context)
              (do (set ngx.status ngx.HTTP_UNAUTHORIZED)
                  (say-serialized
                   {:error {:message "User not confirmed"
                            :code 401}})))))
      with-verified-bearer-jwt))


(fn index-route []
  (say-serialized {:authenticate :/api/authenticate}))
  (say-serialized {:authenticate :/api/authenticate
                   :verify :/api/verify
                   :user :/api/user
                   :confirm-signup :/api/confirm-signup}))

(fn unknown-route []
  (let [message (.. "Error 404 - unknown route " ngx.var.uri " for method " method)
  (let [message (.. "Error 404 - unknown route " ngx.var.uri
                    " for method " method)
        response {:error {:message message :code 404}}]
    (set ngx.status ngx.HTTP_NOT_FOUND)
    (say-serialized response)))

;; returns a user id if successful
(fn authenticate-user-by-email [{:email email :password password}]
  (let [esc_email (: pg :escape_literal email)
        esc_password (: pg :escape_literal password)
        query (.. "select id, email from users where"
                     " email=lower(" esc_email ") and"
                     " password=crypt(" esc_password ", password)"
  (let [esc-email (: pg :escape_literal email)
        esc-password (: pg :escape_literal password)
        query (.. "select id, email, confirmed from users where"
                     " email=lower(" esc-email ") and"
                     " password=crypt(" esc-password ", password)"
                     " limit 1;")
        result (: pg :query query)]
    (when (and result (. result 1)) (. result 1))))
    (and result (. result 1))))

(local authenticate-wrong-method-error-message
       (.. "Method not allowed - use a POST with a JSON body including"
           " 'email' and 'password' to log in and receive a JWT which"
           " can be used as a bearer token to authenticate with the rest"
           " of the API."))
       (.. "Method not allowed - use a POST with a JSON body"
           " including 'email' and 'password' to log in and receive a"
           " JWT which can be used as a bearer token to authenticate"
           "  with the rest of the API."))

(fn authenticate-route []
  (match method
    :GET (do (set ngx.status ngx.HTTP_NOT_ALLOWED)
             (say-serialized
              {:error {:message authenticate-wrong-method-error-message
                       :code 405}}))
    :POST (do (ngx.req.read_body)
              (let [raw-body (ngx.req.get_body_data)
                    body (if raw-body (cjson.decode raw-body) {})]
                (if (and body.email body.password)
                    (let [user (authenticate-user-by-email body)]
                      (say-serialized (jwt.get-token user)))
                    (do (set ngx.status ngx.BAD_REQUEST)
                        (say-serialized {:error {:message "Bad request" :code 400}})))))
    _ (unknown-route)))
    :POST
    (do (ngx.req.read_body)
        (let [raw-body (ngx.req.get_body_data)
              body (if raw-body (cjson.decode raw-body) {})]
          (if (and body.email body.password)
              (let [user (authenticate-user-by-email body)]
                (if user
                    (do (say-serialized
                         {:token (jwt.get-token user)}))
                    (do (set ngx.status ngx.HTTP_UNAUTHORIZED)
                        (say-serialized
                         {:error {:message "Unauthorized"
                                  :code 401}}))))
              (do (set ngx.status ngx.HTTP_BAD_REQUEST)
                  (say-serialized
                   {:error {:message "Bad request" :code 400}})))))
    _ (do (set ngx.status ngx.HTTP_NOT_ALLOWED)
          (say-serialized
           {:error {:message authenticate-wrong-method-error-message
                    :code 405}}))))

(fn get-verified-jwt-payload []
  (let [[typ token] (lume.split headers.Authorization " ")]
    (and typ token (= (string.lower typ) "bearer")
         (jwt.verify-token-and-retrieve-payload token))))

(fn verify-route []
  (let [verified-payload (get-verified-jwt-payload)]
    ;; the "not not" construct forces a boolean for serialization
    (say-serialized {:verified (not (not verified-payload))})))

(local
 user-route
 (-> (fn [context]
       (let [{:id id} (. context user-key)
             query (when id
                     (.. "select email from users where id="
                         (: pg :escape_literal id) " limit 1;"))
             result (when query
                      (: pg :query query))
             email (when (and result (. result 1))
                     (. result 1 :email))]
         (if email (say-serialized {:id id :email email})
             (do (set ngx.status ngx.HTTP_NOT_FOUND)
                 (say-serialized {:error {:message "User not found"
                                          :code 404}})))))
     with-verified-bearer-jwt))

(fn signup-route [context]
  (match method
    :POST ))

(fn path-key [] nil)
(fn confirm-signup-route [context]
  (let [path (. context path-key)]
    (match path
      [nil] ;; missing confirmation token error
      (do (set ngx.status ngx.HTTP_BAD_REQUEST)
          (say-serialized {:error {:message "Token missing"
                                   :code 400}}))
      [token nil] nil ;; look up token and confirm user
      _ (do (set ngx.status ngx.HTTP_BAD_REQUEST)
            (say-serialized {:error {:message "Bad URL"
                                     :code 400}})))))

(fn test-httpbin-route []
  (set ngx.var.fennel_proxy_host "httpbin.org")
  (set ngx.var.fennel_proxy_port "80")
  (set ngx.var.fennel_proxy_path "/get?arg1=a")
  (let [res (ngx.location.capture "/proxy" )]
    (if (not res)
        (ngx.say "failed to request: " err)
        (set ngx.header.Content-Type "text/plain")
        (ngx.say res.body))))

(fn get-route [path]
  (match path
    [:api nil] index-route
    [:api :authenticate nil] authenticate-route
    [:api :verify nil] verify-route
    [:api :user nil] user-route
    [:api :confirm-signup] confirm-signup-route
    [:api :test-httpbin nil] test-httpbin-route
    _ unknown-route))

(fn string-ends-with [str ending]
  (or (= ending "") (= (string.sub str (* -1 (# ending))) ending)))

((fn router [uri]
   (let [path (lume.slice (lume.split uri :/) 2)
         route (match path
                 [:api :authenticate nil] authenticate-route
                 [:api nil] index-route
                 _ unknown-route)]
     (route)))
   (let [trimmed-uri (if (string-ends-with uri "/")
                         (string.sub uri 1 -2)
                         uri)
         path (lume.slice (lume.split trimmed-uri :/) 2)
         route (get-route path)
         context {path-key (lume.slice path 3)}]
     (route context)))
 ngx.var.uri)

M server/wss.fnl => server/wss.fnl +92 -19
@@ 1,21 1,29 @@
(global ngx ngx)
(local server (require :resty.websocket.server))
(local pgmoon (require :pgmoon))
(local cjson (require :cjson))
(local jwt (require :server.jwt))
(local fennelview (require :modules.fennel.fennelview))

(local pg (pgmoon.new (require :db.config)))
(local (pg-status pg-err) (: pg :connect))
((fn [] (when (not pg-status)
          (ngx.log ngx.ERR (.. "error connecting to db: " (tostring pg-err))))))
((fn []
   (when (not pg-status)
     (ngx.log ngx.ERR
              (.. "error connecting to db: " (tostring pg-err))))))

(fn log-message-to-db [message response]
  (ngx.log ngx.INFO (fennelview [message response]))
  (when pg-status
    (let [query (.. "insert into messages (message, response) values ("
                    (: pg :escape_literal message) ","
                    (: pg :escape_literal response) ");")
    (ngx.log ngx.ERR (fennelview [message response]))
    (let [query
          (.. "insert into messages (message, response) values ("
              (: pg :escape_literal message) ","
              (: pg :escape_literal response) ");")
          (result err) (: pg :query query)]
      (when (not result)
        (ngx.log ngx.ERR (.. "error logging message: " (tostring err) " / " (tostring result)))))))
        (ngx.log ngx.ERR (.. "error logging message: " (tostring err)
                             " / " (tostring result)))))))

(global _G (. (getmetatable _G) :__index))
(local fennel (require :modules.fennel.fennel))


@@ 25,11 33,14 @@
  (let [(ok result) (xpcall fennel.eval fennel.traceback message)]
    (if ok (fennelview result) result)))

(fn wss [] ;; must be wrapped in a function to avoid a top-level vararg
  (local (wb, err) (: server :new {:timeout 10000 :max_payload_len 65535}))
(fn wss [] ;; must be wrapped in a function to avoid a top-level
           ;; vararg
  (local (wb err)
         (: server :new {:timeout 10000 :max_payload_len 65535}))
  (var continue true)
  (var session-token nil)
  (when (not wb)
    (ngx.log ngx.ERR "failed to connect to new websocket: ", err)
    (ngx.log ngx.ERR "failed to connect to new websocket: " err)
    (ngx.exit 444)
    (set continue false))
  (while continue


@@ 43,7 54,9 @@
        (let [(bytes err) (: wb :send_close 1000 "close frame")]
          (if (not bytes)
              (ngx.log ngx.ERR "failed to send the close frame: " err)
              (ngx.log ngx.INFO "closing with status code " err " and message " data))
              (ngx.log ngx.INFO
                       "closing with status code " err
                       " and message " data))
          (set continue false))

        (= typ :ping)


@@ 55,26 68,86 @@
        (= typ :pong) nil
        
        (= typ :text)
        (let [evaled-message (eval-message data)
              (bytes err) (: wb :send_text evaled-message)]
          (ngx.log ngx.INFO data)
          (ngx.log ngx.INFO evaled-message)
          (log-message-to-db data evaled-message)
        (let [message (cjson.decode data)
              (bytes err)
              (match message
                {:action :auth :token nil}
                (: wb :send_text
                   (cjson.encode
                    {:re :auth
                     :action :error
                     :message "Missing token!"}))
                
                {:action :auth :token token}
                (let [payload
                      (jwt.verify-token-and-retrieve-payload token)]
                  (ngx.log ngx.ERR (fennelview payload))
                  (if
                    (not payload)
                    (do (set ngx.status ngx.HTTP_UNAUTHORIZED)
                        (cjson.encode
                         {:re :auth
                          :action :error
                          :message "Invalid token!"}))
                    (not payload.confirmed)
                    (do (set ngx.status ngx.HTTP_UNAUTHORIZED)
                        (cjson.encode
                         {:re :auth
                          :action :error
                          :message "User not confirmed!"}))
                    ;; else
                    (do (set session-token token)
                        (: wb :send_text
                           (cjson.encode
                            {:re :auth
                             :action :success
                             :message
                             "Authenticated successfully."})))))
                
                {:action :compile :src nil}
                (: wb :send_text
                   (cjson.encode
                    {:re :compile
                     :action :error
                     :message "Cannot compile without src!"}))

                {:action :compile :src src}
                (: wb :send_text
                   (if session-token
                       (cjson.encode
                        {:re :compile
                         :action :success
                         :value
                         (let [(_ result) 
                               (pcall fennel.compileString src)]
                           (log-message-to-db src result)
                           result)})
                       (cjson.encode
                        {:re :compile
                         :action :error
                         :message "Not authenticated!"})))

                _ (: wb :send_text
                     (cjson.encode
                      {:action :error
                       :message "Message not understood!"})))]
          (when (not bytes)
            (ngx.log ngx.ERR "failed to send text: " err)
            (ngx.exit 444)
            (set continue false)))

        (not (string.find err :timeout 1 true))
        (let [(bytes err) (: wb :send_text (.. "unknown frame type: " (tostring typ)
                                               " data: " (tostring data)
                                               " err: " (tostring err)))]
        (let [(bytes err) (: wb :send_text
                             (.. "unknown frame type: " (tostring typ)
                                 " data: " (tostring data)
                                 " err: " (tostring err)))]
          (when (not bytes) 
            (ngx.log ngx.ERR "failed to send a text frame: " err)
            (ngx.exit 444)
            (set continue false)))))

  (let [(bytes err) (: wb :send_close 1000 "close frame")]
    (when (not bytes) (ngx.log ngx.ERR "failed to send the close frame: " err))))
    (when (not bytes)
      (ngx.log ngx.ERR "failed to send the close frame: " err))))

(wss)