diff options
Diffstat (limited to 'lib/VNWeb/Elm.pm')
-rw-r--r-- | lib/VNWeb/Elm.pm | 196 |
1 files changed, 103 insertions, 93 deletions
diff --git a/lib/VNWeb/Elm.pm b/lib/VNWeb/Elm.pm index 13165959..ad4f80a3 100644 --- a/lib/VNWeb/Elm.pm +++ b/lib/VNWeb/Elm.pm @@ -1,4 +1,4 @@ -# This module is responsible for generating elm/Gen/*. +# This module is responsible for generating elm/Gen/*; # # It exports an `elm_api` function to create an API endpoint, type definitions, # a JSON encoder and HTML5 validation attributes to simplify and synchronize @@ -18,6 +18,8 @@ use VNDB::Config; use VNDB::Types; use VNDB::Func 'fmtrating'; use VNDB::ExtLinks (); +use VNDB::Skins; +use VNWeb::Validation; use VNWeb::Auth; our @EXPORT = qw/ @@ -36,25 +38,19 @@ our %apis = ( Unchanged => [], # No changes Success => [], Redirect => [{}], # Redirect to the given URL - CSRF => [], # Invalid CSRF token Invalid => [], # POST data did not validate the schema Editsum => [], # Invalid edit summary Content => [{}], # Rendered HTML content (for markdown/bbcode APIs) - BadLogin => [], # Invalid user or pass - LoginThrottle => [], # Too many failed login attempts - InsecurePass => [], # Password is in a dictionary or breach database - BadEmail => [], # Unknown email address in password reset form - Bot => [], # User didn't pass bot verification - Taken => [], # Username already taken - DoubleEmail => [], # Account with same email already exists - DoubleIP => [], # Account with same IP already exists - BadCurPass => [], # Current password is incorrect when changing password - MailChange => [], # A confirmation mail has been sent to change a user's email address ImgFormat => [], # Unrecognized image format + LabelId => [{uint => 1}], # Label created + DupNames => [ { aoh => { # Duplicate names/aliases (for tags & traits) + id => { vndbid => ['i','g'] }, + name => {}, + } } ], Releases => [ { aoh => { # Response to 'Release' - id => { id => 1 }, + id => { vndbid => 'r' }, title => {}, - original => { required => 0, default => '' }, + alttitle => { default => '' }, released => { uint => 1 }, rtype => {}, reso_x => { uint => 1 }, @@ -62,87 +58,130 @@ our %apis = ( lang => { type => 'array', values => {} }, platforms=> { type => 'array', values => {} }, } } ], + Resolutions => [ { aoh => { # Response to 'Resolutions' + resolution => {}, + count => { uint => 1 }, + } } ], + Engines => [ { aoh => { # Response to 'Engines' + engine => {}, + count => { uint => 1 }, + } } ], + DRM => [ { aoh => { # Response to 'DRM' + name => {}, + count => { uint => 1 }, + } } ], BoardResult => [ { aoh => { # Response to 'Boards' - btype => {}, - iid => { required => 0, default => 0, id => 1 }, - title => { required => 0 }, + btype => { enum => \%BOARD_TYPE }, + iid => { default => undef, vndbid => ['p','v','u'] }, + title => { default => undef }, } } ], TagResult => [ { aoh => { # Response to 'Tags' - id => { id => 1 }, + id => { vndbid => 'g' }, name => {}, searchable => { anybool => 1 }, applicable => { anybool => 1 }, - state => { int => 1 }, + hidden => { anybool => 1 }, + locked => { anybool => 1 }, } } ], TraitResult => [ { aoh => { # Response to 'Traits' - id => { id => 1 }, + id => { vndbid => 'i' }, name => {}, searchable => { anybool => 1 }, applicable => { anybool => 1 }, - state => { int => 1 }, defaultspoil => { uint => 1 }, - group_id => { required => 0, uint => 1 }, - group_name => { required => 0 }, + hidden => { anybool => 1 }, + locked => { anybool => 1 }, + group_id => { default => undef, vndbid => 'i' }, + group_name => { default => undef }, } } ], VNResult => [ { aoh => { # Response to 'VN' - id => { id => 1 }, + id => { vndbid => 'v' }, title => {}, - original => { required => 0, default => '' }, hidden => { anybool => 1 }, } } ], ProducerResult => [ { aoh => { # Response to 'Producers' - id => { id => 1 }, + id => { vndbid => 'p' }, name => {}, - original => { required => 0, default => '' }, - hidden => { anybool => 1 }, + altname => { default => undef }, } } ], StaffResult => [ { aoh => { # Response to 'Staff' - id => { id => 1 }, + id => { vndbid => 's' }, + lang => {}, aid => { id => 1 }, - name => {}, - original => { required => 0, default => '' }, + title => {}, + alttitle => {}, } } ], CharResult => [ { aoh => { # Response to 'Chars' - id => { id => 1 }, - name => {}, - original => { required => 0, default => '' }, - main => { required => 0, type => 'hash', keys => { - id => { id => 1 }, - name => {}, - original => { required => 0, default => '' }, + id => { vndbid => 'c' }, + title => {}, + alttitle => {}, + main => { default => undef, type => 'hash', keys => { + id => { vndbid => 'c' }, + title => {}, + alttitle => {}, } } } } ], AnimeResult => [ { aoh => { # Response to 'Anime' id => { id => 1 }, title => {}, - original => { required => 0, default => '' }, + original => { default => '' }, } } ], ImageResult => [ { aoh => { # Response to 'Images' - id => { }, # image id... - token => { required => 0 }, + id => { vndbid => ['ch','cv','sf'] }, + token => { default => undef }, width => { uint => 1 }, height => { uint => 1 }, votecount => { uint => 1 }, - sexual_avg => { num => 1, required => 0 }, - sexual_stddev => { num => 1, required => 0 }, - violence_avg => { num => 1, required => 0 }, - violence_stddev => { num => 1, required => 0 }, - my_sexual => { uint => 1, required => 0 }, - my_violence => { uint => 1, required => 0 }, + sexual_avg => { num => 1, default => undef }, + sexual_stddev => { num => 1, default => undef }, + violence_avg => { num => 1, default => undef }, + violence_stddev => { num => 1, default => undef }, + my_sexual => { uint => 1, default => undef }, + my_violence => { uint => 1, default => undef }, my_overrule => { anybool => 1 }, - entry => { required => 0, type => 'hash', keys => { + entry => { default => undef, type => 'hash', keys => { id => {}, title => {}, } }, votes => { unique => 0, aoh => { user => {}, - uid => { uint => 1, required => 0 }, + uid => { vndbid => 'u', default => undef }, sexual => { uint => 1 }, violence => { uint => 1 }, ignore => { anybool => 1 }, } }, } } ], ); +# (These references to other API results cause redundant Elm code - can be deduplicated) +$apis{AdvSearchQuery} = [ { type => 'hash', keys => { # Response to 'AdvSearchLoad' + qtype => {}, + query => { type => 'any' }, + producers => $apis{ProducerResult}[0], + staff => $apis{StaffResult}[0], + tags => $apis{TagResult}[0], + traits => $apis{TraitResult}[0], + anime => $apis{AnimeResult}[0], +} } ]; +$apis{UListWidget} = [ { type => 'hash', keys => { # Initialization for UList.Widget and response to UListWidget + uid => { vndbid => 'u' }, + vid => { vndbid => 'v' }, + # Only includes selected labels, null if the VN is not on the list at all. + labels => { default => undef, aoh => { id => { int => 1 }, label => {default => ''} } }, + # Can be set to null to lazily load the extra data as needed + full => { default => undef, type => 'hash', keys => { + title => {}, + labels => { aoh => { id => { int => 1 }, label => {}, private => { anybool => 1 } } }, + canvote => { anybool => 1 }, + canreview => { anybool => 1 }, + vote => { vnvote => 1 }, + review => { default => undef, vndbid => 'w' }, + notes => { default => '' }, + started => { default => '' }, + finished => { default => '' }, + releases => $apis{Releases}[0], + rlist => { aoh => { id => { vndbid => 'r' }, status => { uint => 1 } } }, + } }, +} } ]; # Compile %apis into a %schema and generate the elm_Response() functions @@ -184,6 +223,7 @@ sub def_type { $data .= def_type($name . to_camel($_), $obj->{keys}{$_}{values} || bless { $obj->{keys}{$_}->%*, required => 1 }, ref $obj->{keys}{$_} ) for @keys; $data .= sprintf "\ntype alias %s = %s\n\n", $name, $obj->elm_type( + any => 'JE.Value', keys => +{ map { my $t = $obj->{keys}{$_}; my $n = $name . to_camel($_); @@ -223,7 +263,7 @@ sub def_validation { # Generate an Elm JSON encoder taking a corresponding def_type() as input sub encoder { my($name, $type, $obj) = @_; - def $name, "$type -> JE.Value", $obj->elm_encoder(json_encode => 'JE.'); + def $name, "$type -> JE.Value", $obj->elm_encoder(any => ' ', json_encode => 'JE.'); } @@ -231,7 +271,7 @@ sub encoder { sub write_module { my($module, $contents) = @_; - my $fn = sprintf '%s/elm/Gen/%s.elm', config->{root}, $module; + my $fn = sprintf '%s/elm/Gen/%s.elm', config->{gen_path}, $module; # The imports aren't necessary in all the files, but might as well add them. $contents = <<~"EOF"; @@ -293,11 +333,6 @@ sub elm_api { $in = comp $in; TUWF::post qr{/elm/\Q$name\E\.json} => sub { - if(!tuwf->samesite && !auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) { - warn "Invalid CSRF token in request\n"; - return elm_CSRF(); - } - my $data = tuwf->validate(json => $in); # Handle failure of the 'editsum' validation as a special case and return elm_Editsum(). if(!$data && $data->err->{errors} && grep $_->{validation} eq 'editsum' || ($_->{validation} eq 'required' && $_->{key} eq 'editsum'), $data->err->{errors}->@*) { @@ -344,7 +379,7 @@ sub elm_empty { return [] if $schema->{type} eq 'array'; return '' if $schema->{type} eq 'bool' || $schema->{type} eq 'scalar'; return 0 if $schema->{type} eq 'num' || $schema->{type} eq 'int'; - return +{ map +($_, elm_empty($schema->{keys}{$_})), $schema->{keys} ? $schema->{keys}->%* : () } if $schema->{type} eq 'hash'; + return +{ map +($_, elm_empty($schema->{keys}{$_})), $schema->{keys} ? keys $schema->{keys}->%* : () } if $schema->{type} eq 'hash'; die "Unable to initialize required value of type '$schema->{type}' without a default"; } @@ -393,11 +428,7 @@ sub write_api { sub write_types { my $data = ''; - $data .= def adminEMail => String => string config->{admin_email}; - $data .= def skins => 'List (String, String)' => - list map tuple(string $_, string tuwf->{skins}{$_}[0]), - sort { tuwf->{skins}{$a}[0] cmp tuwf->{skins}{$b}[0] } keys tuwf->{skins}->%*; - $data .= def languages => 'List (String, String)' => list map tuple(string $_, string $LANGUAGE{$_}), sort { $LANGUAGE{$a} cmp $LANGUAGE{$b} } keys %LANGUAGE; + $data .= def languages => 'List (String, String)' => list map tuple(string $_, string $LANGUAGE{$_}{txt}), sort { $LANGUAGE{$a}{txt} cmp $LANGUAGE{$b}{txt} } keys %LANGUAGE; $data .= def platforms => 'List (String, String)' => list map tuple(string $_, string $PLATFORM{$_}), keys %PLATFORM; $data .= def releaseTypes => 'List (String, String)' => list map tuple(string $_, string $RELEASE_TYPE{$_}), keys %RELEASE_TYPE; $data .= def media => 'List (String, String, Bool)' => list map tuple(string $_, string $MEDIUM{$_}{txt}, $MEDIUM{$_}{qty}?'True':'False'), keys %MEDIUM; @@ -405,6 +436,7 @@ sub write_types { $data .= def boardTypes => 'List (String, String)' => list map tuple(string $_, string $BOARD_TYPE{$_}{txt}), keys %BOARD_TYPE; $data .= def ratings => 'List String' => list map string(fmtrating $_), 1..10; $data .= def ageRatings => 'List (Int, String)' => list map tuple($_, string $AGE_RATING{$_}{txt}.($AGE_RATING{$_}{ex}?" ($AGE_RATING{$_}{ex})":'')), keys %AGE_RATING; + $data .= def devStatus => 'List (Int, String)' => list map tuple($_, string $DEVSTATUS{$_}), keys %DEVSTATUS; $data .= def voiced => 'List (Int, String)' => list map tuple($_, string $VOICED{$_}{txt}), keys %VOICED; $data .= def animated => 'List (Int, String)' => list map tuple($_, string $ANIMATED{$_}{txt}), keys %ANIMATED; $data .= def genders => 'List (String, String)' => list map tuple(string $_, string $GENDER{$_}), keys %GENDER; @@ -416,6 +448,7 @@ sub write_types { $data .= def creditTypes=> 'List (String, String)' => list map tuple(string $_, string $CREDIT_TYPE{$_}), keys %CREDIT_TYPE; $data .= def producerRelations=> 'List (String, String)' => list map tuple(string $_, string $PRODUCER_RELATION{$_}{txt}), keys %PRODUCER_RELATION; $data .= def producerTypes=> 'List (String, String)' => list map tuple(string $_, string $PRODUCER_TYPE{$_}), keys %PRODUCER_TYPE; + $data .= def tagCategories=> 'List (String, String)' => list map tuple(string $_, string $TAG_CATEGORY{$_}), keys %TAG_CATEGORY; $data .= def curYear => Int => (gmtime)[5]+1900; write_module Types => $data; @@ -425,59 +458,36 @@ sub write_types { sub write_extlinks { my $data =<<~'_'; import Regex - import Gen.ReleaseEdit as GRE - type alias Site a = + type alias Site = { name : String - , fmt : String - , regex : Regex.Regex - , multi : Bool - , links : a -> List String - , del : Int -> a -> a - , add : String -> a -> a - , patt : List String + , advid : String } - - reg r = Maybe.withDefault Regex.never (Regex.fromStringWith {caseInsensitive=True, multiline=False} r) - delidx n l = List.take n l ++ List.drop (n+1) l - toint v = Maybe.withDefault 0 (String.toInt v) - - -- Link extraction functions for `Site.links`, i=integer, s=string, m=multi - li v = if v == 0 then [] else [String.fromInt v] - lim = List.map String.fromInt - ls v = if v == "" then [] else [v] - lsm v = v _ my sub links { - my($name, $type, @links) = @_; - $data .= def $name.'Sites' => "List (Site $type)" => list map { + my($name, @links) = @_; + $data .= def $name.'Sites' => "List (Site)" => list map { my $l = $_; my $addval = $l->{int} ? 'toint v' : 'v'; '{ '.join("\n , ", 'name = '.string($l->{name}), - 'fmt = '.string($l->{fmt}), - 'regex = reg '.string(TUWF::Validate::Interop::_re_compat($l->{regex})), - 'multi = '.($l->{multi}?'True':'False'), - 'links = '.sprintf('(\m -> l%s%s m.%s)', $l->{int}?'i':'s', $l->{multi}?'m':'', $l->{id}), - 'del = (\i m -> { m | '.$l->{id}.' = '.($l->{multi} ? "delidx i m.$l->{id}" : $l->{default}).' })', - 'add = (\v m -> { m | '.$l->{id}.' = '.($l->{multi} ? "m.$l->{id} ++ [$addval]" : $addval).' })', - 'patt = ['.join(', ', map string($_), $l->{pattern}->@*).']' + 'advid = '.string($l->{id} =~ s/^l_//r), )."\n }"; } @links; } - links release => 'GRE.RecvExtlinks' => VNDB::ExtLinks::extlinks_sites('r'); + links release => VNDB::ExtLinks::extlinks_sites('r'); + links staff => VNDB::ExtLinks::extlinks_sites('s'); write_module ExtLinks => $data; } if(tuwf->{elmgen}) { - mkdir config->{root}.'/elm/Gen'; write_api; write_types; write_extlinks; - open my $F, '>', config->{root}.'/elm/Gen/.generated'; + open my $F, '>', config->{gen_path}.'/elm/Gen/.generated'; print $F scalar gmtime; } |