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 => +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)