special handling of world:// and assembly names

these now have their own top-level config attribute which is essentially a
shorthand for setting one that's deeper nested.

1 files changed, 18 insertions, 1 deletions

diff --git a/lib/LintConfig.hs b/lib/LintConfig.hs
index f540ae1..b6e6080 100644
--- a/lib/LintConfig.hs
+++ b/lib/LintConfig.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE StandaloneDeriving    #-}
@@ -17,11 +18,13 @@ import           Data.Aeson             (FromJSON (parseJSON), Options (..),
 import           Data.Aeson.Types       (genericParseJSON)
 import qualified Data.ByteString.Char8  as C8
 import qualified Data.ByteString.Lazy   as LB
+import qualified Data.Map.Strict        as M
 import           Data.Text              (Text)
 import           GHC.Generics           (Generic (Rep, from, to), K1 (..),
                                          M1 (..), (:*:) (..))
 import           Types                  (Level)
-import           Uris                   (SchemaSet)
+import           Uris                   (SchemaSet,
+                                         Substitution (DomainSubstitution))
 import           WithCli                (Proxy (..))
 import           WithCli.Pure           (Argument (argumentType, parseArgument))
 
@@ -34,6 +37,8 @@ data LintConfig f = LintConfig
   -- ^ Link to Script that should be injected
   , configAssemblyTag    :: HKD f Text
   -- ^ Assembly name (used for jitsiRoomAdminTag)
+  , configAssemblies     :: HKD f [Text]
+  -- ^ list of all assembly slugs (used to lint e.g. world:// links)
   , configMaxLintLevel   :: HKD f Level
   -- ^ Maximum warn level allowed before the lint fails
   , configDontCopyAssets :: HKD f Bool
@@ -123,6 +128,18 @@ patch ::
   -> f Identity
 patch x y = to (gappend (from x) (from y))
 
+patchConfig :: LintConfig Identity -> Maybe (LintConfig Maybe) -> LintConfig Identity
+patchConfig config p = config'
+  { configUriSchemas = M.adjust assemblysubst "world" $ configUriSchemas config'}
+  where config' = case p of
+          Just p  -> patch config p
+          Nothing -> config
+        assemblysubst = \case
+          DomainSubstitution subst scope ->
+            DomainSubstitution (subst <> M.fromList generated) scope
+            where generated = (\slug -> (slug, "/@/"<>slug)) <$> configAssemblies config'
+          other -> other
+
 instance (FromJSON (LintConfig a)) => Argument (LintConfig a) where
   parseArgument str =
     case eitherDecode (LB.fromStrict $ C8.pack str) of