remove leftover rc3 things & some new stuff

this removes:
 - the bbb properties
 - all explicit mentions of rc3
 - the weird script domain hacks (done via a substitution now)
 - some (few) of the weirder code choices

it also adds some more type level witchery to deal with configs, which
for some reason seems to be the hardest problem of this entire program …

also the server now does inter-assembly dependency checking!

1 files changed, 28 insertions, 40 deletions

diff --git a/lib/Properties.hs b/lib/Properties.hs
index 63cea1f..b937534 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -15,7 +15,7 @@ module Properties (checkMap, checkTileset, checkLayer) where
 
 import           Universum           hiding (intercalate, isPrefixOf)
 
-import           Data.Text           (intercalate, isInfixOf, isPrefixOf)
+import           Data.Text           (intercalate, isPrefixOf)
 import qualified Data.Text           as T
 import           Data.Tiled          (Layer (..), Object (..), Property (..),
                                       PropertyValue (..), Tile (..),
@@ -42,8 +42,7 @@ import           LintWriter          (LintWriter, adjust, askContext,
 import           Paths               (PathResult (..), RelPath (..),
                                       getExtension, isOldStyle, parsePath)
 import           Types               (Dep (Link, Local, LocalMap, MapLink))
-import           Uris                (SubstError (..), applySubsts,
-                                      extractDomain, parseUri)
+import           Uris                (SubstError (..), applySubsts)
 
 
 
@@ -140,12 +139,9 @@ checkMapProperty p@(Property name _) = case name of
   -- "canonical" form, but allowing that here so that multiple
   -- scripts can be used by one map
   _ | T.toLower name == "script" ->
-      unwrapString p $ \str ->
-        unless (checkIsRc3Url str &&
-                not ( "/../" `isInfixOf` str) &&
-                not ( "%" `isInfixOf` str) &&
-                not ( "@" `isInfixOf` str))
-        $ forbid "only scripts hosted on static.rc3.world are allowed."
+      unwrapURI (Proxy @"script") p
+       (dependsOn . Link)
+       (const $ forbid "scripts loaded from local files are disallowed")
     | name `elem` ["jitsiRoom", "playAudio", "openWebsite"
                   , "url", "exitUrl", "silent", "getBadge"]
           -> complain $ "property " <> name
@@ -342,11 +338,6 @@ checkObjectGroupProperty (Property name _) = case name of
                        \not the object layer."
   _ -> warn $ "unknown property " <> prettyprint name <> " for objectgroup layers"
 
-checkIsRc3Url :: Text -> Bool
-checkIsRc3Url text= case extractDomain text of
-    Nothing -> False
-    Just domain -> do
-      domain == "https://static.rc3.world"
 
 
 -- | Checks a single (custom) property of a "normal" tile layer
@@ -405,7 +396,8 @@ checkTileThing removeExits p@(Property name _value) = case name of
         unwrapURI (Proxy @"map") p
           (\link -> do
               assemblyslug <- lintConfig configAssemblyTag
-              case T.stripPrefix ("/@/rc3_21/"<>assemblyslug<>"/") link of
+              eventslug <- lintConfig configEventSlug
+              case T.stripPrefix ("/@/"<>eventslug<>"/"<>assemblyslug<>"/") link of
                 Nothing -> do
                   dependsOn (MapLink link)
                   setProperty "exitUrl" link
@@ -424,8 +416,8 @@ checkTileThing removeExits p@(Property name _value) = case name of
             let ext = getExtension path in
             if | isOldStyle path ->
                  complain "Old-Style inter-repository links (using {<placeholder>}) \
-                          \cannot be used at rC3 2021; please use world:// instead \
-                          \(see howto.rc3.world)."
+                          \cannot be used at divoc bb3; please use world:// instead \
+                          \(see https://di.c3voc.de/howto:world)."
                | ext == "tmx" ->
                    complain "Cannot use .tmx map format; use Tiled's json export instead."
                | ext /= "json" ->
@@ -471,22 +463,21 @@ checkTileThing removeExits p@(Property name _value) = case name of
                               , "jitsiroomadmintag", "jitsiinterfaceconfig"
                               , "openwebsitepolicy", "allowapi" ]
         -> forbidProperty name
-        -- the openWebsite Api can only be allowed if the website is on static.rc3.world
-      | T.toLower name == "openwebsiteallowapi"
-        -> do
-          properties <- askContext <&> getProperties
-          unless (all (\(Property name value) -> case value of
-                          StrProp str -> name /= "openWebsite" || checkIsRc3Url str
-                          _ -> True
-                      ) properties)
-            $ complain "\"openWebsiteAllowApi\" can only be used with websites hosted \
-                       \on https://static.rc3.world"
       | name `elem` [ "openWebsite", "openTab" ] -> do
           uselessEmptyLayer
-          suggestProperty $ Property "openWebsiteTrigger" (StrProp "onaction")
-          unwrapURI (Proxy @"website") p
-            (dependsOn . Link)
-            (const $ forbid "accessing local html files is disallowed.")
+          suggestProperty $ Property "openWebsiteTrigger" "onaction"
+
+          properties <- askContext <&> getProperties
+          let isScript = any (\(Property name _) ->
+                                T.toLower name == "openwebsiteallowapi")
+                          properties
+          if isScript
+            then unwrapURI (Proxy @"script") p
+              (dependsOn . Link)
+              (const $ forbid "accessing local html files is disallowed")
+            else unwrapURI (Proxy @"website") p
+              (dependsOn . Link)
+              (const $ forbid "accessing local html files is disallowed.")
       | otherwise ->
         when (not removeExits || name `notElem` [ "collides", "name", "tilesetCopyright" ]) $ do
           warnUnknown p knownTileLayerProperites
@@ -634,11 +625,6 @@ setProperty name value = adjust $ \ctxt ->
   $ \ps -> Just $ Property name (asProperty value) : filter sameName ps
   where sameName (Property name' _) = name /= name'
 
-removeProperty :: HasProperties ctxt => Text -> LintWriter ctxt
-removeProperty name = adjust $ \ctxt ->
-  flip adjustProperties ctxt
-  $ \ps -> Just $ filter (\(Property name' _) -> name' /= name) ps
-
 naiveEscapeProperty :: HasProperties a =>  Property -> LintWriter a
 naiveEscapeProperty prop@(Property name _) =
   unwrapString prop (setProperty name . naiveEscapeHTML)
@@ -691,7 +677,9 @@ unwrapBadgeToken str f = case parseToken str of
   Nothing -> complain "invalid badge token."
 
 
--- | unwraps a URI
+-- | unwraps a link, giving two  cases:
+--   - the link might be an (allowed) remote URI
+--   - the link might be relative to this map (i.e. just a filepath)
 unwrapURI :: (KnownSymbol s, HasProperties a)
   => Proxy s
   -> Property
@@ -715,12 +703,12 @@ unwrapURI sym p@(Property name _) f g = unwrapString p $ \link -> do
         DomainDoesNotExist domain -> "The domain " <> domain <> " does not exist; \
                                      \please make sure it is spelled correctly."
         SchemaDoesNotExist schema ->
-          "the URI schema " <> schema <> ":// cannot be used."
+          "the URI schema " <> schema <> "// cannot be used."
         WrongScope schema allowed ->
-          "the URI schema " <> schema <> ":// cannot be used in property \
+          "the URI schema " <> schema <> "// cannot be used in property \
           \\"" <> name <> "\"; allowed "
           <> (if length allowed == 1 then "is " else "are ")
-          <> intercalate ", " (fmap (<> "://") allowed) <> "."
+          <> intercalate ", " (map (<> "//") allowed) <> "."
         VarsDisallowed -> "extended API links are disallowed in links"