summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore5
-rw-r--r--Makefile63
-rw-r--r--README.md15
-rw-r--r--data/style.css6
-rw-r--r--elm/0-compat.js31
-rw-r--r--elm/DocEdit.elm134
-rw-r--r--elm/Lib/Api.elm53
-rw-r--r--elm/Lib/Editsum.elm65
-rw-r--r--elm/Lib/Ffi.elm18
-rw-r--r--elm/Lib/Ffi.js9
-rw-r--r--elm/Lib/Html.elm74
-rw-r--r--elm/elm.json30
-rw-r--r--elm/global.js26
-rw-r--r--lib/VNDB/DB/Docs.pm12
-rw-r--r--lib/VNDB/DB/Misc.pm1
-rw-r--r--lib/VNDB/Handler/Docs.pm78
-rw-r--r--lib/VNDB/Util/CommonHTML.pm18
-rw-r--r--lib/VNWeb/DB.pm51
-rw-r--r--lib/VNWeb/Docs/Edit.pm57
-rw-r--r--lib/VNWeb/Elm.pm236
-rw-r--r--lib/VNWeb/HTML.pm16
-rw-r--r--lib/VNWeb/Prelude.pm47
-rw-r--r--lib/VNWeb/Validation.pm66
-rwxr-xr-xutil/vndb.pl38
24 files changed, 1019 insertions, 130 deletions
diff --git a/.gitignore b/.gitignore
index f5615afc..53652ecf 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,6 +4,8 @@
/data/log/
/data/multi.pid
/data/passwords.dat
+/elm/elm-stuff/
+/elm/Gen/
/elm3/elm-stuff/
/elm3/Lib/Gen.elm
/static/f/js/
@@ -12,6 +14,9 @@
/static/f/vndb.js
/static/f/vndb.min.js
/static/f/vndb.min.js.gz
+/static/f/v2rw.js
+/static/f/v2rw.min.js
+/static/f/v2rw.min.js.gz
/static/feeds/
/static/s/*/style.css
/static/s/*/style.min.css
diff --git a/Makefile b/Makefile
index 2770ba05..f0ea4363 100644
--- a/Makefile
+++ b/Makefile
@@ -30,6 +30,7 @@ ALL_KEEP=\
ALL_CLEAN=\
static/f/vndb.js \
+ static/f/v2rw.js \
data/icons/icons.css \
static/v3/elm.js \
static/v3/style.css \
@@ -41,20 +42,23 @@ PROD=\
static/v3/min.js static/v3/min.js.gz \
static/v3/min.css static/v3/min.css.gz \
static/f/vndb.min.js static/f/vndb.min.js.gz \
+ static/f/v2rw.min.js static/f/v2rw.min.js.gz \
static/f/icons.opt.png \
$(shell ls static/s | sed -e 's/\(.\+\)/static\/s\/\1\/style.min.css/g') \
$(shell ls static/s | sed -e 's/\(.\+\)/static\/s\/\1\/style.min.css.gz/g')
all: ${ALL_KEEP} ${ALL_CLEAN}
-prod: ${PROD}
+prod: all ${PROD}
clean:
rm -f ${ALL_CLEAN} ${PROD}
rm -f static/f/icons.png
rm -f elm3/Lib/Gen.elm
+ rm -rf elm/elm-stuff/build-artifacts
rm -rf elm3/elm-stuff/build-artifacts
cleaner: clean
+ rm -rf elm/elm-stuff
rm -rf elm3/elm-stuff
util/sql/editfunc.sql: util/sqleditfunc.pl util/sql/schema.sql
@@ -77,11 +81,12 @@ data/conf.pl:
%.gz: %
zopfli $<
-static/f/vndb.js: data/js/*.js lib/VNDB/Types.pm util/jsgen.pl data/conf.pl | static/f
- util/jsgen.pl
+chmod: all
+ chmod -R a-x+rwX static/{ch,cv,sf,st}
-static/f/vndb.min.js: static/f/vndb.js
- uglifyjs $< --compress --mangle -o $@
+
+
+# v2 & v2-rw
data/icons/icons.css static/f/icons.png: data/icons/*.png data/icons/*/*.png util/spritegen.pl | static/f
util/spritegen.pl
@@ -96,15 +101,56 @@ static/s/%/style.css: static/s/%/conf util/skingen.pl data/style.css data/icons/
static/s/%/style.min.css: static/s/%/style.css
perl -MCSS::Minifier::XS -e 'undef $$/; print CSS::Minifier::XS::minify(scalar <>)' <$< >$@
+
+
+# v2
+
+static/f/vndb.js: data/js/*.js lib/VNDB/Types.pm util/jsgen.pl data/conf.pl | static/f
+ util/jsgen.pl
+
+static/f/vndb.min.js: static/f/vndb.js
+ uglifyjs $< --compress --mangle -o $@
+
+
+
+# v2-rw
+
+define cat-js
+ sed -i 's/var author\$$project\$$Lib\$$Ffi\$$/var __unused__/g' $@
+ sed -Ei 's/author\$$project\$$Lib\$$Ffi\$$([a-zA-Z0-9_]+)/window.elmFfi_\1(_Json_wrap)/g' $@
+ for fn in elm/*.js elm/*/*.js; do \
+ echo "(function(){'use strict';"; \
+ cat $$fn; \
+ echo "})();"; \
+ done >>$@
+endef
+
+elm/Gen/.generated: lib/VNWeb/*.pm lib/VNWeb/*/*.pm lib/VNDB/Types.pm lib/VNDB/Config.pm data/conf.pl
+ util/vndb.pl elmgen
+
+static/f/v2rw.js: elm/*.elm elm/*/*.elm elm/*.js elm/*/*.js elm/Gen/.generated | static/f
+ cd elm && ELM_HOME=elm-stuff elm make *.elm */*.elm --output ../$@
+ ${cat-js}
+
+static/f/v2rw.min.js: elm/*.elm elm/*/*.elm elm/*.js elm/*/*.js elm/Gen/.generated | static/f
+ cd elm && ELM_HOME=elm-stuff elm make --optimize *.elm --output ../$@
+ ${cat-js}
+ uglifyjs $@ --compress 'pure_funcs="F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9",pure_getters,keep_fargs=false,unsafe_comps,unsafe' | uglifyjs --mangle -o $@~
+ mv $@~ $@
+
+
+
+# v3
+
elm3/Lib/Gen.elm: lib/VN3/*.pm lib/VN3/*/*.pm data/conf.pl
util/vndb3.pl elmgen >$@
-static/v3/elm.js: elm3/*.elm elm3/*/*.elm elm3/Lib/Gen.elm | static/f
+static/v3/elm.js: elm3/*.elm elm3/*/*.elm elm3/Lib/Gen.elm
cd elm3 && ELM_HOME=elm-stuff elm make *.elm */*.elm --output ../$@
sed -i 's/var author\$$project\$$Lib\$$Ffi\$$/var __unused__/g' $@
sed -Ei 's/author\$$project\$$Lib\$$Ffi\$$([a-zA-Z0-9_]+)/window.elmFfi_\1(_Json_wrap)/g' $@
-static/v3/elm-opt.js: elm3/*.elm elm3/*/*.elm elm3/Lib/Gen.elm | static/f
+static/v3/elm-opt.js: elm3/*.elm elm3/*/*.elm elm3/Lib/Gen.elm
cd elm3 && ELM_HOME=elm-stuff elm make --optimize *.elm */*.elm --output ../$@
sed -i 's/var author\$$project\$$Lib\$$Ffi\$$/var __unused__/g' $@
sed -Ei 's/author\$$project\$$Lib\$$Ffi\$$([a-zA-Z0-9_]+)/window.elmFfi_\1(_Json_wrap)/g' $@
@@ -127,9 +173,8 @@ static/v3/min.css: static/v3/style.css
perl -MCSS::Minifier::XS -e 'undef $$/; print CSS::Minifier::XS::minify(scalar <>)' <$< >$@
-chmod: all
- chmod -R a-x+rwX static/{ch,cv,sf,st}
+# Multi
# may wait indefinitely, ^C and kill -9 in that case
define multi-stop
diff --git a/README.md b/README.md
index af86396d..69219a70 100644
--- a/README.md
+++ b/README.md
@@ -136,13 +136,14 @@ has `util/vndb.pl` as entry point. Front-end assets are in `data/js/`,
**Version 2-rw**
-This is a (newly started) backend rewrite of version 2. It lives in
-`lib/VNWeb/`. Individual parts of the website are gradually being moved into
-this new coding style and structure. Version 2 and 2-rw run side-by-side in the
-same process and share a common route table and database connection, so the
-entry point is still `util/vndb.pl`. The primary goal of this rewrite is to
-make use of the clearer version 3 structure and to slowly migrate the brittle
-frontend Javascript parts to Elm and JSON APIs.
+This is a (recently started) backend rewrite of version 2. It lives in
+`lib/VNWeb/` with Elm and Javascript code in `elm/`. Individual parts of the
+website are gradually being moved into this new coding style and structure.
+Version 2 and 2-rw run side-by-side in the same process and share a common
+route table and database connection, so the entry point is still
+`util/vndb.pl`. The primary goal of this rewrite is to make use of the clearer
+version 3 structure and to slowly migrate the brittle frontend Javascript parts
+to Elm and JSON APIs.
**Version 3**
diff --git a/data/style.css b/data/style.css
index f603bcfa..afa16fb1 100644
--- a/data/style.css
+++ b/data/style.css
@@ -134,7 +134,8 @@ input.text, input.submit, select, textarea {
padding: 0 1px 1px 1px;
margin: 1px;
}
-form, fieldset { border: 0; display: block; }
+div.preview { border: 1px solid $secborder$; margin: 1px; padding: 5px }
+form, fieldset { border: 0; display: block }
legend { display: none; }
optgroup option { padding-left: 10px; font-style: normal; }
input.submit { background: $boxbg$; padding: 1px; }
@@ -152,6 +153,9 @@ table.formtable td { padding: 0; }
table.formtable tr.newfield td { padding-top: 5px; }
table.formtable tr.newpart td { padding-top: 20px; font-weight: bold; }
+div.spinner { content: ''; border: 3px solid #9eaebd; border-bottom-color: transparent; border-radius: 100%; animation: spin 1s infinite linear; width: 14px; height: 14px; display: inline-block; margin: auto }
+@keyframes spin { from { transform:rotate(0deg); } to { transform:rotate(360deg); } }
+
diff --git a/elm/0-compat.js b/elm/0-compat.js
new file mode 100644
index 00000000..02179ee3
--- /dev/null
+++ b/elm/0-compat.js
@@ -0,0 +1,31 @@
+/* classList.toggle() */
+(function() {
+ var historic = DOMTokenList.prototype.toggle;
+ DOMTokenList.prototype.toggle = function(token, force) {
+ if(arguments.length > 0 && this.contains(token) === force) {
+ return force;
+ }
+ return historic.call(this, token);
+ };
+})();
+
+
+/* Element.matches() and Element.closest() */
+if(!Element.prototype.matches)
+ Element.prototype.matches = Element.prototype.msMatchesSelector || Element.prototype.webkitMatchesSelector;
+if(!Element.prototype.closest)
+ Element.prototype.closest = function(s) {
+ var el = this;
+ if(!document.documentElement.contains(el)) return null;
+ do {
+ if(el.matches(s)) return el;
+ el = el.parentElement || el.parentNode;
+ } while(el !== null && el.nodeType === 1);
+ return null;
+ };
+
+
+/* NodeList.forEach */
+if(window.NodeList && !NodeList.prototype.forEach) {
+ NodeList.prototype.forEach = Array.prototype.forEach;
+}
diff --git a/elm/DocEdit.elm b/elm/DocEdit.elm
new file mode 100644
index 00000000..f7cbac61
--- /dev/null
+++ b/elm/DocEdit.elm
@@ -0,0 +1,134 @@
+module DocEdit exposing (main)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Browser
+import Browser.Navigation exposing (load)
+import Json.Encode as JE
+import Lib.Html exposing (..)
+import Lib.Api as Api
+import Lib.Ffi as Ffi
+import Gen.Api as GApi
+import Gen.DocEdit as GD
+
+--import Lib.Api as Api
+--import Lib.Ffi as Ffi
+
+import Lib.Editsum as Editsum
+
+main : Program GD.Recv Model Msg
+main = Browser.element
+ { init = \e -> (init e, Cmd.none)
+ , view = view
+ , update = update
+ , subscriptions = always Sub.none
+ }
+
+
+type alias Model =
+ { state : Api.State
+ , editsum : Editsum.Model
+ , title : String
+ , content : String
+ , id : Int
+ , preview : String
+ }
+
+
+init : GD.Recv -> Model
+init d =
+ { state = Api.Normal
+ , editsum = { authmod = True, editsum = d.editsum, locked = d.locked, hidden = d.hidden }
+ , title = d.title
+ , content = d.content
+ , id = d.id
+ , preview = ""
+ }
+
+
+encode : Model -> GD.Send
+encode model =
+ { editsum = model.editsum.editsum
+ , hidden = model.editsum.hidden
+ , locked = model.editsum.locked
+ , title = model.title
+ , content = model.content
+ }
+
+
+type Msg
+ = Editsum Editsum.Msg
+ | Submit
+ | Submitted GApi.Response
+ | Title String
+ | Content String
+ | Preview
+ | HandlePreview GApi.Response
+
+
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model =
+ case msg of
+ Editsum e -> ({ model | editsum = Editsum.update e model.editsum }, Cmd.none)
+ Title s -> ({ model | title = s }, Cmd.none)
+ Content s -> ({ model | content = s }, Cmd.none)
+
+ Submit ->
+ let
+ path = "/d" ++ String.fromInt model.id ++ "/edit"
+ body = GD.encode (encode model)
+ in ({ model | state = Api.Loading }, Api.post path body Submitted)
+
+ Submitted (GApi.Changed id rev) -> (model, load <| "/d" ++ String.fromInt id ++ "." ++ String.fromInt rev)
+ Submitted r -> ({ model | state = Api.Error r }, Cmd.none)
+
+ Preview ->
+ if model.preview /= "" then ( { model | preview = "" }, Cmd.none )
+ else
+ ( { model | state = Api.Loading, preview = "" }
+ , Api.post "/js/markdown.json" (JE.object [("content", JE.string model.content)]) HandlePreview
+ )
+
+ HandlePreview (GApi.Content s) -> ({ model | state = Api.Normal, preview = s }, Cmd.none)
+ HandlePreview r -> ({ model | state = Api.Error r }, Cmd.none)
+
+
+view : Model -> Html Msg
+view model =
+ Html.form [ onSubmit Submit ]
+ [ div [ class "mainbox" ]
+ [ h1 [] [ text <| "Edit d" ++ String.fromInt model.id ]
+ , table [ class "formtable" ]
+ [ tr [ class "newfield" ]
+ [ td [ class "label" ] [ label [ for "title" ] [ text "Title" ]]
+ , td [ class "field" ] [ inputText "title" model.title Title (style "width" "300px" :: GD.valTitle) ]
+ ]
+ , tr [ class "newfield" ]
+ [ td [ class "field", colspan 2 ]
+ [ br [] []
+ , text "Contents (HTML and MultiMarkdown supported, which is "
+ , a [ href "https://daringfireball.net/projects/markdown/basics", target "_blank" ] [ text "Markdown" ]
+ , text " with some "
+ , a [ href "http://fletcher.github.io/MultiMarkdown-5/syntax.html", target "_blank" ][ text "extensions" ]
+ , text ")."
+ , br [] []
+ , a [ href "#", style "float" "right", onClickN Preview ]
+ [ text <| if model.preview == "" then "Preview" else "Edit"
+ , if model.state == Api.Loading then div [ class "spinner" ] [] else text ""
+ ]
+ , br [] []
+ , if model.preview == ""
+ then inputTextArea "content" model.content Content ([rows 50, cols 90, style "width" "850px"] ++ GD.valContent)
+ else div [ class "docs preview", style "width" "850px", Ffi.innerHtml model.preview ] []
+ ]
+ ]
+ ]
+ ]
+ , div [ class "mainbox" ]
+ [ fieldset [ class "submit" ]
+ [ Html.map Editsum (Editsum.view model.editsum)
+ , submitButton "Submit" model.state True False
+ ]
+ ]
+ ]
diff --git a/elm/Lib/Api.elm b/elm/Lib/Api.elm
new file mode 100644
index 00000000..31bf3613
--- /dev/null
+++ b/elm/Lib/Api.elm
@@ -0,0 +1,53 @@
+module Lib.Api exposing (..)
+
+import Json.Encode as JE
+import Http
+
+import Gen.Api exposing (..)
+
+
+-- Handy state enum for forms
+type State
+ = Normal
+ | Loading
+ | Error Response
+
+
+-- User-friendly error message if the response isn't what the code expected.
+-- (Technically a good chunk of this function could also be automatically
+-- generated by Elm.pm, but that wouldn't really have all that much value).
+showResponse : Response -> String
+showResponse res =
+ let unexp = "Unexpected response, please report a bug."
+ in case res of
+ HTTPError (Http.Timeout) -> "Network timeout, please try again later."
+ HTTPError (Http.NetworkError) -> "Network error, please try again later."
+ HTTPError (Http.BadStatus r) -> "Server error " ++ String.fromInt r ++ ", please try again later, or report an issue if this persists."
+ HTTPError (Http.BadBody r) -> "Invalid response from the server, please report a bug (debug info: " ++ r ++")."
+ HTTPError (Http.BadUrl _) -> unexp
+ Success -> unexp
+ CSRF -> "Invalid CSRF token, please refresh the page and try again."
+ Invalid -> "Invalid form data, please report a bug."
+ Unauth -> "You do not have the permission to perform this action."
+ Unchanged -> "No changes"
+ Changed _ _ -> unexp
+ Content _ -> unexp
+
+
+expectResponse : (Response -> msg) -> Http.Expect msg
+expectResponse msg =
+ let
+ res r = msg <| case r of
+ Err e -> HTTPError e
+ Ok v -> v
+ in Http.expectJson res decode
+
+
+-- Send a POST request with a JSON body to the VNDB API and get a Response back.
+post : String -> JE.Value -> (Response -> msg) -> Cmd msg
+post url body msg =
+ Http.post
+ { url = url
+ , body = Http.jsonBody body
+ , expect = expectResponse msg
+ }
diff --git a/elm/Lib/Editsum.elm b/elm/Lib/Editsum.elm
new file mode 100644
index 00000000..7ab1f994
--- /dev/null
+++ b/elm/Lib/Editsum.elm
@@ -0,0 +1,65 @@
+-- This module provides an the 'Edit summary' box, including the 'hidden' and
+-- 'locked' moderation checkboxes.
+
+module Lib.Editsum exposing (Model, Msg, new, update, view)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Lib.Html exposing (..)
+
+
+type alias Model =
+ { authmod : Bool
+ , locked : Bool
+ , hidden : Bool
+ , editsum : String
+ }
+
+
+type Msg
+ = Locked Bool
+ | Hidden Bool
+ | Editsum String
+
+
+new : Model
+new =
+ { authmod = False
+ , locked = False
+ , hidden = False
+ , editsum = ""
+ }
+
+
+update : Msg -> Model -> Model
+update msg model =
+ case msg of
+ Locked b -> { model | locked = b }
+ Hidden b -> { model | hidden = b }
+ Editsum s -> { model | editsum = s }
+
+
+view : Model -> Html Msg
+view model =
+ let
+ lockhid =
+ [ label []
+ [ inputCheck "" model.hidden Hidden
+ , text " Deleted" ]
+ , label []
+ [ inputCheck "" model.locked Locked
+ , text " Locked" ]
+ , br [] []
+ , text "Note: edit summary of the last edit should indicate the reason for the deletion."
+ , br [] []
+ ]
+ in fieldset [] <|
+ (if model.authmod then lockhid else [])
+ ++
+ [ h2 []
+ [ text "Edit summary"
+ , b [class "standout"] [text " (English please!)"]
+ ]
+ -- TODO: BBCode preview
+ , inputTextArea "editsum" model.editsum Editsum [rows 4, cols 50, minlength 2, maxlength 5000, required True]
+ ]
diff --git a/elm/Lib/Ffi.elm b/elm/Lib/Ffi.elm
new file mode 100644
index 00000000..6a2a5364
--- /dev/null
+++ b/elm/Lib/Ffi.elm
@@ -0,0 +1,18 @@
+-- Elm 0.19: "We've removed all Native modules and plugged all XSS vectors,
+-- it's now impossible to talk with Javascript other than with ports!"
+-- Me: "Oh yeah? I'll just run sed over the generated Javascript!"
+
+-- This module is a hack to work around the lack of an FFI (Foreign Function
+-- Interface) in Elm. The functions in this module are stubs, their
+-- implementations are replaced by the Makefile with calls to
+-- window.elmFfi_<name> and the actual implementations are in Ffi.js.
+--
+-- Use sparingly, all of this will likely break in future Elm versions.
+module Lib.Ffi exposing (..)
+
+import Html exposing (Attribute)
+import Html.Attributes exposing (title)
+
+-- Set the innerHTML attribute of a node
+innerHtml : String -> Attribute msg
+innerHtml = always (title "")
diff --git a/elm/Lib/Ffi.js b/elm/Lib/Ffi.js
new file mode 100644
index 00000000..86418d97
--- /dev/null
+++ b/elm/Lib/Ffi.js
@@ -0,0 +1,9 @@
+window.elmFfi_innerHtml = function(wrap) { // \s -> _VirtualDom_property('innerHTML', _Json_wrap(s))
+ return function(s) {
+ return {
+ $: 'a2',
+ n: 'innerHTML',
+ o: wrap(s)
+ }
+ }
+};
diff --git a/elm/Lib/Html.elm b/elm/Lib/Html.elm
new file mode 100644
index 00000000..bbd2e1fb
--- /dev/null
+++ b/elm/Lib/Html.elm
@@ -0,0 +1,74 @@
+module Lib.Html exposing (..)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Json.Decode as JD
+import List
+import Lib.Api as Api
+
+
+-- onClick with stopPropagation & preventDefault
+onClickN : m -> Attribute m
+onClickN action = custom "click" (JD.succeed { message = action, stopPropagation = True, preventDefault = True})
+
+
+-- Submit button with loading indicator and error message display
+submitButton : String -> Api.State -> Bool -> Bool -> Html m
+submitButton val state valid load = div []
+ [ input [ type_ "submit", class "submit", tabindex 10, value val, disabled (state == Api.Loading || not valid || load) ] []
+ , case state of
+ Api.Error r -> p [] [ b [class "standout" ] [ text <| Api.showResponse r ] ]
+ _ -> if valid
+ then text ""
+ else p [] [ b [class "standout" ] [ text "The form contains errors, please fix these before submitting. " ] ]
+ , if state == Api.Loading || load
+ then div [ class "spinner" ] []
+ else text ""
+ ]
+
+
+inputSelect : String -> String -> (String -> m) -> List (Attribute m) -> List (String, String) -> Html m
+inputSelect nam sel onch attrs lst =
+ let opt (id, name) = option [ value id, selected (id == sel) ] [ text name ]
+ in select (
+ [ tabindex 10
+ , onInput onch
+ ]
+ ++ attrs
+ ++ (if nam == "" then [] else [ id nam, name nam ])
+ ) <| List.map opt lst
+
+
+inputText : String -> String -> (String -> m) -> List (Attribute m) -> Html m
+inputText nam val onch attrs = input (
+ [ type_ "text"
+ , class "text"
+ , tabindex 10
+ , value val
+ , onInput onch
+ ]
+ ++ attrs
+ ++ (if nam == "" then [] else [ id nam, name nam ])
+ ) []
+
+
+inputTextArea : String -> String -> (String -> m) -> List (Attribute m) -> Html m
+inputTextArea nam val onch attrs = textarea (
+ [ tabindex 10
+ , onInput onch
+ ]
+ ++ attrs
+ ++ (if nam == "" then [] else [ id nam, name nam ])
+ ) [ text val ]
+
+
+inputCheck : String -> Bool -> (Bool -> m) -> Html m
+inputCheck nam val onch = input (
+ [ type_ "checkbox"
+ , tabindex 10
+ , onCheck onch
+ , checked val
+ ]
+ ++ (if nam == "" then [] else [ id nam, name nam ])
+ ) []
diff --git a/elm/elm.json b/elm/elm.json
new file mode 100644
index 00000000..51aca1a7
--- /dev/null
+++ b/elm/elm.json
@@ -0,0 +1,30 @@
+{
+ "type": "application",
+ "source-directories": [
+ "."
+ ],
+ "elm-version": "0.19.0",
+ "dependencies": {
+ "direct": {
+ "elm/browser": "1.0.1",
+ "elm/core": "1.0.2",
+ "elm/file": "1.0.1",
+ "elm/html": "1.0.0",
+ "elm/http": "2.0.0",
+ "elm/json": "1.1.2",
+ "elm/regex": "1.0.0",
+ "justinmimbs/date": "3.1.2"
+ },
+ "indirect": {
+ "elm/bytes": "1.0.3",
+ "elm/parser": "1.1.0",
+ "elm/time": "1.0.0",
+ "elm/url": "1.0.0",
+ "elm/virtual-dom": "1.0.2"
+ }
+ },
+ "test-dependencies": {
+ "direct": {},
+ "indirect": {}
+ }
+} \ No newline at end of file
diff --git a/elm/global.js b/elm/global.js
new file mode 100644
index 00000000..f1c5444a
--- /dev/null
+++ b/elm/global.js
@@ -0,0 +1,26 @@
+/* Add the X-CSRF-Token header to every POST request. Based on:
+ * https://stackoverflow.com/questions/24196140/adding-x-csrf-token-header-globally-to-all-instances-of-xmlhttprequest/24196317#24196317
+ */
+(function() {
+ var open = XMLHttpRequest.prototype.open,
+ token = document.querySelector('meta[name=csrf-token]').content;
+
+ XMLHttpRequest.prototype.open = function(method, url) {
+ var ret = open.apply(this, arguments);
+ this.dataUrl = url;
+ if(method.toLowerCase() == 'post' && /^\//.test(url))
+ this.setRequestHeader('X-CSRF-Token', token);
+ return ret;
+ };
+})();
+
+
+/* Find all divs with a data-elm-module and embed the given Elm module in the div */
+document.querySelectorAll('div[data-elm-module]').forEach(function(el) {
+ var mod = el.getAttribute('data-elm-module').split('.').reduce(function(p, c) { return p[c] }, window.Elm);
+ var flags = el.getAttribute('data-elm-flags');
+ if(flags)
+ mod.init({ node: el, flags: JSON.parse(flags)});
+ else
+ mod.init({ node: el });
+});
diff --git a/lib/VNDB/DB/Docs.pm b/lib/VNDB/DB/Docs.pm
index 27cabf6e..d7c220ff 100644
--- a/lib/VNDB/DB/Docs.pm
+++ b/lib/VNDB/DB/Docs.pm
@@ -5,7 +5,7 @@ use strict;
use warnings;
use Exporter 'import';
-our @EXPORT = qw|dbDocGet dbDocGetRev dbDocRevisionInsert|;
+our @EXPORT = qw|dbDocGet dbDocGetRev|;
# Can only fetch a single document.
@@ -40,14 +40,4 @@ sub dbDocGetRev {
return wantarray ? ($r, 0) : $r;
}
-
-# Updates the edit_* tables, used from dbItemEdit()
-# Arguments: { title content },
-sub dbDocRevisionInsert {
- my($self, $o) = @_;
- my %set = map exists($o->{$_}) ? (qq|"$_" = ?|, $o->{$_}) : (), qw|title content|;
- $self->dbExec('UPDATE edit_docs !H', \%set) if keys %set;
-}
-
-
1;
diff --git a/lib/VNDB/DB/Misc.pm b/lib/VNDB/DB/Misc.pm
index 60c13370..e1a1103c 100644
--- a/lib/VNDB/DB/Misc.pm
+++ b/lib/VNDB/DB/Misc.pm
@@ -41,7 +41,6 @@ sub dbItemEdit {
$self->dbReleaseRevisionInsert( \%o) if $type eq 'r';
$self->dbCharRevisionInsert( \%o) if $type eq 'c';
$self->dbStaffRevisionInsert( \%o) if $type eq 's';
- $self->dbDocRevisionInsert( \%o) if $type eq 'd';
return $self->dbRow('SELECT * FROM edit_!s_commit()', $type);
}
diff --git a/lib/VNDB/Handler/Docs.pm b/lib/VNDB/Handler/Docs.pm
deleted file mode 100644
index 4fabf1d3..00000000
--- a/lib/VNDB/Handler/Docs.pm
+++ /dev/null
@@ -1,78 +0,0 @@
-
-package VNDB::Handler::Docs;
-
-
-use strict;
-use warnings;
-use TUWF ':html';
-use VNDB::Func;
-use Text::MultiMarkdown 'markdown';
-use VNWeb::Docs::Lib;
-
-
-TUWF::register(
- qr{d([1-9]\d*)(?:\.([1-9]\d*))?/edit} => \&edit,
-);
-
-
-sub edit {
- my($self, $id, $rev) = @_;
-
- my $d = $self->dbDocGetRev(id => $id, rev => $rev)->[0];
- return $self->resNotFound if !$d->{id};
- $rev = undef if $d->{lastrev};
-
- return $self->htmlDenied if !$self->authCan('dbmod');
-
- my %b4 = map { $_ => $d->{$_} } qw|title content ihid ilock|;
- my $frm;
-
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'title', maxlength => 200 },
- { post => 'content', },
- { post => 'editsum', template => 'editsum' },
- { post => 'ihid', required => 0 },
- { post => 'ilock', required => 0 },
- { post => 'preview', required => 0 },
- );
- if(!$frm->{_err} && !$frm->{preview}) {
- $frm->{ihid} = $frm->{ihid}?1:0;
- $frm->{ilock} = $frm->{ilock}?1:0;
-
- return $self->resRedirect("/d$id", 'post') if !form_compare(\%b4, $frm);
- my $nrev = $self->dbItemEdit(d => $id, $d->{rev}, %$frm);
- return $self->resRedirect("/d$nrev->{itemid}.$nrev->{rev}", 'post');
- }
- }
-
- !defined $frm->{$_} && ($frm->{$_} = $b4{$_}) for keys %b4;
- $frm->{editsum} = sprintf 'Reverted to revision d%d.%d', $id, $rev if $rev && !defined $frm->{editsum};
- delete $frm->{_err} if $frm->{preview};
-
- my $title = "Edit $d->{title}";
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlMainTabs('d', $d, 'edit');
-
- if($frm->{preview}) {
- div class => 'mainbox';
- h1 'Preview';
- div class => 'docs';
- lit md2html $frm->{content};
- end;
- end;
- }
-
- $self->htmlForm({ frm => $frm, action => "/d$id/edit", editsum => 1, preview => 1 }, dedit => [ $title,
- [ input => name => 'Title', short => 'title', width => 300 ],
- [ static => nolabel => 1, content => q{
- <br>Contents (HTML and MultiMarkdown supported, which is
- <a href="https://daringfireball.net/projects/markdown/basics">Markdown</a>
- with some <a href="http://fletcher.github.io/MultiMarkdown-5/syntax.html">extensions</a>).} ],
- [ textarea => short => 'content', name => 'Content', rows => 50, cols => 90, nolabel => 1 ],
- ]);
- $self->htmlFooter;
-}
-
-1;
diff --git a/lib/VNDB/Util/CommonHTML.pm b/lib/VNDB/Util/CommonHTML.pm
index 3adfe740..4b80eb21 100644
--- a/lib/VNDB/Util/CommonHTML.pm
+++ b/lib/VNDB/Util/CommonHTML.pm
@@ -108,23 +108,7 @@ sub htmlMainTabs {
# generates a full error page, including header and footer
-sub htmlDenied {
- my $self = shift;
- $self->htmlHeader(title => 'Access Denied');
- div class => 'mainbox';
- h1 'Access Denied';
- div class => 'warning';
- if(!$self->authInfo->{id}) {
- h2 'You need to be logged in to perform this action.';
- p; lit 'Please <a href="/u/login">login</a>, or <a href="/u/register">create an account</a> if you don\'t have one yet.'; end;
- } else {
- h2 'You are not allowed to perform this action.';
- p 'It seems you don\'t have the proper rights to perform the action you wanted to perform...';
- }
- end;
- end 'div';
- $self->htmlFooter;
-}
+sub htmlDenied { shift->resDenied }
# Generates message saying that the current item has been deleted,
diff --git a/lib/VNWeb/DB.pm b/lib/VNWeb/DB.pm
index b839baf3..7ef2e161 100644
--- a/lib/VNWeb/DB.pm
+++ b/lib/VNWeb/DB.pm
@@ -12,7 +12,7 @@ our @EXPORT = qw/
sql
sql_join sql_comma sql_and sql_array sql_func sql_fromhex sql_tohex sql_fromtime sql_totime
enrich enrich_merge enrich_flatten
- db_entry
+ db_entry db_edit
/;
@@ -222,6 +222,7 @@ my $entry_types = do {
# TODO:
# - Use non _hist tables if $maxrev == $rev (should be faster)
# - Combine the enrich_merge() calls into a single query.
+# - Fixed ordering of arrays (use primary keys)
sub db_entry {
my($type, $id, $rev) = @_;
my $t = $entry_types->{$type}||die;
@@ -261,4 +262,52 @@ sub db_entry {
$entry
}
+
+# Edit or create an entry, usage:
+# ($id, $chid, $rev) = db_edit $type, $id, $data, $uid;
+#
+# $id should be undef to create a new entry.
+# $uid should be undef to use the currently logged in user.
+# $data should have the same format as returned by db_entry(), but instead with
+# the following additional keys in the top-level hash:
+#
+# hidden, locked, editsum
+sub db_edit {
+ my($type, $id, $data, $uid) = @_;
+ $id ||= undef;
+ my $t = $entry_types->{$type}||die;
+
+ tuwf->dbExeci("SELECT edit_${type}_init(", \$id, ', (SELECT MAX(rev) FROM changes WHERE type = ', \$type, ' AND itemid = ', \$id, '))');
+ tuwf->dbExeci('UPDATE edit_revision SET', {
+ requester => $uid // scalar VNWeb::Auth::auth()->uid(),
+ ip => scalar tuwf->reqIP(),
+ comments => $data->{editsum},
+ ihid => $data->{hidden},
+ ilock => $data->{locked},
+ });
+
+ {
+ my $base = $t->{base}{name} =~ s/_hist$//r;
+ tuwf->dbExeci("UPDATE edit_${base} SET ", sql_comma(
+ map sql("\"$_->{name}\"", ' = ', \$data->{$_->{name}}),
+ grep exists $data->{$_->{name}}, $t->{base}{cols}->@*
+ ));
+ }
+
+ while(my($name, $tbl) = each $t->{tables}->%*) {
+ my $base = $tbl->{name} =~ s/_hist$//r;
+ my @cols = map sql_comma(map "\"$_->{name}\""), $tbl->{cols}->$@;
+ my @rows = map {
+ my $d = $_;
+ sql '(', sql_comma(map \$d, $tbl->{cols}->@*), ')'
+ } $data->{$name}->@*;
+
+ tuwf->dbExeci("DELETE FROM edit_${base}");
+ tuwf->dbExeci("INSERT INTO edit_${base} (", @cols, ') VALUES ', sql_comma @rows) if @rows;
+ }
+
+ my $r = tuwf->dbRow("SELECT * FROM edit_${type}_commit()");
+ ($r->{itemid}, $r->{chid}, $r->{rev})
+}
+
1;
diff --git a/lib/VNWeb/Docs/Edit.pm b/lib/VNWeb/Docs/Edit.pm
new file mode 100644
index 00000000..ad3af9ec
--- /dev/null
+++ b/lib/VNWeb/Docs/Edit.pm
@@ -0,0 +1,57 @@
+package VNWeb::Docs::Edit;
+
+use VNWeb::Prelude;
+use VNWeb::Docs::Lib;
+
+
+my $FORM = {
+ title => { maxlength => 200 },
+ content => { required => 0, default => '' },
+ hidden => { anybool => 1 },
+ locked => { anybool => 1 },
+
+ editsum => { _when => 'in out', editsum => 1 },
+ id => { _when => 'out', id => 1 },
+};
+
+my $FORM_OUT = form_compile out => $FORM;
+my $FORM_IN = form_compile in => $FORM;
+my $FORM_CMP = form_compile cmp => $FORM;
+
+elm_form DocEdit => $FORM_OUT, $FORM_IN;
+
+
+TUWF::get qr{/$RE{drev}/edit} => sub {
+ my $d = db_entry d => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
+ return tuwf->resDenied if !can_edit d => $d;
+
+ $d->{editsum} = $d->{chrev} == $d->{maxrev} ? '' : "Reverted to revision d$d->{id}.$d->{chrev}";
+
+ framework_ title => "Edit $d->{title}", index => 0, type => 'd', dbobj => $d, tab => 'edit',
+ sub {
+ elm_ DocEdit => $FORM_OUT, $d;
+ };
+};
+
+
+json_api qr{/$RE{drev}/edit}, $FORM_IN, sub {
+ my $data = shift;
+ my $doc = db_entry d => tuwf->capture('id') or return tuwf->resNotFound;
+
+ return elm_Unauth if !can_edit d => $doc;
+ return elm_Unchanged if !form_changed $FORM_CMP, $data, $doc;
+
+ my($id,undef,$rev) = db_edit d => $doc->{id}, $data;
+ elm_Changed $id, $rev;
+};
+
+
+json_api '/js/markdown.json', {
+ content => { required => 0, default => '' }
+}, sub {
+ return elm_Unauth if !auth->permDbmod;
+ elm_Content md2html shift->{content};
+};
+
+
+1;
diff --git a/lib/VNWeb/Elm.pm b/lib/VNWeb/Elm.pm
new file mode 100644
index 00000000..ea181e3c
--- /dev/null
+++ b/lib/VNWeb/Elm.pm
@@ -0,0 +1,236 @@
+# This module is responsible for generating elm/Gen/*.
+#
+# It exports an `elm_form` function to generate type definitions, a JSON
+# encoder and HTML5 validation attributes to simplify and synchronize forms.
+#
+# It also exports an `elm_Response` function for each possible API response
+# (see %apis below).
+
+package VNWeb::Elm;
+
+use strict;
+use warnings;
+use TUWF;
+use Exporter 'import';
+use List::Util 'max';
+use VNDB::Config;
+use VNDB::Types;
+use VNWeb::Auth;
+
+our @EXPORT = qw/
+ elm_form
+/;
+
+
+# API response types and arguments. To generate an API response from Perl, call
+# elm_ResponseName(@args), e.g.:
+#
+# elm_Changed $id, $revision;
+#
+# These API responses are available in Elm in the `Gen.Api.Response` union type.
+my %apis = (
+ Unauth => [], # Not authorized
+ Unchanged => [], # No changes
+ Changed => [ { id => 1 }, { uint => 1 } ], # [ id, chrev]; DB entry has been successfully changed
+ Success => [],
+ CSRF => [], # Invalid CSRF token
+ Invalid => [], # POST data did not validate the schema
+ Content => [{}], # Rendered HTML content (for markdown/bbcode APIs)
+);
+
+
+# Generate the elm_Response() functions
+for my $name (keys %apis) {
+ no strict 'refs';
+ $apis{$name} = [ map tuwf->compile($_), $apis{$name}->@* ];
+ *{'elm_'.$name} = sub {
+ my @args = map {
+ $apis{$name}[$_]->validate($_[$_])->data if tuwf->debug;
+ $apis{$name}[$_]->analyze->coerce_for_json($_[$_], unknown => 'reject')
+ } 0..$#{$apis{$name}};
+ tuwf->resJSON({$name, \@args})
+ };
+ push @EXPORT, 'elm_'.$name;
+}
+
+
+
+
+# Formatting functions
+sub indent($) { $_[0] =~ s/\n/\n /gr }
+sub list { indent "\n[ ".join("\n, ", @_)."\n]" }
+sub string($) { '"'.($_[0] =~ s/([\\"])/\\$1/gr).'"' }
+sub tuple { '('.join(', ', @_).')' }
+sub bool($) { $_[0] ? 'True' : 'False' }
+sub to_camel { (ucfirst $_[0]) =~ s/_([a-z])/'_'.uc $1/egr; }
+
+# Generate a variable definition: name, type, value
+sub def($$$) { sprintf "\n%s : %s\n%1\$s = %s\n", @_; }
+
+
+# Generate an Elm type definition corresponding to a TUWF::Validate schema
+sub def_type {
+ my($name, $obj) = @_;
+ my $data = '';
+ my @keys = $obj->{keys} ? grep $obj->{keys}{$_}{keys}||($obj->{keys}{$_}{values}&&$obj->{keys}{$_}{values}{keys}), sort keys $obj->{keys}->%* : ();
+
+ $data .= def_type($name . to_camel($_), $obj->{keys}{$_}{values} || $obj->{keys}{$_}) for @keys;
+
+ $data .= sprintf "\ntype alias %s = %s\n\n", $name, $obj->elm_type(
+ keys => +{ map +($_, ($obj->{keys}{$_}{values} ? 'List ' : '') . $name . to_camel($_)), @keys }
+ );
+ $data
+}
+
+
+# Generate HTML5 validation attribute lists corresponding to a TUWF::Validate schema
+# TODO: Deduplicate some regexes (weburl, email)
+# TODO: Throw these inside a struct for better namespacing?
+sub def_validation {
+ my($name, $obj) = @_;
+ $obj = $obj->{values} if $obj->{values};
+ my $data = '';
+
+ $data .= def_validation($name . to_camel($_), $obj->{keys}{$_}) for $obj->{keys} ? sort keys $obj->{keys}->%* : ();
+
+ my %v = $obj->html5_validation();
+ $data .= def $name, 'List (Html.Attribute msg)', '[ '.join(', ',
+ $v{required} ? 'A.required True' : (),
+ $v{minlength} ? "A.minlength $v{minlength}" : (),
+ $v{maxlength} ? "A.maxlength $v{maxlength}" : (),
+ $v{min} ? "A.min $v{min}" : (),
+ $v{max} ? "A.max $v{max}" : (),
+ $v{pattern} ? 'A.pattern '.string($v{pattern}) : ()
+ ).']' if !$obj->{keys};
+ $data;
+}
+
+
+# Generate an Elm JSON encoder taking a corresponding def_type() as input
+sub encoder {
+ my($name, $type, $obj) = @_;
+ def $name, "$type -> JE.Value", $obj->elm_encoder(json_encode => 'JE.');
+}
+
+
+
+
+sub write_module {
+ my($module, $contents) = @_;
+ my $fn = sprintf '%s/elm/Gen/%s.elm', config->{root}, $module;
+
+ # The imports aren't necessary in all the files, but might as well add them.
+ $contents = <<~"EOF";
+ -- This file is automatically generated from lib/VNWeb/Elm.pm.
+ -- Do not edit, your changes will be lost.
+ module Gen.$module exposing (..)
+ import Http
+ import Html
+ import Html.Attributes as A
+ import Json.Encode as JE
+ import Json.Decode as JD
+ $contents
+ EOF
+
+ # Don't write anything if the file hasn't changed.
+ my $oldcontents = do {
+ local $/=undef; my $F;
+ open($F, '<:utf8', $fn) ? <$F> : '';
+ };
+ return if $oldcontents eq $contents;
+
+ open my $F, '>:utf8', $fn or die "$fn: $!";
+ print $F $contents;
+}
+
+
+
+
+
+# Create type definitions and a JSON encoder for a typical form.
+# Usage:
+#
+# elm_form 'FormName', $TO_ELM_SCHEMA, $TO_SERVER_SCHEMA;
+#
+# That will create a Gen.FormName module with the following definitions:
+#
+# type alias Recv = { .. }
+# type alias Send = { .. }
+# encode : Send -> JE.Value
+# valFieldName : List Html.Attribute
+#
+sub elm_form {
+ return if !tuwf->{elmgen};
+ my($name, $out, $in) = @_;
+
+ my $data = '';
+ $data .= def_type Recv => $out->analyze;
+ $data .= def_type Send => $in->analyze;
+ $data .= encoder encode => 'Send', $in->analyze;
+ $data .= def_validation val => $in->analyze;
+
+ write_module $name, $data;
+}
+
+
+
+# Generate the Gen.Api module with the Response type and decoder.
+sub write_api {
+
+ # Extract all { type => 'hash' } schemas and give them their own
+ # definition, so that it's easy to refer to those records in other places
+ # of the Elm code, similar to def_type().
+ my(@union, @decode);
+ my $data = '';
+ my $len = max map length, keys %apis;
+ for (sort keys %apis) {
+ my($name, $schema) = ($_, $apis{$_});
+ my $def = $name;
+ my $dec = sprintf 'JD.field "%s"%s <| %s', $name,
+ ' 'x($len-(length $name)),
+ @$schema == 0 ? "JD.succeed $name" :
+ @$schema == 1 ? "JD.map $name" : sprintf 'JD.map%d %s', scalar @$schema, $name;
+ my $tname = "Api$name";
+ for my $argn (0..$#$schema) {
+ my $arg = $schema->[$argn]->analyze();
+ my $jd = $arg->elm_decoder(json_decode => 'JD.', level => 3);
+ $dec .= " (JD.index $argn $jd)";
+ if($arg->{keys}) {
+ $data .= def_type $tname, $arg;
+ $def .= " $tname";
+ } elsif($arg->{values} && $arg->{values}{keys}) {
+ $data .= def_type $tname, $arg->{values};
+ $def .= " (List $tname)";
+ } else {
+ $def .= ' '.$arg->elm_type();
+ }
+ }
+ push @union, $def;
+ push @decode, $dec;
+ }
+ $data .= sprintf "\ntype Response\n = HTTPError Http.Error\n | %s\n", join "\n | ", @union;
+ $data .= sprintf "\ndecode : JD.Decoder Response\ndecode = JD.oneOf\n [ %s\n ]", join "\n , ", @decode;
+
+ write_module Api => $data;
+};
+
+
+sub write_types {
+ my $data = '';
+
+ $data .= def urlStatic => String => string config->{url_static};
+
+ write_module Types => $data;
+}
+
+
+if(tuwf->{elmgen}) {
+ mkdir config->{root}.'/elm/Gen';
+ write_api;
+ write_types;
+ open my $F, '>', config->{root}.'/elm/Gen/.generated';
+ print $F scalar gmtime;
+}
+
+
+1;
diff --git a/lib/VNWeb/HTML.pm b/lib/VNWeb/HTML.pm
index 66ab52d6..d1498c1e 100644
--- a/lib/VNWeb/HTML.pm
+++ b/lib/VNWeb/HTML.pm
@@ -21,6 +21,7 @@ our @EXPORT = qw/
debug_
join_
user_
+ elm_
framework_
revision_
/;
@@ -61,6 +62,13 @@ sub user_ {
}
+# Instantiate an Elm module
+sub elm_($$$) {
+ my($mod, $schema, $data) = @_;
+ div_ 'data-elm-module' => 'DocEdit',
+ 'data-elm-flags' => JSON::XS->new->encode($schema->analyze->coerce_for_json($data, unknown => 'remove')), '';
+}
+
sub _head_ {
@@ -78,7 +86,8 @@ sub _head_ {
link_ rel => 'alternate', type => 'application/atom+xml', href => "/feeds/changes.atom", title => 'Recent Changes';
link_ rel => 'alternate', type => 'application/atom+xml', href => "/feeds/posts.atom", title => 'Recent Posts';
}
- meta_ name => 'robots', content => 'noindex, follow' if $o->{noindex};
+ meta_ name => 'csrf-token', content => auth->csrftoken;
+ meta_ name => 'robots', content => 'noindex' if defined $o->{index} && !$o->{index};
# Opengraph metadata
if($o->{og}) {
@@ -288,7 +297,7 @@ sub _hidden_msg_ {
# Options:
# title => $title
-# noindex => 1/0
+# index => 1/0, default 1
# feeds => 1/0
# search => $query
# og => { opengraph metadata }
@@ -313,7 +322,8 @@ sub framework_ {
_maintabs_ \%o;
$cont->() unless $o{hiddenmsg} && _hidden_msg_ \%o;
div_ id => 'footer', \&_footer_;
- }
+ };
+ script_ type => 'application/javascript', src => config->{url_static}.'/f/v2rw.js', '';
}
}
}
diff --git a/lib/VNWeb/Prelude.pm b/lib/VNWeb/Prelude.pm
index ecc5a606..26d0763e 100644
--- a/lib/VNWeb/Prelude.pm
+++ b/lib/VNWeb/Prelude.pm
@@ -14,6 +14,10 @@
# use VNWeb::Auth;
# use VNWeb::HTML;
# use VNWeb::DB;
+# use VNWeb::Validation;
+# use VNWeb::Elm;
+#
+# + A few other handy tools.
#
# WARNING: This should not be used from the above modules.
package VNWeb::Prelude;
@@ -22,6 +26,11 @@ use strict;
use warnings;
use feature ':5.26';
use utf8;
+use VNWeb::Elm;
+use VNWeb::Auth;
+use TUWF;
+use JSON::XS;
+
sub import {
my $c = caller;
@@ -44,11 +53,14 @@ sub import {
use VNWeb::Auth;
use VNWeb::HTML;
use VNWeb::DB;
+ use VNWeb::Validation;
+ use VNWeb::Elm;
1;
EOM;
no strict 'refs';
*{$c.'::RE'} = *RE;
+ *{$c.'::json_api'} = \&json_api;
}
@@ -73,4 +85,39 @@ our %RE = (
drev => qr{d$id$rev?},
);
+
+
+# Easy wrapper to create a simple API that accepts JSON data on POST requests.
+# The CSRF token and the input data are validated before the subroutine is
+# called.
+#
+# Usage:
+#
+# json_api '/some/url', {
+# username => { maxlength => 10 },
+# }, sub {
+# my $validated_data = shift;
+# };
+sub json_api {
+ my($path, $keys, $sub) = @_;
+
+ my $schema = ref $keys eq 'HASH' ? tuwf->compile({ type => 'hash', keys => $keys }) : $keys;
+
+ TUWF::post $path => sub {
+ if(!auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) {
+ warn "Invalid CSRF token in request\n";
+ return elm_CSRF;
+ }
+
+ my $data = tuwf->validate(json => $schema);
+ if(!$data) {
+ warn "JSON validation failed\ninput: " . JSON::XS->new->allow_nonref->pretty->canonical->encode(tuwf->reqJSON) . "\nerror: " . JSON::XS->new->encode($data->err) . "\n";
+ return elm_Invalid;
+ }
+
+ $sub->($data->data);
+ warn "Non-JSON response to a json_api request, is this intended?\n" if tuwf->resHeader('Content-Type') !~ /^application\/json/;
+ };
+}
+
1;
diff --git a/lib/VNWeb/Validation.pm b/lib/VNWeb/Validation.pm
index a014b11d..80af1d34 100644
--- a/lib/VNWeb/Validation.pm
+++ b/lib/VNWeb/Validation.pm
@@ -6,10 +6,76 @@ use VNWeb::Auth;
use Exporter 'import';
our @EXPORT = qw/
+ form_compile
+ form_changed
can_edit
/;
+TUWF::set custom_validations => {
+ id => { uint => 1, max => 1<<40 },
+ editsum => { required => 1, length => [ 2, 5000 ] },
+};
+
+
+# Recursively remove keys from hashes that have a '_when' key that doesn't
+# match $when. This is a quick and dirty way to create multiple validation
+# schemas from a single schema. For example:
+#
+# {
+# title => { _when => 'input' },
+# name => { },
+# }
+#
+# If $when is 'input', then this function returns:
+# { title => {}, name => {} }
+# Otherwise, it returns:
+# { name => {} }
+sub _stripwhen {
+ my($when, $o) = @_;
+ return $o if ref $o ne 'HASH';
+ +{ map $_ eq '_when' || (ref $o->{$_} eq 'HASH' && defined $o->{$_}{_when} && $o->{$_}{_when} !~ $when) ? () : ($_, _stripwhen($when, $o->{$_})), keys %$o }
+}
+
+
+# Short-hand to compile a validation schema for a form. Usage:
+#
+# form_compile $when, {
+# title => { _when => 'input' },
+# name => { },
+# ..
+# };
+sub form_compile {
+ tuwf->compile({ type => 'hash', keys => _stripwhen @_ });
+}
+
+
+sub _eq_deep {
+ my($a, $b) = @_;
+ return 0 if ref $a ne ref $b;
+ return 0 if defined $a != defined $b;
+ return 1 if !defined $a;
+ return 1 if !ref $a && $a eq $b;
+ return 1 if ref $a eq 'ARRAY' && (@$a == @$b && !grep !_eq_deep($a->[$_], $b->[$_]), 0..$#$a);
+ return 1 if ref $a eq 'HASH' && _eq_deep([sort keys %$a], [sort keys %$b]) && !grep !_eq_deep($a->{$_}, $b->{$_}), keys %$a;
+ 0
+}
+
+
+# Usage: form_changed $schema, $a, $b
+# Returns 1 if there is a difference between the data ($a) and the form input
+# ($b), using the normalization defined in $schema. The $schema must validate.
+sub form_changed {
+ my($schema, $a, $b) = @_;
+ my $na = $schema->validate($a)->data;
+ my $nb = $schema->validate($b)->data;
+
+ #warn "a=".JSON::XS->new->pretty->canonical->encode($na);
+ #warn "b=".JSON::XS->new->pretty->canonical->encode($nb);
+ !_eq_deep $na, $nb;
+}
+
+
# Returns whether the current user can edit the given database entry.
sub can_edit {
my($type, $entry) = @_;
diff --git a/util/vndb.pl b/util/vndb.pl
index d2b1a964..15db575a 100755
--- a/util/vndb.pl
+++ b/util/vndb.pl
@@ -13,7 +13,9 @@ BEGIN { ($ROOT = abs_path $0) =~ s{/util/vndb\.pl$}{}; }
use lib $ROOT.'/lib';
use SkinFile;
use VNDB::Config;
+use VNWeb::Auth;
use VNWeb::HTML ();
+use VNWeb::Validation ();
# load the skins
@@ -30,6 +32,10 @@ tuwf->{$_} = config->{$_} for keys %{ config() };
TUWF::set %{ config->{tuwf} };
+# Signal to VNWeb::Elm whether it should generate the Elm files.
+# Should be done before loading any more modules.
+tuwf->{elmgen} = $ARGV[0] && $ARGV[0] eq 'elmgen';
+
TUWF::hook before => sub {
# If we're running standalone, serve www/ and static/ too.
@@ -62,5 +68,33 @@ TUWF::set error_404_handler => sub {
};
-TUWF::load_recursive('VNDB::Util', 'VNDB::DB', 'VNDB::Handler', 'VNWeb');
-TUWF::run();
+sub TUWF::Object::resDenied {
+ tuwf->resStatus(403);
+ VNWeb::HTML::framework_ title => 'Access Denied', noindex => 1, sub {
+ div_ class => 'mainbox', sub {
+ h1_ 'Access Denied';
+ div_ class => 'warning', sub {
+ if(!auth) {
+ h2_ 'You need to be logged in to perform this action.';
+ p_ sub {
+ txt_ 'Please ';
+ a_ href => '/u/login', 'login';
+ txt_ ' or ';
+ a_ href => '/u/register', 'create an account';
+ txt_ " if you don't have one yet.";
+ }
+ } else {
+ h2_ 'You are not allowed to perform this action.';
+ p_ 'You do not have the proper rights to perform the action you wanted to perform.';
+ }
+ }
+ }
+ }
+}
+
+
+TUWF::load_recursive('VNDB::Util', 'VNDB::DB', 'VNDB::Handler');
+TUWF::set import_modules => 0;
+TUWF::load_recursive('VNWeb');
+
+TUWF::run if !tuwf->{elmgen};