diff options
Diffstat (limited to 'lib/Properties.hs')
-rw-r--r-- | lib/Properties.hs | 17 |
1 files changed, 11 insertions, 6 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs index 7772c26..f78ceff 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -68,7 +68,7 @@ checkMap = do -- Doesn't really do all that much, but could in theory be expanded into a -- longer function same as checkLayerProperty. checkMapProperty :: Property -> LintWriter Tiledmap -checkMapProperty (Property name _value) = case name of +checkMapProperty p@(Property name _value) = case name of "script" -> do -- this is kind of stupid, since if we also inject script this -- will be overriden anyways, but it also doesn't really hurt I guess @@ -80,11 +80,11 @@ checkMapProperty (Property name _value) = case name of lintConfig configScriptInject >>= \case Nothing -> pure () Just url -> setProperty "script" url - "mapName" -> pure () + "mapName" -> naiveEscapeProperty p "mapLink" -> pure () "mapImage" -> pure () - "mapDescription" -> pure () - "mapCopyright" -> pure () + "mapDescription" -> naiveEscapeProperty p + "mapCopyright" -> naiveEscapeProperty p _ -> complain $ "unknown map property " <> prettyprint name where @@ -118,8 +118,8 @@ checkTileset = do mapM_ checkTilesetProperty (fromMaybe [] $ tilesetProperties tileset) checkTilesetProperty :: Property -> LintWriter Tileset -checkTilesetProperty (Property name _value) = case name of - "copyright" -> pure () -- only allow some licenses? +checkTilesetProperty p@(Property name _value) = case name of + "copyright" -> naiveEscapeProperty p _ -> pure () -- are there any other properties? @@ -182,6 +182,7 @@ checkLayerProperty p@(Property name _value) = case name of (\link -> do dependsOn (Link link) setProperty "openWebsite" link + setProperty "silent" (BoolProp True) setProperty "openWebsitePolicy" ("fullscreen;camera;microphone;display-capture" :: Text) ) @@ -400,3 +401,7 @@ unwrapURI sym p@(Property name _) f g = unwrapLink p $ \link -> do "the URI schema " <> schema <> ":// does not exist." WrongScope schema -> "the URI schema " <> schema <> ":// cannot be used on \""<>name<>"\"." + +naiveEscapeProperty :: HasProperties a => Property -> LintWriter a +naiveEscapeProperty prop@(Property name _) = + unwrapString prop (setProperty name . naiveEscapeHTML) |