From ccb57f9a16b47aab55f786b976b0b8e89ff49f36 Mon Sep 17 00:00:00 2001 From: stuebinm Date: Sat, 18 Sep 2021 23:21:15 +0200 Subject: collecting map dependencies --- lib/Properties.hs | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) (limited to 'lib/Properties.hs') 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 -- cgit v1.2.3