diff options
| -rw-r--r-- | lib/Paths.hs | 10 | ||||
| -rw-r--r-- | lib/Properties.hs | 2 | ||||
| -rw-r--r-- | lib/Uris.hs | 6 |
3 files changed, 15 insertions, 3 deletions
diff --git a/lib/Paths.hs b/lib/Paths.hs index f72874f..d2861eb 100644 --- a/lib/Paths.hs +++ b/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 diff --git a/lib/Properties.hs b/lib/Properties.hs index 25bbbd3..551c502 100644 --- a/lib/Properties.hs +++ b/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 diff --git a/lib/Uris.hs b/lib/Uris.hs index 5ad9180..e2d9a5f 100644 --- a/lib/Uris.hs +++ b/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 |