summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2019-09-25 18:37:29 +0200
committerYorhel <git@yorhel.nl>2019-09-25 18:49:19 +0200
commitd735e66d7d9b2d8c9a965ec96753864ff8c306c2 (patch)
treece0214b9e3cc819252b9192e7518f7768e568c77
parentc7642c03d99ed0255614a43fb82e55a1dde66753 (diff)
v2rw: Add Elm & db_edit framework + Convert doc page editing
Most of this is copied from v3. I did improve on a few aspects: - db_edit() and db_entry() use VNDB::Schema rather than dynamically querying the DB. This has the minor advantage of a faster startup. - The Elm code generator now writes to multiple files, this avoids the namespace pollution seen in v3's Lib.Gen and makes the dependency graph a bit more lean (i.e. faster incremental builds). - The Elm code generator doesn't update the timestamp of files that haven't been modified. This also speeds up incremental builds, the elm compiler can now skip rebuilding unmodified files. - The Elm API response generator code now uses plain functions rather than code references and all possible responses are now defined in Elm.pm. Turns out most API responses were used from more than a single place, so it makes sense to have them centrally defined. The doc page preview function is also much nicer; I'd like to apply this to all BBCode textareas as well. (Elm.pm itself is ugly as hell though. And we will prolly need some HTML form generation functions in Elm to make that part less verbose)
-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};