From 515dae1ccc3f2e6cfffa5b953fdde13f7eb196a9 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Tue, 14 Dec 2021 19:50:43 +0100
Subject: 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.
---
 lib/Properties.hs | 25 ++++++++++---------------
 1 file 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.
-- 
cgit v1.2.3