summaryrefslogtreecommitdiff
path: root/lib/Properties.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Properties.hs')
-rw-r--r--lib/Properties.hs17
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)