Skip to content
Snippets Groups Projects
Commit 515dae1c authored by stuebinm's avatar stuebinm
Browse files
The script inject doesn't do anything for now; guess I'll re-add that
once we actually have a URI for that.
parent 668daf92
Branches
No related tags found
No related merge requests found
...@@ -12,6 +12,7 @@ module Properties (checkMap, checkTileset, checkLayer) where ...@@ -12,6 +12,7 @@ module Properties (checkMap, checkTileset, checkLayer) where
import Control.Monad (forM_, unless, when) import Control.Monad (forM_, unless, when)
import Data.Text (Text, intercalate, isPrefixOf) import Data.Text (Text, intercalate, isPrefixOf)
import qualified Data.Text as T
import qualified Data.Vector as V import qualified Data.Vector as V
import Tiled (Layer (..), Object (..), Property (..), import Tiled (Layer (..), Object (..), Property (..),
PropertyValue (..), Tile (..), Tiledmap (..), PropertyValue (..), Tile (..), Tiledmap (..),
...@@ -83,28 +84,22 @@ checkMap = do ...@@ -83,28 +84,22 @@ checkMap = do
-- | Checks a single property of a map. -- | Checks a single property of a map.
--
-- 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 -> LintWriter Tiledmap
checkMapProperty p@(Property name _) = case name of checkMapProperty p@(Property name _) = 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
-- TODO: perhaps include an explanation in the lint, or allow
-- exactly that one value?
lintConfig configAllowScripts >>= \case
False -> forbid "cannot use property \"script\"; custom scripts are disallowed"
True -> pure ()
lintConfig configScriptInject >>= \case
Nothing -> pure ()
Just url -> setProperty "script" url
"mapName" -> naiveEscapeProperty p "mapName" -> naiveEscapeProperty p
"mapDescription" -> naiveEscapeProperty p "mapDescription" -> naiveEscapeProperty p
"mapCopyright" -> naiveEscapeProperty p "mapCopyright" -> naiveEscapeProperty p
"mapLink" -> pure () "mapLink" -> pure ()
"mapImage" -> pure () "mapImage" -> pure ()
_ -> complain $ "unknown map property " <> prettyprint name -- usually the linter will complain if names aren't in their
-- "canonical" form, but allowing that here so that multiple
-- scripts can be used by one map
_ | T.toLower name == "script" ->
unwrapString p $ \str ->
unless ("https://static.rc3.world/scripts" `isPrefixOf` str)
$ forbid "only scripts hosted on static.rc3.world are allowed."
| otherwise
-> complain $ "unknown map property " <> prettyprint name
-- | check an embedded tile set. -- | check an embedded tile set.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment