summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorstuebinm2021-12-14 19:50:43 +0100
committerstuebinm2021-12-14 19:50:43 +0100
commit515dae1ccc3f2e6cfffa5b953fdde13f7eb196a9 (patch)
tree7eb5664b6e9dfc344f5eb612b32749d3cf6c9483 /lib
parent668daf92d3b1c32aaf2c64a8f8e162c485bd5efc (diff)
allow scripts from https://static.rc3.world/scripts
The script inject doesn't do anything for now; guess I'll re-add that once we actually have a URI for that.
Diffstat (limited to 'lib')
-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.