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