diff options
author | Yorhel <git@yorhel.nl> | 2020-01-05 12:47:04 +0100 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2020-01-05 12:52:12 +0100 |
commit | d1d981efa5b0910260cbd1c226e3ab683c8304ae (patch) | |
tree | 8704fd96dc8e5820dae8017e5bfaf882ed80980f | |
parent | 0efea750ac26629f48fb50a9cdc9d71bd08257b7 (diff) |
refactor: Combine json_api() & elm_form() + generate Elm function to msg API endpoint
The new elm_api() function now creates an API endpoint (like json_api())
and generates a corresponding Elm module to interact with that API (like
elm_form()). The API endpoint URL is now derived from the name of the
Elm module, so there's no need to think of a separate URL and less prone
to making typos when using that URL from Elm.
Reduces the boilerplace a bit as well.
35 files changed, 252 insertions, 338 deletions
diff --git a/elm/Discussions/Edit.elm b/elm/Discussions/Edit.elm index 495a95e4..711e96ea 100644 --- a/elm/Discussions/Edit.elm +++ b/elm/Discussions/Edit.elm @@ -135,7 +135,7 @@ update msg model = Nothing -> ({ model | boardAdd = nm }, c) Just r -> ({ model | boardAdd = A.clear nm, boards = Maybe.map (\b -> b ++ [r]) model.boards }, c) - Submit -> ({ model | state = Api.Loading }, Api.post "/t/edit.json" (GDE.encode (encode model)) Submitted) + Submit -> ({ model | state = Api.Loading }, GDE.send (encode model) Submitted) Submitted (GApi.Redirect s) -> (model, load s) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) diff --git a/elm/Discussions/Poll.elm b/elm/Discussions/Poll.elm index 40037ba8..04761530 100644 --- a/elm/Discussions/Poll.elm +++ b/elm/Discussions/Poll.elm @@ -62,7 +62,7 @@ update msg model = if toomany model then (model, Cmd.none) else ( { model | state = Api.Loading } - , Api.post "/t/pollvote.json" (GDP.encode { tid = model.data.tid, options = List.filterMap (\o -> if o.my then Just o.id else Nothing) model.data.options }) Submitted + , GDP.send { tid = model.data.tid, options = List.filterMap (\o -> if o.my then Just o.id else Nothing) model.data.options } Submitted ) Submitted (GApi.Success) -> diff --git a/elm/Discussions/Reply.elm b/elm/Discussions/Reply.elm index c6e48a8e..a8d25434 100644 --- a/elm/Discussions/Reply.elm +++ b/elm/Discussions/Reply.elm @@ -50,9 +50,7 @@ update msg model = NotOldAnymore -> ({ model | old = False }, Cmd.none) Content m -> let (nm,nc) = TP.update m model.msg in ({ model | msg = nm }, Cmd.map Content nc) - Submit -> - let body = GDR.encode { msg = model.msg.data, tid = model.tid } - in ({ model | state = Api.Loading }, Api.post "/t/reply.json" body Submitted) + Submit -> ({ model | state = Api.Loading }, GDR.send { msg = model.msg.data, tid = model.tid } Submitted) -- Reload is necessary because s may be the same as the current URL (with a location.hash) Submitted (GApi.Redirect s) -> (model, Cmd.batch [ load s, reload ]) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) diff --git a/elm/DocEdit.elm b/elm/DocEdit.elm index e4282213..9fbea631 100644 --- a/elm/DocEdit.elm +++ b/elm/DocEdit.elm @@ -5,7 +5,6 @@ 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.TextPreview as TP import Lib.Api as Api @@ -69,10 +68,7 @@ update msg model = Title s -> ({ model | title = s }, Cmd.none) Content m -> let (nm,nc) = TP.update m model.content in ({ model | content = nm }, Cmd.map Content nc) - Submit -> - let body = GD.encode (encode model) - in ({ model | state = Api.Loading }, Api.post "/d/edit.json" body Submitted) - + Submit -> ({ model | state = Api.Loading }, GD.send (encode model) Submitted) Submitted (GApi.Redirect s) -> (model, load s) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) diff --git a/elm/Lib/Api.elm b/elm/Lib/Api.elm index ae900fe5..112dcc81 100644 --- a/elm/Lib/Api.elm +++ b/elm/Lib/Api.elm @@ -55,11 +55,12 @@ expectResponse msg = in Http.expectJson res decode --- Send a POST request with a JSON body to the VNDB API and get a Response back. +-- Send a POST request to a Perl `elm_api` endpoint +-- Should not be used directly, use the `send` function in the appropriate Gen.FormName module instead. post : String -> JE.Value -> (Response -> msg) -> Cmd msg -post url body msg = +post name body msg = Http.post - { url = url + { url = "/elm/" ++ name ++ ".json" , body = Http.jsonBody body , expect = expectResponse msg } diff --git a/elm/Lib/Autocomplete.elm b/elm/Lib/Autocomplete.elm index 77f52f9e..a478921b 100644 --- a/elm/Lib/Autocomplete.elm +++ b/elm/Lib/Autocomplete.elm @@ -24,6 +24,7 @@ import Lib.Util exposing (..) import Lib.Api as Api import Gen.Types exposing (boardTypes) import Gen.Api as GApi +import Gen.Boards as GB type alias Config m a = @@ -37,9 +38,8 @@ type alias Config m a = type alias SourceConfig m a = - -- API path to query for completion results. - -- (The API must accept POST requests with {"search":".."} as body) - { path : String + -- API endpoint to query for completion results. + { endpoint : String -> (GApi.Response -> m) -> Cmd m -- How to decode results from the API , decode : GApi.Response -> Maybe (List a) -- How to display the decoded results @@ -54,7 +54,7 @@ type alias SourceConfig m a = boardSource : SourceConfig m GApi.ApiBoardResult boardSource = - { path = "/t/boards.json" + { endpoint = \s -> GB.send { search = s } , decode = \x -> case x of GApi.BoardResult e -> Just e _ -> Nothing @@ -161,7 +161,7 @@ update cfg msg model = if model.value == "" || model.wait /= i then mod model else ( model - , Api.post cfg.source.path (JE.object [("search", JE.string model.value)]) (cfg.wrap << Results model.value) + , cfg.source.endpoint model.value (cfg.wrap << Results model.value) , Nothing ) Results s r -> mod <| diff --git a/elm/Lib/TextPreview.elm b/elm/Lib/TextPreview.elm index fba61ff3..9431848a 100644 --- a/elm/Lib/TextPreview.elm +++ b/elm/Lib/TextPreview.elm @@ -3,42 +3,43 @@ module Lib.TextPreview exposing (..) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Json.Encode as JE import Lib.Html exposing (..) import Lib.Ffi as Ffi import Lib.Api as Api import Gen.Api as GApi +import Gen.Markdown as GM +import Gen.BBCode as GB type alias Model = - { state : Api.State - , data : String -- contents of the textarea - , preview : String -- Rendered HTML, "" if not in sync with data - , display : Bool -- False = textarea is displayed, True = preview is displayed - , apiUrl : String - , class : String + { state : Api.State + , data : String -- contents of the textarea + , preview : String -- Rendered HTML, "" if not in sync with data + , display : Bool -- False = textarea is displayed, True = preview is displayed + , endpoint : { content : String } -> (GApi.Response -> Msg) -> Cmd Msg + , class : String } bbcode : String -> Model bbcode data = - { state = Api.Normal - , data = data - , preview = "" - , display = False - , apiUrl = "/js/bbcode.json" - , class = "preview bbcode" + { state = Api.Normal + , data = data + , preview = "" + , display = False + , endpoint = GB.send + , class = "preview bbcode" } markdown : String -> Model markdown data = - { state = Api.Normal - , data = data - , preview = "" - , display = False - , apiUrl = "/js/markdown.json" - , class = "preview docs" + { state = Api.Normal + , data = data + , preview = "" + , display = False + , endpoint = GM.send + , class = "preview docs" } @@ -59,7 +60,7 @@ update msg model = if model.preview /= "" then ( { model | display = True }, Cmd.none) else ( { model | display = True, state = Api.Loading } - , Api.post model.apiUrl (JE.object [("content", JE.string model.data)]) HandlePreview + , model.endpoint { content = model.data } HandlePreview ) HandlePreview (GApi.Content s) -> ({ model | state = Api.Normal, preview = s }, Cmd.none) diff --git a/elm/StaffEdit/Main.elm b/elm/StaffEdit/Main.elm index 2aace15a..423e088d 100644 --- a/elm/StaffEdit/Main.elm +++ b/elm/StaffEdit/Main.elm @@ -147,10 +147,7 @@ update msg model = AliasMain n _ -> ({ model | aid = n }, Cmd.none) AliasAdd -> ({ model | alias = model.alias ++ [{ aid = newAid model, name = "", original = "", inuse = False }] }, Cmd.none) - Submit -> - let body = GSE.encode (encode model) - in ({ model | state = Api.Loading }, Api.post "/s/edit.json" body Submitted) - + Submit -> ({ model | state = Api.Loading }, GSE.send (encode model) Submitted) Submitted (GApi.Redirect s) -> (model, load s) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) diff --git a/elm/UList/DateEdit.elm b/elm/UList/DateEdit.elm index a9a94960..ff0f408b 100644 --- a/elm/UList/DateEdit.elm +++ b/elm/UList/DateEdit.elm @@ -63,7 +63,7 @@ update msg model = if n /= model.debnum || model.val == model.flags.date || not model.valid then (model, Cmd.none) else ( { model | state = Api.Loading, debnum = model.debnum+1 } - , Api.post "/u/ulist/setdate.json" (GDE.encode { uid = model.flags.uid, vid = model.flags.vid, start = model.flags.start, date = model.val }) Saved ) + , GDE.send { uid = model.flags.uid, vid = model.flags.vid, start = model.flags.start, date = model.val } Saved ) Saved GApi.Success -> let f = model.flags diff --git a/elm/UList/LabelEdit.elm b/elm/UList/LabelEdit.elm index f1f14e0f..a1ab799b 100644 --- a/elm/UList/LabelEdit.elm +++ b/elm/UList/LabelEdit.elm @@ -66,7 +66,7 @@ update msg model = , state = Dict.insert l Api.Loading model.state } , Cmd.batch <| - Api.post "/u/ulist/setlabel.json" (GLE.encode { uid = model.uid, vid = model.vid, label = l, applied = b }) (Saved l b) + GLE.send { uid = model.uid, vid = model.vid, label = l, applied = b } (Saved l b) -- Unselect other progress labels (1..4) when setting a progress label :: if cascade then (List.map (\i -> selfCmd (Toggle i False False)) <| List.filter (\i -> l >= 0 && l <= 4 && i >= 0 && i <= 4 && i /= l) <| Set.toList model.tsel) diff --git a/elm/UList/ManageLabels.elm b/elm/UList/ManageLabels.elm index ab058d99..de56844a 100644 --- a/elm/UList/ManageLabels.elm +++ b/elm/UList/ManageLabels.elm @@ -59,8 +59,7 @@ update msg model = ( { model | labels = model.labels ++ [{ id = -1, label = "New label", private = List.all (\il -> il.private) model.labels, count = 0, delete = Nothing }] } , Task.attempt (always Noop) <| Ffi.elemCall "select" <| "label_txt_" ++ String.fromInt (List.length model.labels) ) - Submit -> ({ model | state = Api.Loading }, Api.post "/u/ulist/labels.json" (GML.encode { uid = model.uid, labels = model.labels }) Submitted) - + Submit -> ({ model | state = Api.Loading }, GML.send { uid = model.uid, labels = model.labels } Submitted) Submitted GApi.Success -> (model, reload) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) diff --git a/elm/UList/Opt.elm b/elm/UList/Opt.elm index e05a21d9..10e41f7d 100644 --- a/elm/UList/Opt.elm +++ b/elm/UList/Opt.elm @@ -3,7 +3,6 @@ port module UList.Opt exposing (main) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Json.Encode as JE import Task import Process import Browser @@ -16,12 +15,12 @@ import Lib.RDate as RDate import Lib.DropDown as DD import Gen.Types as T import Gen.Api as GApi -import Gen.UListVNOpt as GVO import Gen.UListVNNotes as GVN import Gen.UListDel as GDE import Gen.UListRStatus as GRS +import Gen.Release as GR -main : Program GVO.Recv Model Msg +main : Program GVN.Recv Model Msg main = Browser.element { init = \f -> (init f, Date.today |> Task.perform Today) , subscriptions = \model -> Sub.batch (List.map (\r -> DD.sub r.dd) <| model.rels) @@ -49,7 +48,7 @@ newrel rid vid st = } type alias Model = - { flags : GVO.Recv + { flags : GVN.Recv , today : Date.Date , del : Bool , delState : Api.State @@ -62,7 +61,7 @@ type alias Model = , relState : Api.State } -init : GVO.Recv -> Model +init : GVN.Recv -> Model init f = { flags = f , today = Date.fromOrdinalDate 2100 1 @@ -109,7 +108,7 @@ update msg model = Del b -> ({ model | del = b }, Cmd.none) Delete -> ( { model | delState = Api.Loading } - , Api.post "/u/ulist/del.json" (GDE.encode { uid = model.flags.uid, vid = model.flags.vid }) Deleted) + , GDE.send { uid = model.flags.uid, vid = model.flags.vid } Deleted) Deleted GApi.Success -> (model, ulistVNDeleted True) Deleted e -> ({ model | delState = Api.Error e }, Cmd.none) @@ -120,7 +119,7 @@ update msg model = if rev /= model.notesRev || model.notes == model.flags.notes then (model, Cmd.none) else ( { model | notesState = Api.Loading } - , Api.post "/u/ulist/setnote.json" (GVN.encode { uid = model.flags.uid, vid = model.flags.vid, notes = model.notes }) (NotesSaved rev)) + , GVN.send { uid = model.flags.uid, vid = model.flags.vid, notes = model.notes } (NotesSaved rev)) NotesSaved rev GApi.Success -> let f = model.flags nf = { f | notes = model.notes } @@ -132,7 +131,7 @@ update msg model = RelOpen rid b -> ({ model | rels = modrel rid (\r -> { r | dd = DD.toggle r.dd b }) model.rels }, Cmd.none) RelSet rid st _ -> ( { model | rels = modrel rid (\r -> { r | dd = DD.toggle r.dd False, status = st, state = Api.Loading }) model.rels } - , Api.post "/u/ulist/rstatus.json" (GRS.encode { uid = model.flags.uid, rid = rid, status = st }) (RelSaved rid st) ) + , GRS.send { uid = model.flags.uid, rid = rid, status = st } (RelSaved rid st) ) RelSaved rid st GApi.Success -> let nr = if st == -1 then List.filter (\r -> r.id /= rid) model.rels else modrel rid (\r -> { r | state = Api.Normal }) model.rels @@ -142,7 +141,7 @@ update msg model = RelLoad -> ( { model | relState = Api.Loading } - , Api.post "/r/get.json" (JE.object [("vid", JE.int model.flags.vid)]) RelLoaded ) + , GR.send { vid = model.flags.vid } RelLoaded ) RelLoaded (GApi.Releases rels) -> ( { model | relState = Api.Normal diff --git a/elm/UList/SaveDefault.elm b/elm/UList/SaveDefault.elm index 42fdef84..a0945c4b 100644 --- a/elm/UList/SaveDefault.elm +++ b/elm/UList/SaveDefault.elm @@ -49,7 +49,7 @@ update msg model = Submit -> ( { model | state = Api.Loading, hid = False } - , Api.post "/u/ulist/savedefault.json" (GUSD.encode { uid = model.uid, opts = model.opts, field = model.field }) Submitted) + , GUSD.send { uid = model.uid, opts = model.opts, field = model.field } Submitted) Submitted GApi.Success -> ({ model | state = Api.Normal, hid = True }, Cmd.none) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) diff --git a/elm/UList/VNPage.elm b/elm/UList/VNPage.elm index 03fbaf6b..05d94ecf 100644 --- a/elm/UList/VNPage.elm +++ b/elm/UList/VNPage.elm @@ -74,12 +74,12 @@ update msg model = Labels m -> let (nm, cmd) = LE.update m model.labels in ({ model | labels = nm}, Cmd.map Labels cmd) Vote m -> let (nm, cmd) = VE.update m model.vote in ({ model | vote = nm}, Cmd.map Vote cmd) - Add -> ({ model | state = Api.Loading }, Api.post "/u/ulist/add.json" (GAD.encode { uid = model.flags.uid, vid = model.flags.vid }) Added) + Add -> ({ model | state = Api.Loading }, GAD.send { uid = model.flags.uid, vid = model.flags.vid } Added) Added GApi.Success -> ({ model | state = Api.Normal, onlist = True }, Cmd.none) Added e -> ({ model | state = Api.Error e }, Cmd.none) Del b -> ({ model | del = b }, Cmd.none) - Delete -> ({ model | state = Api.Loading }, Api.post "/u/ulist/del.json" (GDE.encode { uid = model.flags.uid, vid = model.flags.vid }) Deleted) + Delete -> ({ model | state = Api.Loading }, GDE.send { uid = model.flags.uid, vid = model.flags.vid } Deleted) Deleted GApi.Success -> ({ model | state = Api.Normal, onlist = False, del = False }, Cmd.none) Deleted e -> ({ model | state = Api.Error e }, Cmd.none) diff --git a/elm/UList/VoteEdit.elm b/elm/UList/VoteEdit.elm index 058eb5aa..adf2cb95 100644 --- a/elm/UList/VoteEdit.elm +++ b/elm/UList/VoteEdit.elm @@ -60,7 +60,7 @@ update msg model = let nmodel = { model | text = if model.text == "" then "-" else model.text } in if nmodel.valid && (Just nmodel.text) /= nmodel.flags.vote then ( { nmodel | state = Api.Loading } - , Api.post "/u/ulist/setvote.json" (GVE.encode { uid = model.flags.uid, vid = model.flags.vid, vote = Just model.text }) Saved ) + , GVE.send { uid = model.flags.uid, vid = model.flags.vid, vote = Just model.text } Saved ) else (nmodel, Task.attempt (always Noop) <| Ffi.elemCall "reportValidity" model.fieldId) Saved GApi.Success -> diff --git a/elm/User/Edit.elm b/elm/User/Edit.elm index 121e283a..ddd9f78e 100644 --- a/elm/User/Edit.elm +++ b/elm/User/Edit.elm @@ -122,7 +122,7 @@ update msg model = Submit -> if model.cpass && model.pass1 /= model.pass2 then ({ model | passNeq = True }, Cmd.none ) - else ({ model | state = Api.Loading }, Api.post "/u/edit.json" (GUE.encode model.data) Submitted) + else ({ model | state = Api.Loading }, GUE.send model.data Submitted) -- TODO: This reload is only necessary for the skin and customcss options to apply, but it's nicer to do that directly from JS. Submitted GApi.Success -> (model, load <| "/u" ++ String.fromInt model.data.id ++ "/edit") diff --git a/elm/User/Login.elm b/elm/User/Login.elm index d28faf6b..0b560cbc 100644 --- a/elm/User/Login.elm +++ b/elm/User/Login.elm @@ -3,12 +3,12 @@ module User.Login exposing (main) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Json.Encode as JE import Browser import Browser.Navigation exposing (load) import Lib.Api as Api import Gen.Api as GApi -import Gen.UserEdit as GUE +import Gen.UserLogin as GUL +import Gen.UserChangePass as GUCP import Gen.Types exposing (adminEMail) import Lib.Html exposing (..) @@ -47,19 +47,6 @@ init ref = } -encodeLogin : Model -> JE.Value -encodeLogin o = JE.object - [ ("username", JE.string o.username) - , ("password", JE.string o.password) ] - - -encodeChangePass : Model -> JE.Value -encodeChangePass o = JE.object - [ ("username", JE.string o.username) - , ("oldpass", JE.string o.password) - , ("newpass", JE.string o.newpass1) ] - - type Msg = Username String | Password String @@ -80,11 +67,11 @@ update msg model = Submit -> if not model.insecure then ( { model | state = Api.Loading } - , Api.post "/u/login.json" (encodeLogin model) Submitted ) + , GUL.send { username = model.username, password = model.password } Submitted ) else if model.newpass1 /= model.newpass2 then ( { model | noteq = True }, Cmd.none ) else ( { model | state = Api.Loading } - , Api.post "/u/changepass.json" (encodeChangePass model) Submitted ) + , GUCP.send { username = model.username, oldpass = model.password, newpass = model.newpass1 } Submitted ) Submitted GApi.Success -> (model, load model.ref) Submitted GApi.InsecurePass -> ({ model | insecure = True, state = if model.insecure then Api.Error GApi.InsecurePass else Api.Normal }, Cmd.none) @@ -99,12 +86,12 @@ view model = [ h1 [] [ text "Login" ] , table [ class "formtable" ] [ formField "username::Username" - [ inputText "username" model.username Username GUE.valUsername + [ inputText "username" model.username Username GUL.valUsername , br_ 1 , a [ href "/u/register" ] [ text "No account yet?" ] ] , formField "password::Password" - [ inputPassword "password" model.password Password GUE.valPasswordOld + [ inputPassword "password" model.password Password GUL.valPassword , br_ 1 , a [ href "/u/newpass" ] [ text "Forgot your password?" ] ] @@ -132,9 +119,9 @@ view model = , text "Your current password is in a public database of leaked passwords. You need to change it before you can continue." ] , table [ class "formtable" ] - [ formField "newpass1::New password" [ inputPassword "newpass1" model.newpass1 Newpass1 GUE.valPasswordNew ] + [ formField "newpass1::New password" [ inputPassword "newpass1" model.newpass1 Newpass1 GUCP.valNewpass ] , formField "newpass2::Repeat" - [ inputPassword "newpass2" model.newpass2 Newpass2 GUE.valPasswordNew + [ inputPassword "newpass2" model.newpass2 Newpass2 GUCP.valNewpass , br_ 1 , if model.noteq then b [ class "standout" ] [ text "Passwords do not match" ] else text "" ] diff --git a/elm/User/PassReset.elm b/elm/User/PassReset.elm index c1b5b516..641767d4 100644 --- a/elm/User/PassReset.elm +++ b/elm/User/PassReset.elm @@ -3,11 +3,10 @@ module User.PassReset exposing (main) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Json.Encode as JE import Browser import Lib.Api as Api import Gen.Api as GApi -import Gen.UserEdit as GUE +import Gen.UserPassReset as GUPR import Lib.Html exposing (..) @@ -35,11 +34,6 @@ init = } -encodeForm : Model -> JE.Value -encodeForm o = JE.object - [ ("email", JE.string o.email) ] - - type Msg = EMail String | Submit @@ -49,13 +43,10 @@ type Msg update : Msg -> Model -> (Model, Cmd Msg) update msg model = case msg of - EMail n -> ({ model | email = n }, Cmd.none) - - Submit -> ( { model | state = Api.Loading } - , Api.post "/u/newpass" (encodeForm model) Submitted ) - - Submitted GApi.Success -> ({ model | success = True }, Cmd.none) - Submitted e -> ({ model | state = Api.Error e }, Cmd.none) + EMail n -> ({ model | email = n }, Cmd.none) + Submit -> ({ model | state = Api.Loading }, GUPR.send { email = model.email } Submitted) + Submitted GApi.Success -> ({ model | success = True }, Cmd.none) + Submitted e -> ({ model | state = Api.Error e }, Cmd.none) view : Model -> Html Msg @@ -77,7 +68,7 @@ view model = , text " and we'll send you instructions to set a new password within a few minutes!" ] , table [ class "formtable" ] - [ formField "email::E-Mail" [ inputText "email" model.email EMail GUE.valEmail ] + [ formField "email::E-Mail" [ inputText "email" model.email EMail GUPR.valEmail ] ] ] , div [ class "mainbox" ] diff --git a/elm/User/PassSet.elm b/elm/User/PassSet.elm index bc5cc24d..618b4ba1 100644 --- a/elm/User/PassSet.elm +++ b/elm/User/PassSet.elm @@ -3,18 +3,17 @@ module User.PassSet exposing (main) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Json.Encode as JE import Browser import Browser.Navigation exposing (load) import Lib.Api as Api import Gen.Api as GApi -import Gen.UserEdit as GUE +import Gen.UserPassSet as GUPS import Lib.Html exposing (..) -main : Program String Model Msg +main : Program GUPS.Recv Model Msg main = Browser.element - { init = \url -> (init url, Cmd.none) + { init = \f -> (init f, Cmd.none) , subscriptions = always Sub.none , view = view , update = update @@ -22,7 +21,8 @@ main = Browser.element type alias Model = - { url : String + { token : String + , uid : Int , newpass1 : String , newpass2 : String , state : Api.State @@ -30,9 +30,10 @@ type alias Model = } -init : String -> Model -init url = - { url = url +init : GUPS.Recv -> Model +init f = + { token = f.token + , uid = f.uid , newpass1 = "" , newpass2 = "" , state = Api.Normal @@ -40,11 +41,6 @@ init url = } -encodeForm : Model -> JE.Value -encodeForm o = JE.object - [ ("password", JE.string o.newpass1) ] - - type Msg = Newpass1 String | Newpass2 String @@ -62,7 +58,7 @@ update msg model = if model.newpass1 /= model.newpass2 then ( { model | noteq = True }, Cmd.none) else ( { model | state = Api.Loading } - , Api.post model.url (encodeForm model) Submitted ) + , GUPS.send { token = model.token, uid = model.uid, password = model.newpass1 } Submitted ) Submitted GApi.Success -> (model, load "/") Submitted e -> ({ model | state = Api.Error e }, Cmd.none) @@ -75,9 +71,9 @@ view model = [ h1 [] [ text "Set your password" ] , p [] [ text "Now you can set a password for your account. You will be logged in automatically after your password has been saved." ] , table [ class "formtable" ] - [ formField "newpass1::New password" [ inputPassword "newpass1" model.newpass1 Newpass1 GUE.valPasswordNew ] + [ formField "newpass1::New password" [ inputPassword "newpass1" model.newpass1 Newpass1 GUPS.valPassword ] , formField "newpass2::Repeat" - [ inputPassword "newpass2" model.newpass2 Newpass2 GUE.valPasswordNew + [ inputPassword "newpass2" model.newpass2 Newpass2 GUPS.valPassword , br_ 1 , if model.noteq then b [ class "standout" ] [ text "Passwords do not match" ] else text "" ] diff --git a/elm/User/Register.elm b/elm/User/Register.elm index 60f5d7d4..9afdded4 100644 --- a/elm/User/Register.elm +++ b/elm/User/Register.elm @@ -3,11 +3,10 @@ module User.Register exposing (main) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Json.Encode as JE import Browser import Lib.Api as Api import Gen.Api as GApi -import Gen.UserEdit as GUE +import Gen.UserRegister as GUR import Lib.Html exposing (..) @@ -39,13 +38,6 @@ init = } -encodeForm : Model -> JE.Value -encodeForm o = JE.object - [ ("username", JE.string o.username) - , ("email", JE.string o.email) - , ("vns", JE.int o.vns) ] - - type Msg = Username String | EMail String @@ -62,7 +54,7 @@ update msg model = VNs n -> ({ model | vns = Maybe.withDefault model.vns (String.toInt n) }, Cmd.none) Submit -> ( { model | state = Api.Loading } - , Api.post "/u/register.json" (encodeForm model) Submitted ) + , GUR.send { username = model.username, email = model.email, vns = model.vns } Submitted ) Submitted GApi.Success -> ({ model | success = True }, Cmd.none) Submitted e -> ({ model | state = Api.Error e }, Cmd.none) @@ -83,13 +75,13 @@ view model = [ h1 [] [ text "Create an account" ] , table [ class "formtable" ] [ formField "username::Username" - [ inputText "username" model.username Username GUE.valUsername + [ inputText "username" model.username Username GUR.valUsername , br_ 1 , text "Preferred username. Must be lowercase, between 2 and 15 characters long and consist entirely of alphanumeric characters or a dash." , text " Names that look like database identifiers (i.e. a single letter followed by several numbers) are also disallowed." ] , formField "email::E-Mail" - [ inputText "email" model.email EMail GUE.valEmail + [ inputText "email" model.email EMail GUR.valEmail , br_ 1 , text "Your email address will only be used in case you lose your password. " , text "We will never send spam or newsletters unless you explicitly ask us for it or we get hacked." diff --git a/lib/VNWeb/Discussions/Edit.pm b/lib/VNWeb/Discussions/Edit.pm index f552d5e4..550be76c 100644 --- a/lib/VNWeb/Discussions/Edit.pm +++ b/lib/VNWeb/Discussions/Edit.pm @@ -34,61 +34,8 @@ my $FORM = { my $FORM_OUT = form_compile out => $FORM; my $FORM_IN = form_compile in => $FORM; -elm_form DiscussionsEdit => $FORM_OUT, $FORM_IN; - -TUWF::get qr{(?:/t/(?<board>$BOARD_RE)/new|/$RE{postid}/edit)}, sub { - my($board_type, $board_id) = (tuwf->capture('board')||'') =~ /^([^0-9]+)([0-9]*)$/; - my($tid, $num) = (tuwf->capture('id'), tuwf->capture('num')); - - $board_type = 'ge' if $board_type && $board_type eq 'an' && !auth->permBoardmod; - - my $t = !$tid ? {} : tuwf->dbRowi(' - SELECT t.id, tp.tid, tp.num, t.title, t.locked, t.private, t.poll_question, t.poll_max_options, tp.hidden, tp.msg, tp.uid AS user_id,', sql_totime('tp.date'), 'AS date - FROM threads t - JOIN threads_posts tp ON tp.tid = t.id AND tp.num =', \$num, - 'WHERE t.id =', \$tid, - 'AND', sql_visible_threads()); - return tuwf->resNotFound if $tid && !$t->{id}; - return tuwf->resDenied if !can_edit t => $t; - - $t->{poll}{options} = $t->{poll_question} && [ map $_->{option}, tuwf->dbAlli('SELECT option FROM threads_poll_options WHERE tid =', \$t->{id}, 'ORDER BY id')->@* ]; - $t->{poll}{question} = delete $t->{poll_question}; - $t->{poll}{max_options} = delete $t->{poll_max_options}; - $t->{poll} = undef if !$t->{poll}{question}; - - if($tid) { - enrich_boards undef, $t; - } else { - $t->{boards} = [ { - btype => $board_type, - iid => $board_id||0, - title => !$board_id ? undef : - tuwf->dbVali('SELECT title FROM', sql_boards(), 'x WHERE btype =', \$board_type, 'AND iid =', \$board_id) - } ]; - return tuwf->resNotFound if $board_id && !length $t->{boards}[0]{title}; - push $t->{boards}->@*, { btype => 'u', iid => auth->uid, title => auth->user->{user_name} } - if $board_type eq 'u' && $board_id != auth->uid; - } - - $t->{can_mod} = auth->permBoardmod; - $t->{can_private} = auth->permBoardmod || auth->permDbmod || auth->permUsermod; - - $t->{msg} //= ''; - $t->{title} //= tuwf->reqGet('title'); - $t->{tid} //= undef; - $t->{num} //= undef; - $t->{private} //= 0; - $t->{hidden} //= 0; - $t->{locked} //= 0; - - framework_ title => $tid ? 'Edit post' : 'Create new thread', sub { - elm_ 'Discussions.Edit' => $FORM_OUT, $t; - }; -}; - - -json_api qr{/t/edit\.json}, $FORM_IN, sub { +elm_api DiscussionsEdit => $FORM_OUT, $FORM_IN, sub { my($data) = @_; my $tid = $data->{tid}; my $num = $data->{num} || 1; @@ -160,4 +107,56 @@ json_api qr{/t/edit\.json}, $FORM_IN, sub { elm_Redirect post_url $tid, $num, $num; }; + +TUWF::get qr{(?:/t/(?<board>$BOARD_RE)/new|/$RE{postid}/edit)}, sub { + my($board_type, $board_id) = (tuwf->capture('board')||'') =~ /^([^0-9]+)([0-9]*)$/; + my($tid, $num) = (tuwf->capture('id'), tuwf->capture('num')); + + $board_type = 'ge' if $board_type && $board_type eq 'an' && !auth->permBoardmod; + + my $t = !$tid ? {} : tuwf->dbRowi(' + SELECT t.id, tp.tid, tp.num, t.title, t.locked, t.private, t.poll_question, t.poll_max_options, tp.hidden, tp.msg, tp.uid AS user_id,', sql_totime('tp.date'), 'AS date + FROM threads t + JOIN threads_posts tp ON tp.tid = t.id AND tp.num =', \$num, + 'WHERE t.id =', \$tid, + 'AND', sql_visible_threads()); + return tuwf->resNotFound if $tid && !$t->{id}; + return tuwf->resDenied if !can_edit t => $t; + + $t->{poll}{options} = $t->{poll_question} && [ map $_->{option}, tuwf->dbAlli('SELECT option FROM threads_poll_options WHERE tid =', \$t->{id}, 'ORDER BY id')->@* ]; + $t->{poll}{question} = delete $t->{poll_question}; + $t->{poll}{max_options} = delete $t->{poll_max_options}; + $t->{poll} = undef if !$t->{poll}{question}; + + if($tid) { + enrich_boards undef, $t; + } else { + $t->{boards} = [ { + btype => $board_type, + iid => $board_id||0, + title => !$board_id ? undef : + tuwf->dbVali('SELECT title FROM', sql_boards(), 'x WHERE btype =', \$board_type, 'AND iid =', \$board_id) + } ]; + return tuwf->resNotFound if $board_id && !length $t->{boards}[0]{title}; + push $t->{boards}->@*, { btype => 'u', iid => auth->uid, title => auth->user->{user_name} } + if $board_type eq 'u' && $board_id != auth->uid; + } + + $t->{can_mod} = auth->permBoardmod; + $t->{can_private} = auth->permBoardmod || auth->permDbmod || auth->permUsermod; + + $t->{msg} //= ''; + $t->{title} //= tuwf->reqGet('title'); + $t->{tid} //= undef; + $t->{num} //= undef; + $t->{private} //= 0; + $t->{hidden} //= 0; + $t->{locked} //= 0; + + framework_ title => $tid ? 'Edit post' : 'Create new thread', sub { + elm_ 'Discussions.Edit' => $FORM_OUT, $t; + }; +}; + + 1; diff --git a/lib/VNWeb/Discussions/JS.pm b/lib/VNWeb/Discussions/Elm.pm index 4c097830..77944926 100644 --- a/lib/VNWeb/Discussions/JS.pm +++ b/lib/VNWeb/Discussions/Elm.pm @@ -1,10 +1,10 @@ -package VNWeb::Discussions::JS; +package VNWeb::Discussions::Elm; use VNWeb::Prelude; use VNWeb::Discussions::Lib; # Autocompletion search results for boards -json_api qr{/t/boards.json}, { +elm_api Boards => undef, { search => {}, }, sub { return elm_Unauth if !auth->permBoard; diff --git a/lib/VNWeb/Discussions/Thread.pm b/lib/VNWeb/Discussions/Thread.pm index 7132f099..e410c920 100644 --- a/lib/VNWeb/Discussions/Thread.pm +++ b/lib/VNWeb/Discussions/Thread.pm @@ -19,14 +19,26 @@ my $POLL_OUT = form_compile any => { } }, }; - my $POLL_IN = form_compile any => { tid => { id => 1 }, options => { type => 'array', values => { id => 1 } }, }; +elm_api DiscussionsPoll => $POLL_OUT, $POLL_IN, sub { + my($data) = @_; + return elm_Unauth if !auth; + + my $t = tuwf->dbRowi('SELECT poll_question, poll_max_options FROM threads t WHERE id =', \$data->{tid}, 'AND', sql_visible_threads()); + return tuwf->resNotFound if !$t->{poll_question}; + + die 'Too many options' if $data->{options}->@* > $t->{poll_max_options}; + validate_dbid sql('SELECT id FROM threads_poll_options WHERE tid =', \$data->{tid}, 'AND id IN'), $data->{options}->@*; + + tuwf->dbExeci('DELETE FROM threads_poll_votes WHERE tid =', \$data->{tid}, 'AND uid =', \auth->uid); + tuwf->dbExeci('INSERT INTO threads_poll_votes', { tid => $data->{tid}, uid => auth->uid, optid => $_ }) for $data->{options}->@*; + elm_Success +}; -elm_form 'DiscussionsPoll' => $POLL_OUT, $POLL_IN; @@ -39,7 +51,19 @@ my $REPLY = { my $REPLY_IN = form_compile in => $REPLY; my $REPLY_OUT = form_compile out => $REPLY; -elm_form 'DiscussionsReply' => $REPLY_OUT, $REPLY_IN; +elm_api DiscussionsReply => $REPLY_OUT, $REPLY_IN, sub { + my($data) = @_; + my $t = tuwf->dbRowi('SELECT id, locked, count FROM threads t WHERE id =', \$data->{tid}, 'AND', sql_visible_threads()); + return tuwf->resNotFound if !$t->{id}; + return elm_Unauth if !can_edit t => $t; + + my $num = $t->{count}+1; + my $msg = bb_subst_links $data->{msg}; + tuwf->dbExeci('INSERT INTO threads_posts', { tid => $t->{id}, num => $num, uid => auth->uid, msg => $msg }); + tuwf->dbExeci('UPDATE threads SET count =', \$num, 'WHERE id =', \$t->{id}); + elm_Redirect post_url $t->{id}, $num, 'last'; +}; + @@ -178,34 +202,4 @@ TUWF::get qr{/$RE{postid}}, sub { tuwf->resRedirect(post_url($id, $num, $num), 'perm') }; - -json_api qr{/t/pollvote\.json}, $POLL_IN, sub { - my($data) = @_; - return elm_Unauth if !auth; - - my $t = tuwf->dbRowi('SELECT poll_question, poll_max_options FROM threads t WHERE id =', \$data->{tid}, 'AND', sql_visible_threads()); - return tuwf->resNotFound if !$t->{poll_question}; - - die 'Too many options' if $data->{options}->@* > $t->{poll_max_options}; - validate_dbid sql('SELECT id FROM threads_poll_options WHERE tid =', \$data->{tid}, 'AND id IN'), $data->{options}->@*; - - tuwf->dbExeci('DELETE FROM threads_poll_votes WHERE tid =', \$data->{tid}, 'AND uid =', \auth->uid); - tuwf->dbExeci('INSERT INTO threads_poll_votes', { tid => $data->{tid}, uid => auth->uid, optid => $_ }) for $data->{options}->@*; - elm_Success -}; - - -json_api qr{/t/reply\.json}, $REPLY_IN, sub { - my($data) = @_; - my $t = tuwf->dbRowi('SELECT id, locked, count FROM threads t WHERE id =', \$data->{tid}, 'AND', sql_visible_threads()); - return tuwf->resNotFound if !$t->{id}; - return elm_Unauth if !can_edit t => $t; - - my $num = $t->{count}+1; - my $msg = bb_subst_links $data->{msg}; - tuwf->dbExeci('INSERT INTO threads_posts', { tid => $t->{id}, num => $num, uid => auth->uid, msg => $msg }); - tuwf->dbExeci('UPDATE threads SET count =', \$num, 'WHERE id =', \$t->{id}); - elm_Redirect post_url $t->{id}, $num, 'last'; -}; - 1; diff --git a/lib/VNWeb/Docs/Edit.pm b/lib/VNWeb/Docs/Edit.pm index 65aa6442..82d9506f 100644 --- a/lib/VNWeb/Docs/Edit.pm +++ b/lib/VNWeb/Docs/Edit.pm @@ -18,8 +18,6 @@ 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; @@ -34,7 +32,7 @@ TUWF::get qr{/$RE{drev}/edit} => sub { }; -json_api qr{/d/edit\.json}, $FORM_IN, sub { +elm_api DocEdit => $FORM_OUT, $FORM_IN, sub { my $data = shift; my $doc = db_entry d => $data->{id} or return tuwf->resNotFound; @@ -46,7 +44,7 @@ json_api qr{/d/edit\.json}, $FORM_IN, sub { }; -json_api qr{/js/markdown\.json}, { +elm_api Markdown => undef, { content => { required => 0, default => '' } }, sub { return elm_Unauth if !auth->permDbmod; diff --git a/lib/VNWeb/Elm.pm b/lib/VNWeb/Elm.pm index 7bca4497..d9bdd7cc 100644 --- a/lib/VNWeb/Elm.pm +++ b/lib/VNWeb/Elm.pm @@ -18,7 +18,7 @@ use VNDB::Types; use VNWeb::Auth; our @EXPORT = qw/ - elm_form + elm_api /; @@ -176,30 +176,63 @@ sub write_module { - -# Create type definitions and a JSON encoder for a typical form. +# Create an API endpoint that can be called from Elm. # Usage: # -# elm_form 'FormName', $TO_ELM_SCHEMA, $TO_SERVER_SCHEMA; +# elm_api FormName => $OUT_SCHEMA, $IN_SCHEMA, sub { +# my($data) = @_; +# elm_Success # Or any other elm_Response() function +# }; +# +# That will create an endpoint at `POST /elm/FormName.json` that accepts JSON +# data that must validate $IN_SCHEMA. The subroutine is given the validated +# data as argument. # -# That will create a Gen.FormName module with the following definitions: +# It will also create an Elm module called `Gen.FormName` with the following definitions: # +# -- Elm type corresponding to $OUT_SCHEMA # type alias Recv = { .. } +# -- Elm type corresponding to $IN_SCHEMA # type alias Send = { .. } -# encode : Send -> JE.Value +# -- HTML Validation attributes corresponding to fields in `Send` # valFieldName : List Html.Attribute # -sub elm_form { - return if !tuwf->{elmgen}; - my($name, $out, $in) = @_; +# -- Command to send an API request to the endpoint and receive a response +# send : Send -> (Gen.Api.Response -> msg) -> Cmd msg +# +sub elm_api { + my($name, $out, $in, $sub) = @_; - my $data = ''; - $data .= def_type Recv => $out->analyze if $out; - $data .= def_type Send => $in->analyze if $in; - $data .= encoder encode => 'Send', $in->analyze if $in; - $data .= def_validation val => $in->analyze if $in; + $in = ref $in eq 'HASH' ? tuwf->compile({ type => 'hash', keys => $in }) : $in; + $out = ref $out eq 'HASH' ? tuwf->compile({ type => 'hash', keys => $out }) : $out; + + TUWF::post qr{/elm/\Q$name\E\.json} => sub { + if(!auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) { + warn "Invalid CSRF token in request\n"; + return elm_CSRF(); + } - write_module $name, $data; + my $data = tuwf->validate(json => $in); + 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/; + }; + + if(tuwf->{elmgen}) { + my $data = "import Gen.Api as GApi\n"; + $data .= "import Lib.Api as Api\n"; + $data .= def_type Recv => $out->analyze if $out; + $data .= def_type Send => $in->analyze; + $data .= def_validation val => $in->analyze; + $data .= encoder encode => 'Send', $in->analyze; + $data .= "send : Send -> (GApi.Response -> msg) -> Cmd msg\n"; + $data .= "send v m = Api.post \"$name\" (encode v) m\n"; + write_module $name, $data; + } } diff --git a/lib/VNWeb/Misc/BBCode.pm b/lib/VNWeb/Misc/BBCode.pm index 643ccbc4..5d6f2e0b 100644 --- a/lib/VNWeb/Misc/BBCode.pm +++ b/lib/VNWeb/Misc/BBCode.pm @@ -2,8 +2,10 @@ package VNWeb::Misc::BBCode; use VNWeb::Prelude; -json_api qr{/js/bbcode\.json}, { +elm_api BBCode => undef, { content => { required => 0, default => '' } }, sub { elm_Content bb2html bb_subst_links shift->{content}; }; + +1; diff --git a/lib/VNWeb/Prelude.pm b/lib/VNWeb/Prelude.pm index b942ff8f..64ef289c 100644 --- a/lib/VNWeb/Prelude.pm +++ b/lib/VNWeb/Prelude.pm @@ -70,7 +70,6 @@ sub import { no strict 'refs'; *{$c.'::RE'} = *RE; - *{$c.'::json_api'} = \&json_api; *{$c.'::in'} = \∈ } @@ -100,41 +99,6 @@ our %RE = ( ); - -# 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/; - }; -} - - # Simple "is this element in the array?" function, using 'eq' to test equality. # Supports both an @array and \@array. # Usage: diff --git a/lib/VNWeb/Releases/JS.pm b/lib/VNWeb/Releases/Elm.pm index 34bf823f..32dd89ca 100644 --- a/lib/VNWeb/Releases/JS.pm +++ b/lib/VNWeb/Releases/Elm.pm @@ -1,10 +1,10 @@ -package VNWeb::Releases::JS; +package VNWeb::Releases::Elm; use VNWeb::Prelude; # Used by UList.Opt to fetch releases from a VN id. -json_api qr{/r/get\.json}, { vid => { id => 1 } }, sub { +elm_api Release => undef, { vid => { id => 1 } }, sub { my($data) = @_; my $l = tuwf->dbAlli( 'SELECT r.id, r.title, r.original, r.type AS rtype, r.released diff --git a/lib/VNWeb/Staff/Edit.pm b/lib/VNWeb/Staff/Edit.pm index 2feb52c1..deb5e7fc 100644 --- a/lib/VNWeb/Staff/Edit.pm +++ b/lib/VNWeb/Staff/Edit.pm @@ -31,8 +31,6 @@ my $FORM_OUT = form_compile out => $FORM; my $FORM_IN = form_compile in => $FORM; my $FORM_CMP = form_compile cmp => $FORM; -elm_form StaffEdit => $FORM_OUT, $FORM_IN; - TUWF::get qr{/$RE{srev}/edit} => sub { my $e = db_entry s => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound; @@ -65,7 +63,7 @@ TUWF::get qr{/s/new}, sub { }; -json_api qr{/s/edit\.json}, $FORM_IN, sub { +elm_api StaffEdit => $FORM_OUT, $FORM_IN, sub { my $data = shift; my $new = !$data->{id}; my $e = $new ? { id => 0 } : db_entry s => $data->{id} or return tuwf->resNotFound; diff --git a/lib/VNWeb/User/Edit.pm b/lib/VNWeb/User/Edit.pm index 82e08729..bfd2e5f8 100644 --- a/lib/VNWeb/User/Edit.pm +++ b/lib/VNWeb/User/Edit.pm @@ -39,8 +39,6 @@ my $FORM = form_compile in => { authmod => { anybool => 1 }, }; -# Some validations in this form are also used by other User.* Elm modules. -elm_form UserEdit => undef, $FORM; sub _getmail { @@ -77,7 +75,7 @@ TUWF::get qr{/$RE{uid}/edit}, sub { }; -json_api qr{/u/edit\.json}, $FORM, sub { +elm_api UserEdit => undef, $FORM, sub { my $data = shift; my $username = tuwf->dbVali('SELECT username FROM users WHERE id =', \$data->{id}); diff --git a/lib/VNWeb/User/Lists.pm b/lib/VNWeb/User/Lists.pm index 9620eb80..6df2b345 100644 --- a/lib/VNWeb/User/Lists.pm +++ b/lib/VNWeb/User/Lists.pm @@ -27,9 +27,7 @@ my $LABELS = form_compile any => { } } }; -elm_form 'UListManageLabels', undef, $LABELS; - -json_api qr{/u/ulist/labels\.json}, $LABELS, sub { +elm_api UListManageLabels => undef, $LABELS, sub { my($uid, $labels) = ($_[0]{uid}, $_[0]{labels}); return elm_Unauth if !own $uid; @@ -88,9 +86,7 @@ my $VNVOTE = form_compile any => { vote => { vnvote => 1 }, }; -elm_form 'UListVoteEdit', undef, $VNVOTE; - -json_api qr{/u/ulist/setvote\.json}, $VNVOTE, sub { +elm_api UListVoteEdit => undef, $VNVOTE, sub { my($data) = @_; return elm_Unauth if !own $data->{uid}; tuwf->dbExeci( @@ -120,9 +116,7 @@ my $VNLABELS = { my $VNLABELS_OUT = form_compile out => $VNLABELS; my $VNLABELS_IN = form_compile in => $VNLABELS; -elm_form 'UListLabelEdit', $VNLABELS_OUT, $VNLABELS_IN; - -json_api qr{/u/ulist/setlabel\.json}, $VNLABELS_IN, sub { +elm_api UListLabelEdit => $VNLABELS_OUT, $VNLABELS_IN, sub { my($data) = @_; return elm_Unauth if !own $data->{uid}; die "Attempt to set vote label" if $data->{label} == 7; @@ -151,9 +145,7 @@ my $VNDATE = form_compile any => { start => { anybool => 1 }, # Field selection, started/finished }; -elm_form 'UListDateEdit', undef, $VNDATE; - -json_api qr{/u/ulist/setdate\.json}, $VNDATE, sub { +elm_api UListDateEdit => undef, $VNDATE, sub { my($data) = @_; return elm_Unauth if !own $data->{uid}; tuwf->dbExeci( @@ -184,20 +176,14 @@ my $VNOPT = form_compile any => { relstatus => { type => 'array', values => { uint => 1 } }, # List of release statuses, same order as rels }; -elm_form 'UListVNOpt', $VNOPT, undef; - - -my $VNNOTES = form_compile any => { +# UListVNNotes module is abused for the UList.Opts flag definition +elm_api UListVNNotes => $VNOPT, { uid => { id => 1 }, vid => { id => 1 }, notes => { required => 0, default => '', maxlength => 2000 }, -}; - -elm_form 'UListVNNotes', undef, $VNNOTES; - -json_api qr{/u/ulist/setnote\.json}, $VNNOTES, sub { +}, sub { my($data) = @_; return elm_Unauth if !own $data->{uid}; tuwf->dbExeci( @@ -211,14 +197,10 @@ json_api qr{/u/ulist/setnote\.json}, $VNNOTES, sub { -my $VNDEL = form_compile any => { +elm_api UListDel => undef, { uid => { id => 1 }, vid => { id => 1 }, -}; - -elm_form 'UListDel', undef, $VNDEL; - -json_api qr{/u/ulist/del\.json}, $VNDEL, sub { +}, sub { my($data) = @_; return elm_Unauth if !own $data->{uid}; tuwf->dbExeci('DELETE FROM ulist_vns WHERE uid =', \$data->{uid}, 'AND vid =', \$data->{vid}); @@ -229,14 +211,10 @@ json_api qr{/u/ulist/del\.json}, $VNDEL, sub { -my $VNADD = form_compile any => { +elm_api UListAdd => undef, { uid => { id => 1 }, vid => { id => 1 }, -}; - -elm_form 'UListAdd', undef, $VNADD; - -json_api qr{/u/ulist/add\.json}, $VNADD, sub { +}, sub { my($data) = @_; return elm_Unauth if !own $data->{uid}; tuwf->dbExeci('INSERT INTO ulist_vns', $data, 'ON CONFLICT (uid, vid) DO NOTHING'); @@ -247,16 +225,12 @@ json_api qr{/u/ulist/add\.json}, $VNADD, sub { -my $RSTATUS = form_compile any => { +# Adds the release when not in the list. +elm_api UListRStatus => undef, { uid => { id => 1 }, rid => { id => 1 }, status => { int => 1, enum => [ -1, keys %RLIST_STATUS ] }, # -1 meaning delete -}; - -elm_form 'UListRStatus', undef, $RSTATUS; - -# Adds the release when not in the list. -json_api qr{/u/ulist/rstatus\.json}, $RSTATUS, sub { +}, sub { my($data) = @_; return elm_Unauth if !own $data->{uid}; if($data->{status} == -1) { @@ -291,9 +265,7 @@ my $SAVED_OPTS = { my $SAVED_OPTS_IN = form_compile in => $SAVED_OPTS; my $SAVED_OPTS_OUT = form_compile out => $SAVED_OPTS; -elm_form UListSaveDefault => $SAVED_OPTS_OUT, $SAVED_OPTS_IN; - -json_api qr{/u/ulist/savedefault\.json}, $SAVED_OPTS_IN, sub { +elm_api UListSaveDefault => $SAVED_OPTS_OUT, $SAVED_OPTS_IN, sub { my($data) = @_; return elm_Unauth if !own $data->{uid}; tuwf->dbExeci('UPDATE users SET ulist_'.$data->{field}, '=', \JSON::XS->new->encode($data->{opts}), 'WHERE id =', \$data->{uid}); diff --git a/lib/VNWeb/User/Login.pm b/lib/VNWeb/User/Login.pm index d1069b26..95295e05 100644 --- a/lib/VNWeb/User/Login.pm +++ b/lib/VNWeb/User/Login.pm @@ -15,7 +15,7 @@ TUWF::get '/u/login' => sub { }; -json_api qr{/u/login\.json}, { +elm_api UserLogin => undef, { username => { username => 1 }, password => { password => 1 } }, sub { @@ -41,7 +41,7 @@ json_api qr{/u/login\.json}, { }; -json_api qr{/u/changepass\.json}, { +elm_api UserChangePass => undef, { username => { username => 1 }, oldpass => { password => 1 }, newpass => { password => 1 }, diff --git a/lib/VNWeb/User/PassReset.pm b/lib/VNWeb/User/PassReset.pm index 0edd21e3..39f1d6ea 100644 --- a/lib/VNWeb/User/PassReset.pm +++ b/lib/VNWeb/User/PassReset.pm @@ -10,7 +10,7 @@ TUWF::get '/u/newpass' => sub { }; -json_api '/u/newpass', { +elm_api UserPassReset => undef, { email => { email => 1 }, }, sub { my $data = shift; diff --git a/lib/VNWeb/User/PassSet.pm b/lib/VNWeb/User/PassSet.pm index 71929812..cbb6c31f 100644 --- a/lib/VNWeb/User/PassSet.pm +++ b/lib/VNWeb/User/PassSet.pm @@ -2,14 +2,17 @@ package VNWeb::User::PassSet; use VNWeb::Prelude; +my $FORM = { + uid => { id => 1 }, + token => { regex => qr/[a-f0-9]{40}/ }, + password => { _when => 'in', password => 1 }, +}; -# Compatibility with old the URL format -TUWF::get qr{/$RE{uid}/setpass}, sub { tuwf->resRedirect(sprintf('/u%d/setpass/%s', tuwf->capture('id'), tuwf->reqGet('t')||''), 'temp') }; - +my $FORM_IN = form_compile in => $FORM; +my $FORM_OUT = form_compile out => $FORM; -my $reset_url = qr{/$RE{uid}/setpass/(?<token>[a-f0-9]{40})}; -TUWF::get $reset_url, sub { +TUWF::get qr{/$RE{uid}/setpass/(?<token>[a-f0-9]{40})}, sub { return tuwf->resRedirect('/', 'temp') if auth; my $id = tuwf->capture('id'); @@ -19,24 +22,20 @@ TUWF::get $reset_url, sub { return tuwf->resNotFound if !$name || !auth->isvalidtoken($id, $token); framework_ title => 'Set password', sub { - elm_ 'User.PassSet', tuwf->compile({}), tuwf->reqPath; + elm_ 'User.PassSet', $FORM_OUT, { uid => $id, token => $token }; }; }; -json_api $reset_url, { - password => { password => 1 }, -}, sub { - my $data = shift; - my $id = tuwf->capture('id'); - my $token = tuwf->capture('token'); +elm_api UserPassSet => $FORM_OUT, $FORM_IN, sub { + my($data) = @_; return elm_InsecurePass if is_insecurepass($data->{password}); # "CSRF" is kind of wrong here, but the message advices to reload the page, # which will give a 404, which should be a good enough indication that the # token has expired. This case won't happen often. - return elm_CSRF if !auth->setpass($id, $token, undef, $data->{password}); - tuwf->dbExeci('UPDATE users SET email_confirmed = true WHERE id =', \$id); + return elm_CSRF if !auth->setpass($data->{uid}, $data->{token}, undef, $data->{password}); + tuwf->dbExeci('UPDATE users SET email_confirmed = true WHERE id =', \$data->{uid}); elm_Success }; diff --git a/lib/VNWeb/User/Register.pm b/lib/VNWeb/User/Register.pm index 05a1d433..2dd41e4e 100644 --- a/lib/VNWeb/User/Register.pm +++ b/lib/VNWeb/User/Register.pm @@ -11,7 +11,7 @@ TUWF::get '/u/register', sub { }; -json_api qr{/u/register\.json}, { +elm_api UserRegister => undef, { username => { username => 1 }, email => { email => 1 }, vns => { int => 1 }, |