diff options
| author | Yorhel <git@yorhel.nl> | 2019-07-29 16:48:48 +0200 |
|---|---|---|
| committer | Yorhel <git@yorhel.nl> | 2019-07-29 16:53:04 +0200 |
| commit | 6cda16f862283b4cb502af8ebdddea25bde29816 (patch) | |
| tree | 4a143aade9cd01d9ee7880a4696fd7ed4bdbb959 | |
| parent | e1e1d4e9b85d4ff0b26832fe95374f6f9718511e (diff) | |
v3: Define & Generate API responses from Perl
This allows Perl modules to define new API responses and the
corresponding Elm type and parser will be generated automatically. The
primary reason to do this is to ensure that Elm and Perl stay
synchronized and to make sure that errors in generating API responses
can easily be found on the server side.
Also moded json_api() from VN3::Validate to VN3::Prelude, as that seemed
more fitting.
47 files changed, 427 insertions, 469 deletions
diff --git a/elm3/CharEdit/General.elm b/elm3/CharEdit/General.elm index 43379afb..ee0dbd77 100644 --- a/elm3/CharEdit/General.elm +++ b/elm3/CharEdit/General.elm @@ -6,8 +6,8 @@ import Html.Events exposing (..) import File exposing (File) import Lib.Html exposing (..) import Lib.Autocomplete as A -import Lib.Gen exposing (..) import Lib.Util exposing (..) +import Lib.Gen as Gen import Lib.Api as Api @@ -33,11 +33,11 @@ type alias Model = , mainId : Int , mainSpoil : Int , mainName : String - , mainSearch : A.Model Api.Char + , mainSearch : A.Model Gen.ApiCharResult } -init : CharEdit -> Model +init : Gen.CharEdit -> Model init d = { alias = d.alias , aliasDuplicates = False @@ -91,7 +91,7 @@ new = } -searchConfig : A.Config Msg Api.Char +searchConfig : A.Config Msg Gen.ApiCharResult searchConfig = { wrap = MainSearch, id = "add-main", source = A.charSource } @@ -112,7 +112,7 @@ type Msg | Weight String | MainInstance Bool | MainSpoil String - | MainSearch (A.Msg Api.Char) + | MainSearch (A.Msg Gen.ApiCharResult) | ImgUpload (List File) | ImgDone Api.Response @@ -142,13 +142,13 @@ update msg model = Nothing -> ({ model | mainSearch = nm }, c) Just r -> -- If the selected char has a main, automatically select that as our main - let chr = Maybe.withDefault {id = r.id, name = r.name} r.main + let chr = Maybe.withDefault {id = r.id, name = r.name, original = r.original } r.main in ({ model | mainId = chr.id, mainName = chr.name, mainSearch = A.clear nm }, c) ImgUpload [i] -> ({ model | imgState = Api.Loading }, Api.postImage Api.Ch i ImgDone) ImgUpload _ -> (model, Cmd.none) - ImgDone (Api.Image id _ _) -> ({ model | image = id, imgState = Api.Normal }, Cmd.none) + ImgDone (Gen.Image id _ _) -> ({ model | image = id, imgState = Api.Normal }, Cmd.none) ImgDone r -> ({ model | image = 0, imgState = Api.Error r }, Cmd.none) @@ -208,10 +208,10 @@ view model = card "general" "General info" [] , cardRow "Meta" Nothing <| formGroups [ [ label [for "sex"] [text "Sex"] - , inputSelect [id "sex", onInput Gender] model.gender genders + , inputSelect [id "sex", onInput Gender] model.gender Gen.genders ] , [ label [for "bloodt"] [text "Blood type"] - , inputSelect [id "bloodt", onInput Bloodt] model.bloodt bloodTypes + , inputSelect [id "bloodt", onInput Bloodt] model.bloodt Gen.bloodTypes ] -- TODO: Enforce that both or neither are set , [ label [for "b_month"] [text "Birthday"] diff --git a/elm3/CharEdit/Main.elm b/elm3/CharEdit/Main.elm index b3332f25..dbb88788 100644 --- a/elm3/CharEdit/Main.elm +++ b/elm3/CharEdit/Main.elm @@ -5,7 +5,7 @@ import Html.Lazy exposing (..) import Browser import Browser.Navigation exposing (load) import Lib.Html exposing (..) -import Lib.Gen exposing (..) +import Lib.Gen as Gen import Lib.Api as Api import Lib.Editsum as Editsum import CharEdit.General as General @@ -13,7 +13,7 @@ import CharEdit.Traits as Traits import CharEdit.VN as VN -main : Program CharEdit Model Msg +main : Program Gen.CharEdit Model Msg main = Browser.element { init = \e -> (init e, Cmd.none) , view = view @@ -32,7 +32,7 @@ type alias Model = } -init : CharEdit -> Model +init : Gen.CharEdit -> Model init d = { state = Api.Normal , editsum = { authmod = d.authmod, editsum = d.editsum, locked = d.locked, hidden = d.hidden } @@ -43,7 +43,7 @@ init d = } -new : List CharEditVns -> List CharEditVnrels -> Model +new : List Gen.CharEditVns -> List Gen.CharEditVnrels -> Model new vns vnrels = { state = Api.Normal , editsum = Editsum.new @@ -54,7 +54,7 @@ new vns vnrels = } -encode : Model -> CharEditSend +encode : Model -> Gen.CharEditSend encode model = { editsum = model.editsum.editsum , hidden = model.editsum.hidden @@ -103,10 +103,10 @@ update msg model = case model.id of Just id -> "/c" ++ String.fromInt id ++ "/edit" Nothing -> "/c/add" - body = chareditSendEncode (encode model) + body = Gen.chareditSendEncode (encode model) in ({ model | state = Api.Loading }, Api.post path body Submitted) - Submitted (Api.Changed id rev) -> (model, load <| "/c" ++ String.fromInt id ++ "." ++ String.fromInt rev) + Submitted (Gen.Changed id rev) -> (model, load <| "/c" ++ String.fromInt id ++ "." ++ String.fromInt rev) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) diff --git a/elm3/CharEdit/Traits.elm b/elm3/CharEdit/Traits.elm index 66d220a5..60399452 100644 --- a/elm3/CharEdit/Traits.elm +++ b/elm3/CharEdit/Traits.elm @@ -5,19 +5,18 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import Lib.Html exposing (..) import Lib.Autocomplete as A -import Lib.Gen exposing (CharEditTraits) +import Lib.Gen as Gen import Lib.Util exposing (..) -import Lib.Api exposing (Trait) type alias Model = - { traits : List CharEditTraits - , search : A.Model Trait + { traits : List Gen.CharEditTraits + , search : A.Model Gen.ApiTraitResult , duplicates : Bool } -init : List CharEditTraits -> Model +init : List Gen.CharEditTraits -> Model init l = { traits = l , search = A.init @@ -28,10 +27,10 @@ init l = type Msg = Del Int | SetSpoil Int String - | Search (A.Msg Trait) + | Search (A.Msg Gen.ApiTraitResult) -searchConfig : A.Config Msg Trait +searchConfig : A.Config Msg Gen.ApiTraitResult searchConfig = { wrap = Search, id = "add-trait", source = A.traitSource } diff --git a/elm3/CharEdit/VN.elm b/elm3/CharEdit/VN.elm index cef66dfc..57a50c88 100644 --- a/elm3/CharEdit/VN.elm +++ b/elm3/CharEdit/VN.elm @@ -7,9 +7,8 @@ import Json.Encode as JE import Dict exposing (Dict) import Lib.Html exposing (..) import Lib.Autocomplete as A -import Lib.Gen exposing (..) +import Lib.Gen as Gen import Lib.Util exposing (..) -import Lib.Api exposing (VN) import Lib.Api as Api @@ -24,13 +23,13 @@ type alias VNRel = type alias Model = { vn : List VNRel - , releases : Dict Int (List CharEditVnrelsReleases) -- Mapping from VN id -> list of releases - , search : A.Model VN + , releases : Dict Int (List Gen.CharEditVnrelsReleases) -- Mapping from VN id -> list of releases + , search : A.Model Gen.ApiVNResult , duplicates : Bool } -init : List CharEditVns -> List CharEditVnrels -> Model +init : List Gen.CharEditVns -> List Gen.CharEditVnrels -> Model init vns rels = -- Turn the array from the server into a more usable data structure. This assumes that the array is ordered by VN id. let @@ -60,7 +59,7 @@ init vns rels = -- XXX: The model and the UI allow an invalid state: VN is present, but -- role="". This isn't too obvious to trigger, I hope, so in this case we'll -- just be lazy and not send the VN to the server. -encode : Model -> List CharEditSendVns +encode : Model -> List Gen.CharEditSendVns encode model = let vn e = @@ -78,11 +77,11 @@ type Msg | SetSpoil Int String | SetRRole Int Int String | SetRSpoil Int Int String - | Search (A.Msg VN) + | Search (A.Msg Gen.ApiVNResult) | ReleaseInfo Int Api.Response -searchConfig : A.Config Msg VN +searchConfig : A.Config Msg Gen.ApiVNResult searchConfig = { wrap = Search, id = "add-vn", source = A.vnSource } @@ -118,7 +117,7 @@ update msg model = Just _ -> Cmd.none in (validate { model | search = A.clear nm, vn = model.vn ++ [nrow] }, Cmd.batch [c, nc]) - ReleaseInfo vid (Api.ReleaseResult r) -> ({ model | releases = Dict.insert vid r model.releases}, Cmd.none) + ReleaseInfo vid (Gen.ReleaseResult r) -> ({ model | releases = Dict.insert vid r model.releases}, Cmd.none) ReleaseInfo _ _ -> (model, Cmd.none) @@ -146,7 +145,7 @@ view model = , editListField 1 "" [ inputSelect [onInput (SetRole n)] e.role <| (if e.relsel then [("", "Not involved")] else []) - ++ charRoles + ++ Gen.charRoles ] , editListField 1 "" [ if e.role == "" @@ -165,7 +164,7 @@ view model = ++ [ a [href <| "/r" ++ String.fromInt e.id, title e.title, target "_blank" ] [ text e.title ] ] , editListField 1 "" - [ inputSelect [onInput (SetRRole n e.id)] sel.role (("", "-default-") :: charRoles) ] + [ inputSelect [onInput (SetRRole n e.id)] sel.role (("", "-default-") :: Gen.charRoles) ] , editListField 1 "" [ if sel.role == "" then text "" diff --git a/elm3/DocEdit.elm b/elm3/DocEdit.elm index 09729a3d..4461c522 100644 --- a/elm3/DocEdit.elm +++ b/elm3/DocEdit.elm @@ -7,13 +7,13 @@ import Browser import Browser.Navigation exposing (load) import Json.Encode as JE import Lib.Html exposing (..) -import Lib.Gen exposing (..) +import Lib.Gen as Gen import Lib.Api as Api import Lib.Ffi as Ffi import Lib.Editsum as Editsum -main : Program DocEdit Model Msg +main : Program Gen.DocEdit Model Msg main = Browser.element { init = \e -> (init e, Cmd.none) , view = view @@ -32,7 +32,7 @@ type alias Model = } -init : DocEdit -> Model +init : Gen.DocEdit -> Model init d = { state = Api.Normal , editsum = { authmod = True, editsum = d.editsum, locked = d.locked, hidden = d.hidden } @@ -43,7 +43,7 @@ init d = } -encode : Model -> DocEditSend +encode : Model -> Gen.DocEditSend encode model = { editsum = model.editsum.editsum , hidden = model.editsum.hidden @@ -73,10 +73,10 @@ update msg model = Submit -> let path = "/d" ++ String.fromInt model.id ++ "/edit" - body = doceditSendEncode (encode model) + body = Gen.doceditSendEncode (encode model) in ({ model | state = Api.Loading }, Api.post path body Submitted) - Submitted (Api.Changed id rev) -> (model, load <| "/d" ++ String.fromInt id ++ "." ++ String.fromInt rev) + Submitted (Gen.Changed id rev) -> (model, load <| "/d" ++ String.fromInt id ++ "." ++ String.fromInt rev) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) Preview -> @@ -84,7 +84,7 @@ update msg model = , Api.post "/js/markdown.json" (JE.object [("content", JE.string model.content)]) HandlePreview ) - HandlePreview (Api.Content s) -> ({ model | state = Api.Normal, preview = s }, Cmd.none) + HandlePreview (Gen.Content s) -> ({ model | state = Api.Normal, preview = s }, Cmd.none) HandlePreview r -> ({ model | state = Api.Error r }, Cmd.none) diff --git a/elm3/Lib/Api.elm b/elm3/Lib/Api.elm index 512038e8..c1e0ddcb 100644 --- a/elm3/Lib/Api.elm +++ b/elm3/Lib/Api.elm @@ -7,6 +7,8 @@ import Http import Html exposing (Attribute) import Html.Events exposing (on) +import Lib.Gen exposing (ApiResponse(..), decodeApiResponse) + -- Handy state enum for forms type State @@ -15,170 +17,13 @@ type State | Error Response -type alias VN = - { id : Int - , title : String - , original : String - , hidden : Bool - } - -decodeVN : JD.Decoder VN -decodeVN = JD.map4 - (\a b c d -> { id = a, title = b, original = c, hidden = d}) - (JD.field "id" JD.int) - (JD.field "title" JD.string) - (JD.field "original" JD.string) - (JD.field "hidden" JD.bool) - - -type alias Staff = - { id : Int - , aid : Int - , name : String - , original : String - } - -decodeStaff : JD.Decoder Staff -decodeStaff = JD.map4 - (\a b c d -> { id = a, aid = b, name = c, original = d }) - (JD.field "id" JD.int) - (JD.field "aid" JD.int) - (JD.field "name" JD.string) - (JD.field "original" JD.string) - - -type alias Producer = - { id : Int - , name : String - , original : String - , hidden : Bool - } - -decodeProducer : JD.Decoder Producer -decodeProducer = JD.map4 - (\a b c d -> { id = a, name = b, original = c, hidden = d }) - (JD.field "id" JD.int) - (JD.field "name" JD.string) - (JD.field "original" JD.string) - (JD.field "hidden" JD.bool) - - -type alias Char = - { id : Int - , name : String - , original : String - , main : Maybe - { id : Int - , name : String - } - } - -decodeChar : JD.Decoder Char -decodeChar = JD.map5 - (\a b c d e -> - { id = a, name = b, original = c - , main = case (d, e) of - (Just id, Just name) -> Just { id = id, name = name } - _ -> Nothing - }) - (JD.field "id" JD.int) - (JD.field "name" JD.string) - (JD.field "original" JD.string) - (JD.field "main" (JD.nullable JD.int )) - (JD.field "main_name" (JD.nullable JD.string)) - - -type alias Trait = - { id : Int - , name : String - , gid : Maybe Int - , group : Maybe String - } - -decodeTrait : JD.Decoder Trait -decodeTrait = JD.map4 - (\a b c d -> { id = a, name = b, gid = c, group = d }) - (JD.field "id" JD.int) - (JD.field "name" JD.string) - (JD.field "gid" (JD.nullable JD.int)) - (JD.field "group" (JD.nullable JD.string)) - - --- Same as Lib.Gen.CharEditVnrelsReleases -type alias Release = - { id : Int - , title : String - , lang : List String - } - -decodeRelease : JD.Decoder Release -decodeRelease = JD.map3 - (\a b c -> { id = a, title = b, lang = c }) - (JD.field "id" JD.int) - (JD.field "title" JD.string) - (JD.field "lang" (JD.list JD.string)) - - --- Possible server responses. This only includes "expected" responses. Much of --- the form validation is performed client side, so a constraint violation in --- the JSON structure or data fields is unexpected and is reported by the --- server as a 400 or 500 response. -type Response - = HTTPError Http.Error - | Success - | CSRF - | Throttled - | Invalid JE.Value -- JSON structure constraint violation, contains TUWF::Validate error for low-level error reporting - | Unauth - | BadEmail - | BadLogin - | BadPass - | Bot - | Taken - | DoubleEmail - | DoubleIP - | Unchanged - | Changed Int Int -- DB entry updated, entry ID and revision number - | VNResult (List VN) - | StaffResult (List Staff) - | ProducerResult (List Producer) - | CharResult (List Char) - | TraitResult (List Trait) - | ReleaseResult (List Release) - | ImgFormat - | Image Int Int Int -- Uploaded image (id, width, height) - | Content String -- Text content - -decodeResponse : JD.Decoder Response -decodeResponse = JD.oneOf - [ JD.field "Success" <| JD.succeed Success - , JD.field "Throttled" <| JD.succeed Throttled - , JD.field "CSRF" <| JD.succeed CSRF - , JD.field "Invalid" <| JD.map Invalid JD.value - , JD.field "Unauth" <| JD.succeed Unauth - , JD.field "BadEmail" <| JD.succeed BadEmail - , JD.field "BadLogin" <| JD.succeed BadLogin - , JD.field "BadPass" <| JD.succeed BadPass - , JD.field "Bot" <| JD.succeed Bot - , JD.field "Taken" <| JD.succeed Taken - , JD.field "DoubleEmail" <| JD.succeed DoubleEmail - , JD.field "DoubleIP" <| JD.succeed DoubleIP - , JD.field "Unchanged" <| JD.succeed Unchanged - , JD.field "Changed" <| JD.map2 Changed (JD.index 0 JD.int) (JD.index 1 JD.int) - , JD.field "VNResult" <| JD.map VNResult <| JD.list decodeVN - , JD.field "StaffResult" <| JD.map StaffResult <| JD.list decodeStaff - , JD.field "ProducerResult"<| JD.map ProducerResult <| JD.list decodeProducer - , JD.field "CharResult" <| JD.map CharResult <| JD.list decodeChar - , JD.field "TraitResult" <| JD.map TraitResult <| JD.list decodeTrait - , JD.field "ReleaseResult" <| JD.map ReleaseResult <| JD.list decodeRelease - , JD.field "ImgFormat" <| JD.succeed ImgFormat - , JD.field "Image" <| JD.map3 Image (JD.index 0 JD.int) (JD.index 1 JD.int) (JD.index 2 JD.int) - , JD.field "Content" <| JD.map Content JD.string - ] +type alias Response = ApiResponse --- User-friendly error message if the response isn't what the code expected +-- 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 ElmGen.pm, but that wouldn't really have all that much value). showResponse : Response -> String showResponse res = let unexp = "Unexpected response, please report a bug." @@ -219,7 +64,7 @@ expectResponse msg = res r = msg <| case r of Err e -> HTTPError e Ok v -> v - in Http.expectJson res decodeResponse + in Http.expectJson res decodeApiResponse -- Send a POST request with a JSON body to the VNDB API and get a Response back. diff --git a/elm3/Lib/Autocomplete.elm b/elm3/Lib/Autocomplete.elm index a6935057..facbb8d2 100644 --- a/elm3/Lib/Autocomplete.elm +++ b/elm3/Lib/Autocomplete.elm @@ -25,6 +25,7 @@ import Process import Browser.Dom as Dom import Lib.Html exposing (..) import Lib.Api as Api +import Lib.Gen as Gen type alias Config m a = @@ -53,11 +54,11 @@ type alias SourceConfig m a = -staffSource : SourceConfig m Api.Staff +staffSource : SourceConfig m Gen.ApiStaffResult staffSource = { path = "/js/staff.json" , decode = \x -> case x of - Api.StaffResult e -> Just e + Gen.StaffResult e -> Just e _ -> Nothing , view = (\i -> [ div [ class "row row-compact" ] [ div [ class "col single-line muted" ] [ text <| "s" ++ String.fromInt i.id ] @@ -68,11 +69,11 @@ staffSource = } -vnSource : SourceConfig m Api.VN +vnSource : SourceConfig m Gen.ApiVNResult vnSource = { path = "/js/vn.json" , decode = \x -> case x of - Api.VNResult e -> Just e + Gen.VNResult e -> Just e _ -> Nothing , view = (\i -> [ div [ class "row row-compact" ] [ div [ class "col single-line muted" ] [ text <| "v" ++ String.fromInt i.id ] @@ -82,11 +83,11 @@ vnSource = } -producerSource : SourceConfig m Api.Producer +producerSource : SourceConfig m Gen.ApiProducerResult producerSource = { path = "/js/producer.json" , decode = \x -> case x of - Api.ProducerResult e -> Just e + Gen.ProducerResult e -> Just e _ -> Nothing , view = (\i -> [ div [ class "row row-compact" ] [ div [ class "col single-line muted" ] [ text <| "p" ++ String.fromInt i.id ] @@ -96,11 +97,11 @@ producerSource = } -charSource : SourceConfig m Api.Char +charSource : SourceConfig m Gen.ApiCharResult charSource = { path = "/js/char.json" , decode = \x -> case x of - Api.CharResult e -> Just e + Gen.CharResult e -> Just e _ -> Nothing , view = (\i -> [ div [ class "row row-compact" ] [ div [ class "col single-line muted" ] [ text <| "c" ++ String.fromInt i.id ] @@ -111,11 +112,11 @@ charSource = } -traitSource : SourceConfig m Api.Trait +traitSource : SourceConfig m Gen.ApiTraitResult traitSource = { path = "/js/trait.json" , decode = \x -> case x of - Api.TraitResult e -> Just e + Gen.TraitResult e -> Just e _ -> Nothing , view = (\i -> [ div [ class "row row-compact" ] [ div [ class "col single-line muted" ] [ text <| "i" ++ String.fromInt i.id ] diff --git a/elm3/ProdEdit/Main.elm b/elm3/ProdEdit/Main.elm index 6d77ba7a..06328f53 100644 --- a/elm3/ProdEdit/Main.elm +++ b/elm3/ProdEdit/Main.elm @@ -7,15 +7,15 @@ import Browser import Browser.Navigation exposing (load) import Lib.Util exposing (splitLn) import Lib.Html exposing (..) -import Lib.Gen exposing (..) +import Lib.Gen as Gen import Lib.Api as Api import Lib.Editsum as Editsum import ProdEdit.Names as Names -import ProdEdit.General as Gen +import ProdEdit.General as General import ProdEdit.Relations as Rel -main : Program ProdEdit Model Msg +main : Program Gen.ProdEdit Model Msg main = Browser.element { init = \e -> (init e, Cmd.none) , view = view @@ -29,20 +29,20 @@ type alias Model = , new : Bool , editsum : Editsum.Model , names : Names.Model - , general : Gen.Model + , general : General.Model , relations : Rel.Model , id : Maybe Int - , dupProds : List Api.Producer + , dupProds : List Gen.ApiProducerResult } -init : ProdEdit -> Model +init : Gen.ProdEdit -> Model init d = { state = Api.Normal , new = False , editsum = { authmod = d.authmod, editsum = d.editsum, locked = d.locked, hidden = d.hidden } , names = Names.init d - , general = Gen.init d + , general = General.init d , relations = Rel.init d.relations , id = d.id , dupProds = [] @@ -55,14 +55,14 @@ new = , new = True , editsum = Editsum.new , names = Names.new - , general = Gen.new + , general = General.new , relations = Rel.init [] , id = Nothing , dupProds = [] } -encode : Model -> ProdEditSend +encode : Model -> Gen.ProdEditSend encode model = { editsum = model.editsum.editsum , hidden = model.editsum.hidden @@ -84,7 +84,7 @@ type Msg | Submit | Submitted Api.Response | Names Names.Msg - | General Gen.Msg + | General General.Msg | Relations Rel.Msg | CheckDup | RecvDup Api.Response @@ -94,7 +94,7 @@ update : Msg -> Model -> (Model, Cmd Msg) update msg model = case msg of Names m -> ({ model | names = Names.update m model.names, dupProds = [] }, Cmd.none) - General m -> ({ model | general = Gen.update m model.general }, Cmd.none) + General m -> ({ model | general = General.update m model.general }, Cmd.none) Editsum m -> ({ model | editsum = Editsum.update m model.editsum }, Cmd.none) Relations m -> let (nm, c) = Rel.update m model.relations in ({ model | relations = nm }, Cmd.map Relations c) @@ -104,10 +104,10 @@ update msg model = case model.id of Just id -> "/p" ++ String.fromInt id ++ "/edit" Nothing -> "/p/add" - body = prodeditSendEncode (encode model) + body = Gen.prodeditSendEncode (encode model) in ({ model | state = Api.Loading }, Api.post path body Submitted) - Submitted (Api.Changed id rev) -> (model, load <| "/p" ++ String.fromInt id ++ "." ++ String.fromInt rev) + Submitted (Gen.Changed id rev) -> (model, load <| "/p" ++ String.fromInt id ++ "." ++ String.fromInt rev) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) CheckDup -> @@ -119,7 +119,7 @@ update msg model = then ({ model | state = Api.Loading }, Api.post "/js/producer.json" body RecvDup) else ({ model | new = False }, Cmd.none) - RecvDup (Api.ProducerResult dup) -> + RecvDup (Gen.ProducerResult dup) -> ({ model | state = Api.Normal, dupProds = dup, new = not (List.isEmpty dup) }, Cmd.none) RecvDup r -> ({ model | state = Api.Error r }, Cmd.none) @@ -151,7 +151,7 @@ view model = ] else form_ Submit (model.state == Api.Loading) - [ Gen.view model.general General <| List.map (Html.map Names) <| Names.view model.names + [ General.view model.general General <| List.map (Html.map Names) <| Names.view model.names , Html.map Relations <| Rel.view model.relations , Html.map Editsum <| Editsum.view model.editsum , submitButton "Submit" model.state (isValid model) False diff --git a/elm3/ProdEdit/Relations.elm b/elm3/ProdEdit/Relations.elm index a74339f1..b1887684 100644 --- a/elm3/ProdEdit/Relations.elm +++ b/elm3/ProdEdit/Relations.elm @@ -4,20 +4,19 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import Lib.Html exposing (..) -import Lib.Gen exposing (ProdEditRelations, producerRelations) -import Lib.Api exposing (Producer) +import Lib.Gen as Gen import Lib.Util exposing (..) import Lib.Autocomplete as A type alias Model = - { relations : List ProdEditRelations - , search : A.Model Producer + { relations : List Gen.ProdEditRelations + , search : A.Model Gen.ApiProducerResult , duplicates : Bool } -init : List ProdEditRelations -> Model +init : List Gen.ProdEditRelations -> Model init l = { relations = l , search = A.init @@ -28,10 +27,10 @@ init l = type Msg = Del Int | Rel Int String - | Search (A.Msg Producer) + | Search (A.Msg Gen.ApiProducerResult) -searchConfig : A.Config Msg Producer +searchConfig : A.Config Msg Gen.ApiProducerResult searchConfig = { wrap = Search, id = "add-relation", source = A.producerSource } @@ -50,7 +49,7 @@ update msg model = Nothing -> ({ model | search = nm }, c) Just r -> let - rel = List.head producerRelations |> Maybe.map Tuple.first |> Maybe.withDefault "" + rel = List.head Gen.producerRelations |> Maybe.map Tuple.first |> Maybe.withDefault "" nrow = { pid = r.id, relation = rel, name = r.name } in (validate { model | search = A.clear nm, relations = model.relations ++ [nrow] }, c) @@ -62,7 +61,7 @@ view model = [ editListField 1 "single-line" [ a [href <| "/p" ++ String.fromInt e.pid, title e.name, target "_blank" ] [text e.name ] ] , editListField 1 "" - [ inputSelect [onInput (Rel n)] e.relation producerRelations ] + [ inputSelect [onInput (Rel n)] e.relation Gen.producerRelations ] , editListField 0 "" [ removeButton (Del n) ] ] diff --git a/elm3/RelEdit/Main.elm b/elm3/RelEdit/Main.elm index 6afa2719..16e317f0 100644 --- a/elm3/RelEdit/Main.elm +++ b/elm3/RelEdit/Main.elm @@ -4,7 +4,7 @@ import Html exposing (..) import Browser import Browser.Navigation exposing (load) import Lib.Html exposing (..) -import Lib.Gen exposing (..) +import Lib.Gen as Gen import Lib.Api as Api import Lib.Editsum as Editsum import RelEdit.General as General @@ -12,7 +12,7 @@ import RelEdit.Producers as Producers import RelEdit.Vn as Vn -main : Program RelEdit Model Msg +main : Program Gen.RelEdit Model Msg main = Browser.element { init = \e -> (init e, Cmd.none) , view = view @@ -31,7 +31,7 @@ type alias Model = } -init : RelEdit -> Model +init : Gen.RelEdit -> Model init d = { state = Api.Normal , editsum = { authmod = d.authmod, editsum = d.editsum, locked = d.locked, hidden = d.hidden } @@ -53,7 +53,7 @@ new vid title orig = } -encode : Model -> RelEditSend +encode : Model -> Gen.RelEditSend encode model = { editsum = model.editsum.editsum , hidden = model.editsum.hidden @@ -106,10 +106,10 @@ update msg model = case model.id of Just id -> "/r" ++ String.fromInt id ++ "/edit" Nothing -> "/r/add" - body = releditSendEncode (encode model) + body = Gen.releditSendEncode (encode model) in ({ model | state = Api.Loading }, Api.post path body Submitted) - Submitted (Api.Changed id rev) -> (model, load <| "/r" ++ String.fromInt id ++ "." ++ String.fromInt rev) + Submitted (Gen.Changed id rev) -> (model, load <| "/r" ++ String.fromInt id ++ "." ++ String.fromInt rev) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) diff --git a/elm3/RelEdit/Producers.elm b/elm3/RelEdit/Producers.elm index e546e223..1af1f2ba 100644 --- a/elm3/RelEdit/Producers.elm +++ b/elm3/RelEdit/Producers.elm @@ -5,19 +5,18 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import Lib.Html exposing (..) import Lib.Autocomplete as A -import Lib.Gen exposing (RelEditProducers) +import Lib.Gen as Gen import Lib.Util exposing (..) -import Lib.Api exposing (Producer) type alias Model = - { producers : List RelEditProducers - , search : A.Model Producer + { producers : List Gen.RelEditProducers + , search : A.Model Gen.ApiProducerResult , duplicates : Bool } -init : List RelEditProducers -> Model +init : List Gen.RelEditProducers -> Model init l = { producers = l , search = A.init @@ -28,10 +27,10 @@ init l = type Msg = Del Int | SetRole Int String - | Search (A.Msg Producer) + | Search (A.Msg Gen.ApiProducerResult) -searchConfig : A.Config Msg Producer +searchConfig : A.Config Msg Gen.ApiProducerResult searchConfig = { wrap = Search, id = "add-producer", source = A.producerSource } diff --git a/elm3/RelEdit/Vn.elm b/elm3/RelEdit/Vn.elm index 35afb932..9f32aff4 100644 --- a/elm3/RelEdit/Vn.elm +++ b/elm3/RelEdit/Vn.elm @@ -3,20 +3,19 @@ module RelEdit.Vn exposing (Model, Msg, init, update, view) import Html exposing (..) import Html.Attributes exposing (..) import Lib.Html exposing (..) -import Lib.Gen exposing (RelEditVn) +import Lib.Gen as Gen import Lib.Util exposing (..) import Lib.Autocomplete as A -import Lib.Api exposing (VN) type alias Model = - { vn : List RelEditVn - , search : A.Model VN + { vn : List Gen.RelEditVn + , search : A.Model Gen.ApiVNResult , duplicates : Bool } -init : List RelEditVn -> Model +init : List Gen.RelEditVn -> Model init l = { vn = l , search = A.init @@ -26,10 +25,10 @@ init l = type Msg = Del Int - | Search (A.Msg VN) + | Search (A.Msg Gen.ApiVNResult) -searchConfig : A.Config Msg VN +searchConfig : A.Config Msg Gen.ApiVNResult searchConfig = { wrap = Search, id = "add-vn", source = A.vnSource } diff --git a/elm3/StaffEdit/Main.elm b/elm3/StaffEdit/Main.elm index a0bad42f..96d90343 100644 --- a/elm3/StaffEdit/Main.elm +++ b/elm3/StaffEdit/Main.elm @@ -8,12 +8,12 @@ import Browser import Browser.Navigation exposing (load) import Lib.Util exposing (..) import Lib.Html exposing (..) -import Lib.Gen exposing (..) +import Lib.Gen as Gen import Lib.Api as Api import Lib.Editsum as Editsum -main : Program StaffEdit Model Msg +main : Program Gen.StaffEdit Model Msg main = Browser.element { init = \e -> (init e, Cmd.none) , view = view @@ -25,7 +25,7 @@ main = Browser.element type alias Model = { state : Api.State , editsum : Editsum.Model - , alias : List StaffEditAlias + , alias : List Gen.StaffEditAlias , aliasDup : Bool , aid : Int , desc : String @@ -39,7 +39,7 @@ type alias Model = } -init : StaffEdit -> Model +init : Gen.StaffEdit -> Model init d = { state = Api.Normal , editsum = { authmod = d.authmod, editsum = d.editsum, locked = d.locked, hidden = d.hidden } @@ -75,7 +75,7 @@ new = } -encode : Model -> StaffEditSend +encode : Model -> Gen.StaffEditSend encode model = { editsum = model.editsum.editsum , hidden = model.editsum.hidden @@ -142,10 +142,10 @@ update msg model = case model.id of Just id -> "/s" ++ String.fromInt id ++ "/edit" Nothing -> "/s/add" - body = staffeditSendEncode (encode model) + body = Gen.staffeditSendEncode (encode model) in ({ model | state = Api.Loading }, Api.post path body Submitted) - Submitted (Api.Changed id rev) -> (model, load <| "/s" ++ String.fromInt id ++ "." ++ String.fromInt rev) + Submitted (Gen.Changed id rev) -> (model, load <| "/s" ++ String.fromInt id ++ "." ++ String.fromInt rev) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) @@ -190,10 +190,10 @@ view model = meta = cardRow "Meta" Nothing <| formGroups [ [ label [for "lang"] [ text "Primary language" ] - , inputSelect [id "lang", name "lang", onInput Lang] model.lang languages + , inputSelect [id "lang", name "lang", onInput Lang] model.lang Gen.languages ] , [ label [for "website"] [ text "Official Website" ] - , inputText "website" model.l_site Website [pattern weburlPattern] + , inputText "website" model.l_site Website [pattern Gen.weburlPattern] ] , [ label [] [ text "Wikipedia" ] , p [] [ text "https://en.wikipedia.org/wiki/", inputText "l_wp" model.l_wp LWP [class "form-control--inline", maxlength 100] ] diff --git a/elm3/UVNList/Status.elm b/elm3/UVNList/Status.elm index e11443df..7a2782d2 100644 --- a/elm3/UVNList/Status.elm +++ b/elm3/UVNList/Status.elm @@ -8,7 +8,7 @@ import Browser import Lib.Api as Api import Lib.Html exposing (..) import Lib.Util exposing (lookup) -import Lib.Gen exposing (vnlistStatus) +import Lib.Gen as Gen main : Program Flags Model Msg @@ -59,7 +59,7 @@ update msg model = in ( nmodel , Api.post "/u/setvnstatus" (encodeForm nmodel) Saved ) - Saved Api.Success -> ({ model | state = Api.Normal }, Cmd.none) + Saved Gen.Success -> ({ model | state = Api.Normal }, Cmd.none) Saved e -> ({ model | state = Api.Error e }, Cmd.none) @@ -69,9 +69,9 @@ view model = if model.state == Api.Loading then div [ class "spinner spinner--md" ] [] else div [] - [ text <| Maybe.withDefault "" <| lookup model.flags.status vnlistStatus + [ text <| Maybe.withDefault "" <| lookup model.flags.status Gen.vnlistStatus , inputSelect [ class "form-control--table-edit form-control--table-edit-overlay", onInput Input ] (String.fromInt model.flags.status) - (List.map (\(a,b) -> (String.fromInt a, b)) vnlistStatus) + (List.map (\(a,b) -> (String.fromInt a, b)) Gen.vnlistStatus) ] diff --git a/elm3/UVNList/Vote.elm b/elm3/UVNList/Vote.elm index 2e29aeb2..2834e25e 100644 --- a/elm3/UVNList/Vote.elm +++ b/elm3/UVNList/Vote.elm @@ -14,7 +14,7 @@ import Json.Encode as JE import Browser import Regex import Lib.Api as Api -import Lib.Gen exposing (vnvotePattern) +import Lib.Gen as Gen main : Program Flags Model Msg @@ -65,7 +65,7 @@ update msg model = case msg of Input s -> ( { model | text = s - , valid = Regex.contains (Maybe.withDefault Regex.never <| Regex.fromString vnvotePattern) s + , valid = Regex.contains (Maybe.withDefault Regex.never <| Regex.fromString Gen.vnvotePattern) s } , Cmd.none ) @@ -76,7 +76,7 @@ update msg model = , Api.post "/u/setvote" (encodeForm model) Saved ) else (model, Cmd.none) - Saved Api.Success -> + Saved Gen.Success -> let flags = model.flags nflags = { flags | vote = model.text } in ({ model | flags = nflags, state = Api.Normal }, Cmd.none) @@ -94,7 +94,7 @@ view model = else input [ type_ "text" - , pattern vnvotePattern + , pattern Gen.vnvotePattern , class "form-control form-control--table-edit form-control--stealth" , classList [("is-invalid", not model.valid)] , value model.text diff --git a/elm3/User/Login.elm b/elm3/User/Login.elm index abfe44ec..09aa0aa7 100644 --- a/elm3/User/Login.elm +++ b/elm3/User/Login.elm @@ -7,6 +7,7 @@ import Json.Encode as JE import Browser import Browser.Navigation exposing (load) import Lib.Api as Api +import Lib.Gen as Gen import Lib.Html exposing (..) @@ -49,7 +50,7 @@ update msg model = , Api.post "/u/login" (encodeForm model) Submitted ) - Submitted Api.Success -> (model, load "/") + Submitted Gen.Success -> (model, load "/") Submitted e -> ({ model | state = Api.Error e }, Cmd.none) diff --git a/elm3/User/PassReset.elm b/elm3/User/PassReset.elm index aa649c24..9d6130fa 100644 --- a/elm3/User/PassReset.elm +++ b/elm3/User/PassReset.elm @@ -6,6 +6,7 @@ import Html.Events exposing (..) import Browser import Json.Encode as JE import Lib.Api as Api +import Lib.Gen as Gen import Lib.Html exposing (..) @@ -45,7 +46,7 @@ update msg model = , Api.post "/u/newpass" (encodeForm model) Submitted ) - Submitted Api.Success -> ({ model | success = True }, Cmd.none) + Submitted Gen.Success -> ({ model | success = True }, Cmd.none) Submitted e -> ({ model | state = Api.Error e }, Cmd.none) diff --git a/elm3/User/PassSet.elm b/elm3/User/PassSet.elm index 13b45de1..b85f715a 100644 --- a/elm3/User/PassSet.elm +++ b/elm3/User/PassSet.elm @@ -7,6 +7,7 @@ import Json.Encode as JE import Browser import Browser.Navigation exposing (load) import Lib.Api as Api +import Lib.Gen as Gen import Lib.Html exposing (..) @@ -59,7 +60,7 @@ update msg model = else ( { model | state = Api.Loading } , Api.post model.url (encodeForm model) Submitted) - Submitted Api.Success -> (model, load "/") + Submitted Gen.Success -> (model, load "/") Submitted e -> ({ model | state = Api.Error e }, Cmd.none) diff --git a/elm3/User/Register.elm b/elm3/User/Register.elm index 4a956a38..e214cef1 100644 --- a/elm3/User/Register.elm +++ b/elm3/User/Register.elm @@ -5,7 +5,7 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import Browser import Json.Encode as JE -import Lib.Gen exposing (emailPattern) +import Lib.Gen as Gen import Lib.Api as Api import Lib.Html exposing (..) @@ -52,7 +52,7 @@ update msg model = Submit -> ( { model | state = Api.Loading } , Api.post "/u/register" (encodeForm model) Submitted) - Submitted Api.Success -> ({ model | state = Api.Normal, success = True }, Cmd.none) + Submitted Gen.Success -> ({ model | state = Api.Normal, success = True }, Cmd.none) Submitted e -> ({ model | state = Api.Error e}, Cmd.none) @@ -82,7 +82,7 @@ view model = form_ Submit (model.state == Api.Loading) ] , div [ class "form-group" ] [ label [ for "email" ] [ text "Email" ] - , inputText "email" model.email EMail [required True, type_ "email", pattern emailPattern] + , inputText "email" model.email EMail [required True, type_ "email", pattern Gen.emailPattern] , div [ class "form-group__help" ] [ text "Your email address will only be used in case you lose your password. We will never send spam or newsletters unless you explicitly ask us for it or we get hacked." ] ] diff --git a/elm3/User/Settings.elm b/elm3/User/Settings.elm index 538225ca..2e43e8ed 100644 --- a/elm3/User/Settings.elm +++ b/elm3/User/Settings.elm @@ -7,11 +7,11 @@ import Html.Events exposing (..) import Browser import Browser.Navigation exposing (reload) import Lib.Html exposing (..) -import Lib.Gen exposing (..) +import Lib.Gen as Gen import Lib.Api as Api -main : Program UserEdit Model Msg +main : Program Gen.UserEdit Model Msg main = Browser.element { init = init , view = view @@ -23,7 +23,7 @@ main = Browser.element type alias Model = { state : Api.State , saved : Bool - , data : UserEdit + , data : Gen.UserEdit , cpass : Bool , pass1 : String , pass2 : String @@ -32,7 +32,7 @@ type alias Model = } -init : UserEdit -> (Model, Cmd Msg) +init : Gen.UserEdit -> (Model, Cmd Msg) init d = ({state = Api.Normal , saved = False @@ -45,7 +45,7 @@ init d = }, Cmd.none) -encode : Model -> UserEditSend +encode : Model -> Gen.UserEditSend encode model = { hide_list = model.data.hide_list , ign_votes = model.data.ign_votes @@ -87,7 +87,7 @@ type Msg | Pass2 String -updateField : UpdateMsg -> UserEdit -> UserEdit +updateField : UpdateMsg -> Gen.UserEdit -> Gen.UserEdit updateField msg model = case msg of Username s -> { model | username = s } @@ -116,10 +116,10 @@ update msg model = Submit -> let path = "/u" ++ String.fromInt model.data.id ++ "/edit" - body = usereditSendEncode (encode model) + body = Gen.usereditSendEncode (encode model) in ({ model | state = Api.Loading }, Api.post path body Submitted) - Submitted (Api.Success) -> + Submitted (Gen.Success) -> ( { model | state = Api.Normal, saved = True, cpass = False, opass = "", pass1 = "", pass2 = "" } , if model.cpass then reload else Cmd.none ) @@ -136,7 +136,7 @@ view model = , inputText "username" model.data.username (Set << Username) [required True, maxlength 200, pattern "[a-z0-9-]{2,15}", disabled (not model.data.authmod)] ] , [ label [ for "email" ] [ text "Email address" ] - , inputText "email" model.data.mail (Set << Email) [type_ "email", required True, pattern emailPattern] + , inputText "email" model.data.mail (Set << Email) [type_ "email", required True, pattern Gen.emailPattern] ] ] @@ -166,7 +166,7 @@ view model = [ [ label [] [ text "Permissions" ] ] ++ List.map (\(n,s) -> label [ class "checkbox" ] [ inputCheck "" (and model.data.perm n > 0) (Set << Perm n), text (" " ++ s) ] - ) userPerms + ) Gen.userPerms , [ label [] [ text "Other" ] , label [ class "checkbox" ] [ inputCheck "" model.data.ign_votes (Set << IgnVotes), text "Ignore votes in VN statistics" ] ] diff --git a/elm3/VNEdit/General.elm b/elm3/VNEdit/General.elm index f98bf5c2..4a0ebaa2 100644 --- a/elm3/VNEdit/General.elm +++ b/elm3/VNEdit/General.elm @@ -6,7 +6,7 @@ import Html.Events exposing (..) import File exposing (File) import Json.Decode as JD import Lib.Html exposing (..) -import Lib.Gen exposing (..) +import Lib.Gen as Gen import Lib.Util exposing (..) import Lib.Api as Api @@ -25,7 +25,7 @@ type alias Model = } -init : VNEdit -> Model +init : Gen.VNEdit -> Model init d = { desc = d.desc , image = d.image @@ -84,7 +84,7 @@ update msg model = ImgUpload [i] -> ({ model | imgState = Api.Loading }, Api.postImage Api.Cv i ImgDone) ImgUpload _ -> (model, Cmd.none) - ImgDone (Api.Image id _ _) -> ({ model | image = id, imgState = Api.Normal }, Cmd.none) + ImgDone (Gen.Image id _ _) -> ({ model | image = id, imgState = Api.Normal }, Cmd.none) ImgDone r -> ({ model | image = 0, imgState = Api.Error r }, Cmd.none) @@ -133,7 +133,7 @@ view model wrap titles = card "general" "General info" [] <| [ [ label [for "length"] [ text "Length" ] , inputSelect [id "length", name "length", onInput Length] (String.fromInt model.length) - (List.map (\(a,b) -> (String.fromInt a, b)) vnLengths) + (List.map (\(a,b) -> (String.fromInt a, b)) Gen.vnLengths) ] , [ label [] [ text "External links" ] , p [] [ text "http://en.wikipedia.org/wiki/", inputText "l_wp" model.l_wp LWP [class "form-control--inline", maxlength 100] ] diff --git a/elm3/VNEdit/Main.elm b/elm3/VNEdit/Main.elm index bee56211..f613e62e 100644 --- a/elm3/VNEdit/Main.elm +++ b/elm3/VNEdit/Main.elm @@ -7,18 +7,18 @@ import Json.Encode as JE import Browser import Browser.Navigation exposing (load) import Lib.Html exposing (..) -import Lib.Gen exposing (..) +import Lib.Gen as Gen import Lib.Api as Api import Lib.Editsum as Editsum import VNEdit.Titles as Titles -import VNEdit.General as Gen +import VNEdit.General as General import VNEdit.Seiyuu as Seiyuu import VNEdit.Staff as Staff import VNEdit.Screenshots as Scr import VNEdit.Relations as Rel -main : Program VNEdit Model Msg +main : Program Gen.VNEdit Model Msg main = Browser.element { init = \e -> (init e, Cmd.none) , view = view @@ -33,24 +33,24 @@ type alias Model = , editsum : Editsum.Model , l_encubed : String , titles : Titles.Model - , general : Gen.Model + , general : General.Model , staff : Staff.Model , seiyuu : Seiyuu.Model , relations : Rel.Model , screenshots : Scr.Model , id : Maybe Int - , dupVNs : List Api.VN + , dupVNs : List Gen.ApiVNResult } -init : VNEdit -> Model +init : Gen.VNEdit -> Model init d = { state = Api.Normal , new = False , editsum = { authmod = d.authmod, editsum = d.editsum, locked = d.locked, hidden = d.hidden } , l_encubed = d.l_encubed , titles = Titles.init d - , general = Gen.init d + , general = General.init d , staff = Staff.init d.staff , seiyuu = Seiyuu.init d.seiyuu d.chars , relations = Rel.init d.relations @@ -67,7 +67,7 @@ new = , editsum = Editsum.new , l_encubed = "" , titles = Titles.new - , general = Gen.new + , general = General.new , staff = Staff.init [] , seiyuu = Seiyuu.init [] [] , relations = Rel.init [] @@ -77,7 +77,7 @@ new = } -encode : Model -> VNEditSend +encode : Model -> Gen.VNEditSend encode model = { editsum = model.editsum.editsum , hidden = model.editsum.hidden @@ -105,7 +105,7 @@ type Msg | Submit | Submitted Api.Response | Titles Titles.Msg - | General Gen.Msg + | General General.Msg | Staff Staff.Msg | Seiyuu Seiyuu.Msg | Relations Rel.Msg @@ -126,17 +126,17 @@ update msg model = case model.id of Just id -> "/v" ++ String.fromInt id ++ "/edit" Nothing -> "/v/add" - body = vneditSendEncode (encode model) + body = Gen.vneditSendEncode (encode model) in ({ model | state = Api.Loading }, Api.post path body Submitted) - Submitted (Api.Changed id rev) -> (model, load <| "/v" ++ String.fromInt id ++ "." ++ String.fromInt rev) + Submitted (Gen.Changed id rev) -> (model, load <| "/v" ++ String.fromInt id ++ "." ++ String.fromInt rev) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) - General m -> let (nm, c) = Gen.update m model.general in ({ model | general = nm }, Cmd.map General c) - Staff m -> let (nm, c) = Staff.update m model.staff in ({ model | staff = nm }, Cmd.map Staff c) - Seiyuu m -> let (nm, c) = Seiyuu.update m model.seiyuu in ({ model | seiyuu = nm }, Cmd.map Seiyuu c) - Screenshots m -> let (nm, c) = Scr.update m model.screenshots in ({ model | screenshots = nm }, Cmd.map Screenshots c) - Relations m -> let (nm, c) = Rel.update m model.relations in ({ model | relations = nm }, Cmd.map Relations c) + General m -> let (nm, c) = General.update m model.general in ({ model | general = nm }, Cmd.map General c) + Staff m -> let (nm, c) = Staff.update m model.staff in ({ model | staff = nm }, Cmd.map Staff c) + Seiyuu m -> let (nm, c) = Seiyuu.update m model.seiyuu in ({ model | seiyuu = nm }, Cmd.map Seiyuu c) + Screenshots m -> let (nm, c) = Scr.update m model.screenshots in ({ model | screenshots = nm }, Cmd.map Screenshots c) + Relations m -> let (nm, c) = Rel.update m model.relations in ({ model | relations = nm }, Cmd.map Relations c) CheckDup -> let body = JE.object @@ -147,7 +147,7 @@ update msg model = then ({ model | state = Api.Loading }, Api.post "/js/vn.json" body RecvDup) else ({ model | new = False }, Cmd.none) - RecvDup (Api.VNResult dup) -> + RecvDup (Gen.VNResult dup) -> ({ model | state = Api.Normal, dupVNs = dup, new = not (List.isEmpty dup) }, Cmd.none) RecvDup r -> ({ model | state = Api.Error r }, Cmd.none) @@ -189,7 +189,7 @@ view model = ] else form_ Submit (model.state == Api.Loading) - [ Gen.view model.general General <| List.map (Html.map Titles) <| Titles.view model.titles + [ General.view model.general General <| List.map (Html.map Titles) <| Titles.view model.titles , Html.map Staff <| lazy Staff.view model.staff , Html.map Seiyuu <| lazy2 Seiyuu.view model.seiyuu model.id , Html.map Relations <| lazy Rel.view model.relations diff --git a/elm3/VNEdit/Relations.elm b/elm3/VNEdit/Relations.elm index 673e4ba1..c9f82ec6 100644 --- a/elm3/VNEdit/Relations.elm +++ b/elm3/VNEdit/Relations.elm @@ -4,20 +4,19 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import Lib.Html exposing (..) -import Lib.Gen exposing (VNEditRelations, vnRelations) -import Lib.Api exposing (VN) +import Lib.Gen as Gen import Lib.Util exposing (..) import Lib.Autocomplete as A type alias Model = - { relations : List VNEditRelations - , search : A.Model VN + { relations : List Gen.VNEditRelations + , search : A.Model Gen.ApiVNResult , duplicates : Bool } -init : List VNEditRelations -> Model +init : List Gen.VNEditRelations -> Model init l = { relations = l , search = A.init @@ -29,10 +28,10 @@ type Msg = Del Int | Official Int Bool | Rel Int String - | Search (A.Msg VN) + | Search (A.Msg Gen.ApiVNResult) -searchConfig : A.Config Msg VN +searchConfig : A.Config Msg Gen.ApiVNResult searchConfig = { wrap = Search, id = "add-relation", source = A.vnSource } @@ -52,7 +51,7 @@ update msg model = Nothing -> ({ model | search = nm }, c) Just r -> let - rel = List.head vnRelations |> Maybe.map Tuple.first |> Maybe.withDefault "" + rel = List.head Gen.vnRelations |> Maybe.map Tuple.first |> Maybe.withDefault "" nrow = { vid = r.id, relation = rel, title = r.title, official = True } in (validate { model | search = A.clear nm, relations = model.relations ++ [nrow] }, c) @@ -71,7 +70,7 @@ view model = ] ] , editListField 1 "" - [ inputSelect [onInput (Rel n)] e.relation vnRelations ] + [ inputSelect [onInput (Rel n)] e.relation Gen.vnRelations ] , editListField 0 "single-line" [ text " of this VN" ] , editListField 0 "" [ removeButton (Del n) ] ] diff --git a/elm3/VNEdit/Screenshots.elm b/elm3/VNEdit/Screenshots.elm index 7505fc15..f0888c8e 100644 --- a/elm3/VNEdit/Screenshots.elm +++ b/elm3/VNEdit/Screenshots.elm @@ -7,13 +7,13 @@ import File exposing (File) import Lib.Html exposing (..) import Lib.Util exposing (..) import Lib.Api as Api -import Lib.Gen exposing (resolutions, VNEditScreenshots, VNEditReleases) +import Lib.Gen as Gen import Lib.Util exposing (lookup, isJust) type alias Model = - { screenshots : List VNEditScreenshots - , releases : List VNEditReleases + { screenshots : List Gen.VNEditScreenshots + , releases : List Gen.VNEditReleases , state : List Api.State , id : Int -- Temporary negative internal screenshot identifier, until the image has been uploaded and the actual ID is known , rel : Int @@ -22,7 +22,7 @@ type alias Model = } -init : List VNEditScreenshots -> List VNEditReleases -> Model +init : List Gen.VNEditScreenshots -> List Gen.VNEditReleases -> Model init scr rels = { screenshots = scr , releases = rels @@ -76,10 +76,10 @@ update msg model = Just (n,_) -> let st _ = case r of - Api.Image _ _ _ -> Api.Normal + Gen.Image _ _ _ -> Api.Normal re -> Api.Error re scr s = case r of - Api.Image nid width height -> { s | scr = nid, width = width, height = height } + Gen.Image nid width height -> { s | scr = nid, width = width, height = height } _ -> s in ({ model | screenshots = modidx n scr model.screenshots, state = modidx n st model.state }, Cmd.none) @@ -102,7 +102,7 @@ view model vid = commonRes res = -- NDS resolution, not in the database - res == "256x384" || isJust (lookup res resolutions) + res == "256x384" || isJust (lookup res Gen.resolutions) resWarn e = let res = String.fromInt e.width ++ "x" ++ String.fromInt e.height diff --git a/elm3/VNEdit/Seiyuu.elm b/elm3/VNEdit/Seiyuu.elm index 2f1a0457..3473bb7b 100644 --- a/elm3/VNEdit/Seiyuu.elm +++ b/elm3/VNEdit/Seiyuu.elm @@ -5,20 +5,19 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import Lib.Util exposing (..) import Lib.Html exposing (..) -import Lib.Gen exposing (VNEditSeiyuu, VNEditChars) +import Lib.Gen as Gen import Lib.Autocomplete as A -import Lib.Api exposing (Staff) type alias Model = - { chars : List VNEditChars - , seiyuu : List VNEditSeiyuu - , search : A.Model Staff + { chars : List Gen.VNEditChars + , seiyuu : List Gen.VNEditSeiyuu + , search : A.Model Gen.ApiStaffResult , duplicates : Bool } -init : List VNEditSeiyuu -> List VNEditChars -> Model +init : List Gen.VNEditSeiyuu -> List Gen.VNEditChars -> Model init s c = { chars = c , seiyuu = s @@ -31,10 +30,10 @@ type Msg = Del Int | SetNote Int String | SetChar Int String - | Search (A.Msg Staff) + | Search (A.Msg Gen.ApiStaffResult) -searchConfig : A.Config Msg Staff +searchConfig : A.Config Msg Gen.ApiStaffResult searchConfig = { wrap = Search, id = "add-seiyuu", source = A.staffSource } diff --git a/elm3/VNEdit/Staff.elm b/elm3/VNEdit/Staff.elm index 589475b2..07b94569 100644 --- a/elm3/VNEdit/Staff.elm +++ b/elm3/VNEdit/Staff.elm @@ -5,19 +5,18 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import Lib.Html exposing (..) import Lib.Autocomplete as A -import Lib.Gen exposing (VNEditStaff, staffRoles) +import Lib.Gen as Gen import Lib.Util exposing (..) -import Lib.Api exposing (Staff) type alias Model = - { staff : List VNEditStaff - , search : A.Model Staff + { staff : List Gen.VNEditStaff + , search : A.Model Gen.ApiStaffResult , duplicates : Bool } -init : List VNEditStaff -> Model +init : List Gen.VNEditStaff -> Model init l = { staff = l , search = A.init @@ -29,10 +28,10 @@ type Msg = Del Int | SetNote Int String | SetRole Int String - | Search (A.Msg Staff) + | Search (A.Msg Gen.ApiStaffResult) -searchConfig : A.Config Msg Staff +searchConfig : A.Config Msg Gen.ApiStaffResult searchConfig = { wrap = Search, id = "add-staff", source = A.staffSource } @@ -53,7 +52,7 @@ update msg model = Nothing -> ({ model | search = nm }, c) Just r -> let - role = List.head staffRoles |> Maybe.map Tuple.first |> Maybe.withDefault "" + role = List.head Gen.staffRoles |> Maybe.map Tuple.first |> Maybe.withDefault "" nrow = { aid = r.aid, id = r.id, name = r.name, role = role, note = "" } in (validate { model | search = A.clear nm, staff = model.staff ++ [nrow] }, c) @@ -66,7 +65,7 @@ view model = [ editListField 1 "col-form-label single-line" [ a [href <| "/s" ++ String.fromInt e.id, target "_blank" ] [text e.name ] ] , editListField 1 "" - [ inputSelect [onInput (SetRole n)] e.role staffRoles ] + [ inputSelect [onInput (SetRole n)] e.role Gen.staffRoles ] , editListField 2 "" [ inputText "" e.note (SetNote n) [placeholder "Note", maxlength 250] ] , editListField 0 "" [ removeButton (Del n) ] diff --git a/lib/VN3/Char/Edit.pm b/lib/VN3/Char/Edit.pm index d7c4ef4f..e711eb17 100644 --- a/lib/VN3/Char/Edit.pm +++ b/lib/VN3/Char/Edit.pm @@ -1,7 +1,6 @@ package VN3::Char::Edit; use VN3::Prelude; -use VN3::ElmGen; my $FORM = { @@ -137,7 +136,7 @@ json_api qr{/(?:$CID_RE/edit|c/add)}, $FORM_IN, sub { my $new = !tuwf->capture('id'); my $c = $new ? { id => 0 } : entry c => tuwf->capture('id') or return tuwf->resNotFound; - return tuwf->resJSON({Unauth => 1}) if !can_edit c => $c; + return $elm_Unauth->() if !can_edit c => $c; if(!auth->permDbmod) { $data->{hidden} = $c->{hidden}||0; @@ -160,10 +159,10 @@ json_api qr{/(?:$CID_RE/edit|c/add)}, $FORM_IN, sub { $data->{desc} = bb_subst_links $data->{desc}; - return tuwf->resJSON({Unchanged => 1}) if !$new && !form_changed $FORM_CMP, $data, $c; + return $elm_Unchanged->() if !$new && !form_changed $FORM_CMP, $data, $c; my($id,undef,$rev) = update_entry c => $c->{id}, $data; - tuwf->resJSON({Changed => [$id, $rev]}); + $elm_Changed->($id, $rev); }; 1; diff --git a/lib/VN3/Char/JS.pm b/lib/VN3/Char/JS.pm index b91b7534..2eceb98f 100644 --- a/lib/VN3/Char/JS.pm +++ b/lib/VN3/Char/JS.pm @@ -3,6 +3,17 @@ package VN3::Char::JS; use VN3::Prelude; +my $elm_CharResult = elm_api CharResult => { aoh => { + id => { id => 1 }, + name => {}, + original => {}, + main => { type => 'hash', required => 0, keys => { + id => { id => 1 }, + name => {}, + original => {}, + }}, +}}; + json_api '/js/char.json', { search => { maxlength => 500 } }, sub { @@ -32,7 +43,12 @@ json_api '/js/char.json', { 'LIMIT 20' ); - tuwf->resJSON({CharResult => $r}); + for (@$r) { + $_->{main} = $_->{main} ? { id => $_->{main}, name => $_->{main_name}, original => $_->{main_original} } : undef; + delete $_->{main_name}, $_->{main_original}; + } + + $elm_CharResult->($r); }; 1; diff --git a/lib/VN3/Docs/Edit.pm b/lib/VN3/Docs/Edit.pm index 1f2a5ba0..a93be5b2 100644 --- a/lib/VN3/Docs/Edit.pm +++ b/lib/VN3/Docs/Edit.pm @@ -2,7 +2,6 @@ package VN3::Docs::Edit; use VN3::Prelude; use VN3::Docs::Lib; -use VN3::ElmGen; my $FORM = { @@ -45,11 +44,11 @@ json_api qr{/$DOC_RE/edit}, $FORM_IN, sub { my $data = shift; my $doc = entry d => tuwf->capture('id') or return tuwf->resNotFound; - return tuwf->resJSON({Unauth => 1}) if !can_edit d => $doc; - return tuwf->resJSON({Unchanged => 1}) if !form_changed $FORM_CMP, $data, $doc; + return $elm_Unauth->() if !can_edit d => $doc; + return $elm_Unchanged->() if !form_changed $FORM_CMP, $data, $doc; my($id,undef,$rev) = update_entry d => $doc->{id}, $data; - tuwf->resJSON({Changed => [$id, $rev]}); + $elm_Changed->($id, $rev); }; 1; diff --git a/lib/VN3/Docs/JS.pm b/lib/VN3/Docs/JS.pm index 12e31f83..397842fd 100644 --- a/lib/VN3/Docs/JS.pm +++ b/lib/VN3/Docs/JS.pm @@ -3,11 +3,13 @@ package Docs::JS; use VN3::Prelude; use VN3::Docs::Lib; +my $elm_Content = elm_api Content => {}; + json_api '/js/markdown.json', { content => { required => 0, default => '' } }, sub { - tuwf->resJSON({Unauth => 1}) if !auth->permDbmod; - tuwf->resJSON({Content => md2html shift->{content}}); + return $elm_Unauth->() if !auth->permDbmod; + $elm_Content->(md2html shift->{content}); }; 1; diff --git a/lib/VN3/ElmGen.pm b/lib/VN3/ElmGen.pm index 621c03ec..f0066be6 100755..100644 --- a/lib/VN3/ElmGen.pm +++ b/lib/VN3/ElmGen.pm @@ -1,6 +1,6 @@ # This module is responsible for generating elm3/Lib/Gen.elm. Variables and -# type definitions can be added from any Perl module by calling def() and -# elm_form() at file load time. +# type definitions can be added from any Perl module by calling def(), +# elm_form() and elm_api() at file load time. package VN3::ElmGen; @@ -8,10 +8,14 @@ use strict; use warnings; use TUWF; use Exporter 'import'; +use List::Util 'max'; use VN3::Auth; use VN3::Types; -our @EXPORT = qw/ elm_form /; +our @EXPORT = qw/ + elm_form elm_api + $elm_Unauth $elm_Unchanged $elm_Changed $elm_Success $elm_CSRF +/; my $data = <<_; @@ -19,7 +23,9 @@ my $data = <<_; -- DO NOT EDIT! module Lib.Gen exposing (..) +import Http import Json.Encode as JE +import Json.Decode as JD type alias Medium = { qty : Bool @@ -80,7 +86,79 @@ sub elm_form { encoder lc($name).'SendEncode', $name.'Send', $in->analyze; } -sub print { print $data }; + +my %apis; + +# Define an API response. This will be added to the 'Lib.Api.Response' union type. +# Usage: +# +# # At file scope: +# my $json_generator = elm_api_response UnionName => $SCHEMA1, $SCHEMA2, ..; +# +# # Later, to actually generate a JSON response: +# $json_generator->($data1, $data2, ..); +# +# Limitation: There may be only a single $SCHEMA with an embedded {type => 'hash'}. +sub elm_api { + my($name, @schema) = @_; + @schema = map tuwf->compile($_), @schema; + $apis{$name} = \@schema; + sub { + # TODO: Validate $data? Easier to catch bugs that way + tuwf->resJSON({$name, @schema ? [map $schema[$_]->analyze->coerce_for_json($_[$_], unknown => 'reject'), 0..$#schema] : 1}) + } +} + +# Common API responses. +our $elm_Unauth = elm_api 'Unauth'; +our $elm_Unchanged = elm_api 'Unchanged'; +our $elm_Changed = elm_api 'Changed', { id => 1 }, { uint => 1 }; +our $elm_Success = elm_api 'Success'; +our $elm_CSRF = elm_api 'CSRF'; + + +sub print { + # Generate the ApiResponse type and decoder. + # + # 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 $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}) { + def_type $tname, $arg; + $def .= " $tname"; + #$dec .= $jd; + } elsif($arg->{values} && $arg->{values}{keys}) { + def_type $tname, $arg->{values}; + $def .= " (List $tname)"; + #$dec .= "(JD.list $jd)"; + } else { + $def .= ' '.$arg->elm_type(); + #$dec .= $jd; + } + #$dec .= ')'; + } + push @union, $def; + push @decode, $dec; + } + $data .= sprintf "\ntype ApiResponse\n = HTTPError Http.Error\n | %s\n", join "\n | ", @union; + $data .= sprintf "\ndecodeApiResponse : JD.Decoder ApiResponse\ndecodeApiResponse = JD.oneOf\n [ %s\n ]", join "\n , ", @decode; + + print $data; +}; my $perms = VN3::Auth::listPerms(); diff --git a/lib/VN3/Misc/ImageUpload.pm b/lib/VN3/Misc/ImageUpload.pm index 56f12ec3..76a07975 100644 --- a/lib/VN3/Misc/ImageUpload.pm +++ b/lib/VN3/Misc/ImageUpload.pm @@ -1,11 +1,7 @@ package VN3::Misc::ImageUpload; -use strict; -use warnings; +use VN3::Prelude; use Image::Magick; -use TUWF; -use VNDBUtil; -use VN3::Auth; sub save_img { @@ -25,18 +21,20 @@ sub save_img { chmod 0666, $fn; } +my $elm_ImgFormat = elm_api 'ImgFormat'; +my $elm_Image = elm_api 'Image', {id=>1}, {uint=>1}, {uint=>1}; # id, width, height + TUWF::post '/js/imageupload.json', sub { if(!auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) { warn "Invalid CSRF token in request"; - tuwf->resJSON({CSRF => 1}); - return; + return $elm_CSRF->(); } - return tuwf->resJSON({Unauth => 1}) if !auth->permEdit; + return $elm_Unauth->() if !auth->permEdit; my $type = tuwf->validate(post => type => { enum => [qw/cv ch sf/] })->data; my $imgdata = tuwf->reqUploadRaw('img'); - return tuwf->resJSON({ImgFormat => 1}) if $imgdata !~ /^(\xff\xd8|\x89\x50)/; # JPG or PNG header + return $elm_ImgFormat->() if $imgdata !~ /^(\xff\xd8|\x89\x50)/; # JPG or PNG header my $im = Image::Magick->new; $im->BlobToImage($imgdata); @@ -65,8 +63,7 @@ TUWF::post '/js/imageupload.json', sub { save_img $im, ch => $id, $ow, $oh, 256, 300; } - - tuwf->resJSON({Image => [$id, $ow, $oh]}); + $elm_Image->($id, $ow, $oh); }; diff --git a/lib/VN3/Prelude.pm b/lib/VN3/Prelude.pm index 3e9465ef..21bea25f 100644 --- a/lib/VN3/Prelude.pm +++ b/lib/VN3/Prelude.pm @@ -16,14 +16,20 @@ # use VN3::Types; # use VN3::Validation; # use VN3::BBCode; +# use VN3::ElmGen; # # WARNING: This should not be used from the above modules. +# +# This module also exports a few utility functions for writing URI handlers. package VN3::Prelude; use strict; use warnings; use utf8; use feature ':5.10'; +use TUWF; +use VN3::Auth; +use VN3::ElmGen; sub import { my $c = caller; @@ -47,8 +53,50 @@ sub import { use VN3::Types; use VN3::Validation; use VN3::BBCode; + use VN3::ElmGen; 1; EOM; + + no strict 'refs'; + *{$c.'::json_api'} = \&json_api; +} + + + +# 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; +# }; +my $elm_Invalid = elm_api 'Invalid', {}; +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"; + $elm_CSRF->(); + return; + } + + 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"; + $elm_Invalid->($data->err); + return; + } + + $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/VN3/Producer/Edit.pm b/lib/VN3/Producer/Edit.pm index b879c739..1b2fd21d 100644 --- a/lib/VN3/Producer/Edit.pm +++ b/lib/VN3/Producer/Edit.pm @@ -1,7 +1,6 @@ package VN3::Producer::Edit; use VN3::Prelude; -use VN3::ElmGen; my $FORM = { @@ -77,7 +76,7 @@ json_api qr{/(?:$PID_RE/edit|p/add)}, $FORM_IN, sub { my $new = !tuwf->capture('id'); my $p = $new ? { id => 0 } : entry p => tuwf->capture('id') or return tuwf->resNotFound; - return tuwf->resJSON({Unauth => 1}) if !can_edit p => $p; + return $elm_Unauth->() if !can_edit p => $p; $data->{l_wp} ||= undef; if(!auth->permDbmod) { @@ -92,14 +91,14 @@ json_api qr{/(?:$PID_RE/edit|p/add)}, $FORM_IN, sub { $data->{desc} = bb_subst_links $data->{desc}; $p->{ptype} = delete $p->{type}; - return tuwf->resJSON({Unchanged => 1}) if !$new && !form_changed $FORM_CMP, $data, $p; + return $elm_Unchanged->() if !$new && !form_changed $FORM_CMP, $data, $p; $data->{type} = delete $data->{ptype}; my($id,undef,$rev) = update_entry p => $p->{id}, $data; update_reverse($id, $rev, $p, $data); - tuwf->resJSON({Changed => [$id, $rev]}); + $elm_Changed->($id, $rev); }; diff --git a/lib/VN3/Producer/JS.pm b/lib/VN3/Producer/JS.pm index 26f55de6..50161ce5 100644 --- a/lib/VN3/Producer/JS.pm +++ b/lib/VN3/Producer/JS.pm @@ -3,12 +3,12 @@ package VN3::Producer::JS; use VN3::Prelude; -my $OUT = tuwf->compile({ aoh => { +my $elm_ProducerResult = elm_api ProducerResult => { aoh => { id => { id => 1 }, name => {}, original => {}, hidden => { anybool => 1 }, -}}); +}}; json_api '/js/producer.json', { @@ -41,7 +41,7 @@ json_api '/js/producer.json', { 'LIMIT 20' ); - tuwf->resJSON({ProducerResult => $OUT->analyze->coerce_for_json($r)}); + $elm_ProducerResult->($r); }; 1; diff --git a/lib/VN3/Release/Edit.pm b/lib/VN3/Release/Edit.pm index c1aa4e96..d552fa9b 100644 --- a/lib/VN3/Release/Edit.pm +++ b/lib/VN3/Release/Edit.pm @@ -1,7 +1,6 @@ package VN3::Release::Edit; use VN3::Prelude; -use VN3::ElmGen; my $FORM = { hidden => { anybool => 1 }, @@ -104,7 +103,7 @@ json_api qr{/(?:$RID_RE/edit|r/add)}, $FORM_IN, sub { my $new = !tuwf->capture('id'); my $rel = $new ? { id => 0 } : entry r => tuwf->capture('id') or return tuwf->resNotFound; - return tuwf->resJSON({Unauth => 1}) if !can_edit r => $rel; + return $elm_Unauth->() if !can_edit r => $rel; if(!auth->permDbmod) { $data->{hidden} = $rel->{hidden}||0; @@ -121,11 +120,11 @@ json_api qr{/(?:$RID_RE/edit|r/add)}, $FORM_IN, sub { $data->{notes} = bb_subst_links $data->{notes}; $rel->{rtype} = delete $rel->{type}; - return tuwf->resJSON({Unchanged => 1}) if !$new && !form_changed $FORM_CMP, $data, $rel; + return $elm_Unchanged() if !$new && !form_changed $FORM_CMP, $data, $rel; $data->{type} = delete $data->{rtype}; my($id,undef,$rev) = update_entry r => $rel->{id}, $data; - tuwf->resJSON({Changed => [$id, $rev]}); + $elm_Changed->($id, $rev); }; 1; diff --git a/lib/VN3/Release/JS.pm b/lib/VN3/Release/JS.pm index c562d4c5..152fd69a 100644 --- a/lib/VN3/Release/JS.pm +++ b/lib/VN3/Release/JS.pm @@ -3,11 +3,11 @@ package VN3::Release::JS; use VN3::Prelude; -my $OUT = tuwf->compile({ aoh => { +my $elm_ReleaseResult = elm_api ReleaseResult => { aoh => { id => { id => 1 }, title => {}, lang => { type => 'array', values => {} }, -}}); +}}; # Fetch all releases assigned to a VN @@ -26,7 +26,7 @@ json_api '/js/release.json', { }); enrich_list1 lang => id => id => sub { sql 'SELECT id, lang FROM releases_lang WHERE id IN', $_[0], 'ORDER BY id, lang' }, $r; - tuwf->resJSON({ReleaseResult => $OUT->analyze->coerce_for_json($r)}); + $elm_ReleaseResult->($r); }; 1; diff --git a/lib/VN3/Staff/Edit.pm b/lib/VN3/Staff/Edit.pm index 154434ea..0b9c3af4 100644 --- a/lib/VN3/Staff/Edit.pm +++ b/lib/VN3/Staff/Edit.pm @@ -1,7 +1,6 @@ package VN3::Staff::Edit; use VN3::Prelude; -use VN3::ElmGen; my $FORM = { @@ -77,7 +76,7 @@ json_api qr{/(?:$SID_RE/edit|s/add)}, $FORM_IN, sub { my $new = !tuwf->capture('id'); my $e = $new ? { id => 0 } : entry s => tuwf->capture('id') or return tuwf->resNotFound; - return tuwf->resJSON({Unauth => 1}) if !can_edit s => $e; + return $elm_Unauth->() if !can_edit s => $e; if(!auth->permDbmod) { $data->{hidden} = $e->{hidden}||0; @@ -101,9 +100,9 @@ json_api qr{/(?:$SID_RE/edit|s/add)}, $FORM_IN, sub { $data->{desc} = bb_subst_links $data->{desc}; - return tuwf->resJSON({Unchanged => 1}) if !$new && !form_changed $FORM_CMP, $data, $e; + return $elm_Unchanged->() if !$new && !form_changed $FORM_CMP, $data, $e; my($id,undef,$rev) = update_entry s => $e->{id}, $data; - tuwf->resJSON({Changed => [$id, $rev]}); + $elm_Changed->($id, $rev); }; 1; diff --git a/lib/VN3/Staff/JS.pm b/lib/VN3/Staff/JS.pm index 02531ac1..58ce947b 100644 --- a/lib/VN3/Staff/JS.pm +++ b/lib/VN3/Staff/JS.pm @@ -2,6 +2,12 @@ package Staff::JS; use VN3::Prelude; +my $elm_StaffResult = elm_api StaffResult => { aoh => { + id => { id => 1 }, + aid => { id => 1 }, + name => {}, + original => {}, +}}; json_api '/js/staff.json', { search => { maxlength => 500 } @@ -31,7 +37,7 @@ json_api '/js/staff.json', { 'LIMIT 20' ); - tuwf->resJSON({StaffResult => $r}); + $elm_StaffResult->($r); }; 1; diff --git a/lib/VN3/Trait/JS.pm b/lib/VN3/Trait/JS.pm index d8844ddd..05e1d03d 100644 --- a/lib/VN3/Trait/JS.pm +++ b/lib/VN3/Trait/JS.pm @@ -2,6 +2,12 @@ package VN3::Trait::JS; use VN3::Prelude; +my $elm_TraitResult = elm_api TraitResult => { aoh => { + id => { id => 1 }, + name => {}, + gid => { id => 1, required => 0 }, + group => { required => 0 } +}}; # Returns only approved and applicable traits json_api '/js/trait.json', { @@ -32,7 +38,7 @@ json_api '/js/trait.json', { 'LIMIT 20' ); - tuwf->resJSON({TraitResult => $r}); + $elm_TraitResult->($r); }; 1; diff --git a/lib/VN3/User/Login.pm b/lib/VN3/User/Login.pm index 050d7130..7660762a 100644 --- a/lib/VN3/User/Login.pm +++ b/lib/VN3/User/Login.pm @@ -12,6 +12,9 @@ TUWF::get '/u/login' => sub { }; +my $elm_Throttled = elm_api 'Throttled'; +my $elm_BadLogin = elm_api 'BadLogin'; + json_api '/u/login', { username => { username => 1 }, password => { password => 1 } @@ -25,21 +28,16 @@ json_api '/u/login', { 'SELECT', sql_totime('greatest(timeout, now())'), 'FROM login_throttle WHERE ip =', \$ip ) || time; - my $status - = $tm-time() > $conf->[1] ? 'Throttled' - : auth->login($data->{username}, $data->{password}) ? 'Success' - : 'BadLogin'; + return $elm_Throttled->() if $tm-time() > $conf->[1]; + return $elm_Success->() if auth->login($data->{username}, $data->{password}); # Failed login, update throttle. - if($status eq 'BadLogin') { - my $upd = { - ip => \$ip, - timeout => sql_fromtime $tm+$conf->[0] - }; - tuwf->dbExeci('INSERT INTO login_throttle', $upd, 'ON CONFLICT (ip) DO UPDATE SET', $upd); - } - - tuwf->resJSON({$status => 1}); + my $upd = { + ip => \$ip, + timeout => sql_fromtime $tm+$conf->[0] + }; + tuwf->dbExeci('INSERT INTO login_throttle', $upd, 'ON CONFLICT (ip) DO UPDATE SET', $upd); + $elm_BadLogin->() }; diff --git a/lib/VN3/User/RegReset.pm b/lib/VN3/User/RegReset.pm index 5b227ef7..ed815547 100644 --- a/lib/VN3/User/RegReset.pm +++ b/lib/VN3/User/RegReset.pm @@ -12,13 +12,21 @@ TUWF::get '/u/newpass' => sub { }; +my $elm_BadEmail = elm_api 'BadEmail'; +my $elm_BadPass = elm_api 'BadPass'; +my $elm_Bot = elm_api 'Bot'; +my $elm_Taken = elm_api 'Taken'; +my $elm_DoubleEmail = elm_api 'DoubleEmail'; +my $elm_DoubleIP = elm_api 'DoubleIP'; + + json_api '/u/newpass', { email => { email => 1 }, }, sub { my $data = shift; my($id, $token) = auth->resetpass($data->{email}); - return tuwf->resJSON({BadEmail => 1}) if !$id; + return $elm_BadEmail->() if !$id; my $name = tuwf->dbVali('SELECT username FROM users WHERE id =', \$id); my $body = sprintf @@ -38,7 +46,7 @@ json_api '/u/newpass', { From => 'VNDB <noreply@vndb.org>', Subject => "Password reset for $name", ); - tuwf->resJSON({Success => 1}); + $elm_Success->(); }; @@ -66,10 +74,10 @@ json_api $reset_url, { my $id = tuwf->capture('id'); my $token = tuwf->capture('token'); - return tuwf->resJSON({BadPass => 1}) if tuwf->isUnsafePass($data->{pass}); + return $elm_BadPass->() if tuwf->isUnsafePass($data->{pass}); die "Invalid reset token" if !auth->setpass($id, $token, undef, $data->{pass}); tuwf->dbExeci('UPDATE users SET email_confirmed = true WHERE id =', \$id); - tuwf->resJSON({Success => 1}); + $elm_Success->() }; @@ -89,15 +97,12 @@ json_api '/u/register', { my $data = shift; my $num = tuwf->dbVali("SELECT count FROM stats_cache WHERE section = 'vn'"); - return tuwf->resJSON({Bot => 1}) - if $data->{vns} < $num*0.995 || $data->{vns} > $num*1.005; - return tuwf->resJSON({Taken => 1}) - if tuwf->dbVali('SELECT 1 FROM users WHERE username =', \$data->{username}); - return tuwf->resJSON({DoubleEmail => 1}) - if tuwf->dbVali(select => sql_func user_emailexists => \$data->{email}); + return $elm_Bot->() if $data->{vns} < $num*0.995 || $data->{vns} > $num*1.005; + return $elm_Taken->() if tuwf->dbVali('SELECT 1 FROM users WHERE username =', \$data->{username}); + return $elm_DoubleEmail->() if tuwf->dbVali(select => sql_func user_emailexists => \$data->{email}); my $ip = tuwf->reqIP; - return tuwf->resJSON({DoubleIP => 1}) if tuwf->dbVali( + return $elm_DoubleIP->() if tuwf->dbVali( q{SELECT 1 FROM users WHERE registered >= NOW()-'1 day'::interval AND ip <<}, $ip =~ /:/ ? \"$ip/48" : \"$ip/30" ); @@ -126,7 +131,7 @@ json_api '/u/register', { From => 'VNDB <noreply@vndb.org>', Subject => "Confirm registration for $data->{username}", ); - tuwf->resJSON({Success => 1}); + $elm_Success->() }; 1; diff --git a/lib/VN3/User/Settings.pm b/lib/VN3/User/Settings.pm index e3539168..a63de232 100644 --- a/lib/VN3/User/Settings.pm +++ b/lib/VN3/User/Settings.pm @@ -1,7 +1,6 @@ package VN3::User::Settings; use VN3::Prelude; -use VN3::ElmGen; my $FORM = { @@ -32,6 +31,8 @@ my $FORM_IN = form_compile in => $FORM; elm_form UserEdit => $FORM_OUT, $FORM_IN; +my $elm_BadPass = elm_api 'BadPass'; +my $elm_BadLogin = elm_api 'BadLogin'; TUWF::get qr{/$UID_RE/edit}, sub { my $u = tuwf->dbRowi('SELECT id, username, perm, ign_votes FROM users WHERE id =', \tuwf->capture('id')); @@ -63,7 +64,7 @@ json_api qr{/$UID_RE/edit}, $FORM_IN, sub { my $data = shift; my $id = tuwf->capture('id'); - return tuwf->resJSON({Unauth => 1}) if !can_edit u => { id => $id }; + return $elm_Unauth->() if !can_edit u => { id => $id }; if(auth->permUsermod) { tuwf->dbExeci(update => users => set => { @@ -75,10 +76,10 @@ json_api qr{/$UID_RE/edit}, $FORM_IN, sub { } if($data->{password}) { - return tuwf->resJSON({BadPass => 1}) if tuwf->isUnsafePass($data->{password}{new}); + return $elm_BadPass->() if tuwf->isUnsafePass($data->{password}{new}); if(auth->uid == $id) { - return tuwf->resJSON({BadLogin => 1}) if !auth->setpass($id, undef, $data->{password}{old}, $data->{password}{new}); + return $elm_BadLogin->() if !auth->setpass($id, undef, $data->{password}{old}, $data->{password}{new}); } else { tuwf->dbExeci(select => sql_func user_admin_setpass => \$id, \auth->uid, sql_fromhex(auth->token), sql_fromhex auth->_preparepass($data->{password}{new}) @@ -91,7 +92,7 @@ json_api qr{/$UID_RE/edit}, $FORM_IN, sub { auth->prefSet($_, $data->{$_}, $id) for qw/hide_list show_nsfw traits_sexual tags_all spoilers/; auth->prefSet(tags_cat => join(',', map $data->{"tags_$_"} ? $_ : (), qw/cont ero tech/), $id); - tuwf->resJSON({Success => 1}); + $elm_Success->(); }; 1; diff --git a/lib/VN3/User/VNList.pm b/lib/VN3/User/VNList.pm index 9b4d34ed..71ebd1f3 100644 --- a/lib/VN3/User/VNList.pm +++ b/lib/VN3/User/VNList.pm @@ -289,7 +289,7 @@ json_api '/u/setvote', { vote => { vnvote => 1 } }, sub { my $data = shift; - return tuwf->resJSON({Unauth => 1}) if (auth->uid||0) != $data->{uid}; + return $elm_Unauth->() if (auth->uid||0) != $data->{uid}; tuwf->dbExeci( 'DELETE FROM votes WHERE', @@ -303,7 +303,7 @@ json_api '/u/setvote', { { vote => $data->{vote} } ) if $data->{vote}; - tuwf->resJSON({Success => 1}) + $elm_Success->() }; @@ -313,7 +313,7 @@ json_api '/u/setvnstatus', { status => { vnlist_status => 1 } }, sub { my $data = shift; - return tuwf->resJSON({Unauth => 1}) if (auth->uid||0) != $data->{uid}; + return $elm_Unauth->() if (auth->uid||0) != $data->{uid}; tuwf->dbExeci( 'INSERT INTO vnlists', @@ -321,5 +321,5 @@ json_api '/u/setvnstatus', { 'ON CONFLICT (vid, uid) DO UPDATE SET', { status => $data->{status} } ); - tuwf->resJSON({Success => 1}) + $elm_Success->(); }; diff --git a/lib/VN3/VN/Edit.pm b/lib/VN3/VN/Edit.pm index 6386104f..bee48a5f 100644 --- a/lib/VN3/VN/Edit.pm +++ b/lib/VN3/VN/Edit.pm @@ -2,7 +2,6 @@ package VN3::VN::Edit; use VN3::Prelude; use VN3::VN::Lib; -use VN3::ElmGen; my $FORM = { @@ -125,7 +124,7 @@ json_api qr{/(?:$VID_RE/edit|v/add)}, $FORM_IN, sub { my $new = !tuwf->capture('id'); my $vn = $new ? { id => 0 } : entry v => tuwf->capture('id') or return tuwf->resNotFound; - return tuwf->resJSON({Unauth => 1}) if !can_edit v => $vn; + return $elm_Unauth->() if !can_edit v => $vn; if(!auth->permDbmod) { $data->{hidden} = $vn->{hidden}||0; @@ -143,13 +142,13 @@ json_api qr{/(?:$VID_RE/edit|v/add)}, $FORM_IN, sub { validate_dbid sql('SELECT DISTINCT id FROM chars_vns WHERE vid =', \$vn->{id}, ' AND id IN'), map $_->{cid}, @{$data->{seiyuu}}; $data->{desc} = bb_subst_links $data->{desc}; - return tuwf->resJSON({Unchanged => 1}) if !$new && !form_changed $FORM_CMP, $data, $vn; + return $elm_Unchanged->() if !$new && !form_changed $FORM_CMP, $data, $vn; my($id,undef,$rev) = update_entry v => $vn->{id}, $data; update_reverse($id, $rev, $vn, $data); - tuwf->resJSON({Changed => [$id, $rev]}); + $elm_Changed->($id, $rev); }; diff --git a/lib/VN3/VN/JS.pm b/lib/VN3/VN/JS.pm index 8c2c30ab..ec98b768 100644 --- a/lib/VN3/VN/JS.pm +++ b/lib/VN3/VN/JS.pm @@ -3,12 +3,12 @@ package VN3::VN::JS; use VN3::Prelude; -my $OUT = tuwf->compile({ aoh => { +my $elm_VNResult = elm_api VNResult => { aoh => { id => { id => 1 }, title => {}, original => {}, hidden => { anybool => 1 }, -}}); +}}; json_api '/js/vn.json', { @@ -39,7 +39,7 @@ json_api '/js/vn.json', { 'LIMIT 20' ); - tuwf->resJSON({VNResult => $OUT->analyze->coerce_for_json($r)}); + $elm_VNResult->($r); }; 1; diff --git a/lib/VN3/Validation.pm b/lib/VN3/Validation.pm index a0a59e44..2c30e26d 100644 --- a/lib/VN3/Validation.pm +++ b/lib/VN3/Validation.pm @@ -1,15 +1,5 @@ # This module provides additional validations for tuwf->validate(), and exports -# an 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; -# }; +# a few convenient form handling/validation functions. package VN3::Validation; use strict; @@ -23,7 +13,7 @@ use JSON::XS; use Exporter 'import'; use Time::Local 'timegm'; use Carp 'croak'; -our @EXPORT = ('form_compile', 'form_changed', 'json_api', 'validate_dbid', 'can_edit'); +our @EXPORT = ('form_compile', 'form_changed', 'validate_dbid', 'can_edit'); TUWF::set custom_validations => { @@ -143,30 +133,6 @@ sub form_changed { } -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"; - tuwf->resJSON({CSRF => 1}); - return; - } - - 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"; - tuwf->resJSON({Invalid => $data->err}); - return; - } - - $sub->($data->data); - }; -} - - # Validate identifiers against an SQL query. The query must end with a 'id IN' # clause, where the @ids array is appended. The query must return exactly 1 # column, the id of each entry. This function throws an error if an id is |