collecting map dependencies

1 files changed, 22 insertions, 8 deletions

diff --git a/lib/Properties.hs b/lib/Properties.hs
index 7d6fc4a..ebd34bb 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -6,14 +6,14 @@ module Properties (checkProperty) where
 
 
 import           Control.Monad (unless)
-import           Data.Text     (Text)
+import           Data.Text     (Text, isPrefixOf)
 import           Tiled2        (Layer (layerProperties), Property, propertyName,
                                 propertyValue)
 import           Util          (prettyprint)
 
-import           LintWriter    (LintWriter, complain, forbid, info, require,
+import           LintWriter    (LintWriter, complain, dependsOn, forbid, info,
                                 suggest, warn)
-
+import           Types
 -- | the point of this module
 --
 -- given a property, check if it is valid. It gets a reference
@@ -37,27 +37,37 @@ checkProperty layer prop = case propName of
     "jitsiConfig" -> isForbidden
     "jitsiClientConfig" -> isForbidden
     "jitsiRoomAdminTag" -> isForbidden
-    "playAudio" -> do
-      -- TODO: check for url validity?
-      pure ()
+    "playAudio" ->
+      forbidHTTPAndThen $ dependsOn $ if "https://" `isPrefixOf` propValue
+        then Link propValue
+        else Local propValue
     "audioLoop" ->
       requireProperty "playAudio"
     "audioVolume" ->
       requireProperty "playAudio"
     "openWebsite" -> do
       suggestPropertyValue "openWebsiteTrigger" "onaction"
-      require $ propertyValue prop
+      if "http://" `isPrefixOf` propValue
+        then complain "cannot load content over http into map, please use https or include your assets locally"
+        else dependsOn $
+          if "https://" `isPrefixOf` propValue
+          then Link propValue
+          else Local propValue
     "openWebsiteTrigger" ->
       requireProperty "openWebsite"
     "openWebsitePolicy" ->
       requireProperty "openWebsite"
-    "exitUrl" -> pure ()
+    "exitUrl" ->
+      forbidHTTPAndThen $ dependsOn $ if "https://" `isPrefixOf` propValue
+        then MapLink propValue
+        else LocalMap propValue
     "startLayer" -> pure ()
       -- could also make this a "hard error" (i.e. Left), but then it
       -- stops checking other properties as checkLayer short-circuits.
     _ -> warn $ "unknown property type " <> prettyprint propName
     where
       propName = propertyName prop
+      propValue = propertyValue prop
       -- | require some property in this layer
       requireProperty name = unless (hasProperty name layer)
         $ complain $ "property "<>prettyprint name<>" requires property "<>prettyprint propName
@@ -67,6 +77,10 @@ checkProperty layer prop = case propName of
       suggestPropertyValue :: Text -> Text -> LintWriter ()
       suggestPropertyValue name value = unless (hasProperty name layer)
         $ suggest $ "set property " <> prettyprint name <> " to " <> prettyprint value
+      forbidHTTPAndThen :: LintWriter () -> LintWriter ()
+      forbidHTTPAndThen andthen = if "http://" `isPrefixOf` propValue
+        then complain "cannot access content via http; either use https or include it locally instead."
+        else andthen