diff options
| -rw-r--r-- | lib/Properties.hs | 25 |
1 files changed, 10 insertions, 15 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs index cabc2b7..b27cce1 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -12,6 +12,7 @@ module Properties (checkMap, checkTileset, checkLayer) where import Control.Monad (forM_, unless, when) import Data.Text (Text, intercalate, isPrefixOf) +import qualified Data.Text as T import qualified Data.Vector as V import Tiled (Layer (..), Object (..), Property (..), PropertyValue (..), Tile (..), Tiledmap (..), @@ -83,28 +84,22 @@ checkMap = do -- | 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 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 "mapDescription" -> naiveEscapeProperty p "mapCopyright" -> naiveEscapeProperty p "mapLink" -> 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. |