Merge branch 'main' into extended-scripts

lib/Paths.hs

@@ -20,12 +20,18 @@ data RelPath = Path Int Text (Maybe Text)
 
 
 
-data PathResult = OkRelPath RelPath | AbsolutePath | NotAPath | UnderscoreMapLink | AtMapLink
+data PathResult = OkRelPath RelPath
+  | AbsolutePath
+  | NotAPath
+  | UnderscoreMapLink
+  | AtMapLink
+  | PathVarsDisallowed
 
 -- | horrible regex parsing for filepaths that is hopefully kinda safe
 parsePath :: Text -> PathResult
 parsePath text =
-  if | rest =~ ("^([^/]*[^\\./]/)*[^/]*[^\\./]$" :: Text) -> OkRelPath (Path up path fragment)
+  if | text =~ ("{{{.*}}}" :: Text) -> PathVarsDisallowed
+     | rest =~ ("^([^/]*[^\\./]/)*[^/]*[^\\./]$" :: Text) -> OkRelPath (Path up path fragment)
      | "/_/" `isPrefixOf` text ->  UnderscoreMapLink
      | "/@/" `isPrefixOf` text ->  AtMapLink
      | "/" `isPrefixOf` text ->  AbsolutePath

lib/Properties.hs

@@ -673,6 +673,7 @@ unwrapPath str f = case parsePath str of
   AbsolutePath -> forbid "absolute paths are disallowed. Use world:// instead."
   UnderscoreMapLink -> forbid "map links using /_/ are disallowed. Use world:// instead."
   AtMapLink -> forbid "map links using /@/ are disallowed. Use world:// instead."
+  PathVarsDisallowed -> forbid "extended API variables are not allowed in asset paths."
 
 unwrapBadgeToken :: Text -> (BadgeToken -> LintWriter a) -> LintWriter a
 unwrapBadgeToken str f = case parseToken str of
@@ -700,6 +701,7 @@ unwrapURI sym p@(Property name _) f g = unwrapString p $ \link -> do
         \\"" <> name <> "\"; allowed "
         <> (if length allowed == 1 then "is " else "are ")
         <> intercalate ", " (fmap (<> "://") allowed) <> "."
+      VarsDisallowed -> "extended API links are disallowed in links"
 
 -- | just asserts that this is a string
 isString :: Property -> LintWriter a

lib/Uris.hs

@@ -9,7 +9,7 @@ module Uris where
 
 
 
-import           Control.Monad           (unless)
+import           Control.Monad           (unless, when)
 import           Data.Aeson              (FromJSON (..), Options (..),
                                           SumEncoding (UntaggedValue),
                                           defaultOptions, genericParseJSON)
@@ -58,6 +58,7 @@ data SubstError =
   | IsBlocked
   | DomainDoesNotExist Text
   | WrongScope Text [Text]
+  | VarsDisallowed
   -- ^ This link's schema exists, but cannot be used in this scope.
   -- The second field contains a list of schemas that may be used instead.
 
@@ -65,7 +66,10 @@ data SubstError =
 applySubst :: KnownSymbol s
   => Proxy s -> SchemaSet -> Text -> Either SubstError Text
 applySubst s substs uri =  do
+  when (uri =~ "{{{.*}}}")
+   $ Left VarsDisallowed
   (schema, domain, rest) <- note NotALink $ parseUri uri
+
   rules <- note (SchemaDoesNotExist schema) ( M.lookup schema substs)
   unless (symbolVal s `elem` scope rules)
         $ Left (WrongScope schema