diff options
| -rw-r--r-- | config.json | 23 | ||||
| -rw-r--r-- | lib/Uris.hs | 15 |
2 files changed, 15 insertions, 23 deletions
diff --git a/config.json b/config.json index 9db5342..1ccb0a5 100644 --- a/config.json +++ b/config.json @@ -3,23 +3,16 @@ "Assemblies":[], "ScriptInject":null, "AllowScripts":false, - "MaxLintLevel":"Warning", + "MaxLintLevel":"Fatal", "DontCopyAssets":false, - "UriSchemas": [ - ["https", { - "scope" : ["website"], - "allowed" : ["media.ccc.de", "streaming.media.ccc.de", "static.rc3.world", "cdn.c3voc.de", "pretalx.c3voc.de"], - "blocked" : ["blocked.com"], - "prefix" : "https:\/\/rc3.world\/2021\/wa_dereferrer\/" - }], - ["https", { - "scope" : ["audio"], - "allowed" : ["cdn.c3voc.de", "media.ccc.de", "streaming.media.ccc.de", "static.rc3.world", "live.dort.c3voc.de"] - }], - ["world", { + "UriSchemas": { + "world": { "scope" : ["map"], "substs" : { } - }] - ] + }, + "https": { + "scope" : [ "website", "audio" ] + } + } } diff --git a/lib/Uris.hs b/lib/Uris.hs index a8c7068..596c272 100644 --- a/lib/Uris.hs +++ b/lib/Uris.hs @@ -23,6 +23,7 @@ data Substitution = Prefixed { prefix :: Text, blocked :: [Text], allowed :: [Text], scope :: [String] } | DomainSubstitution { substs :: Map Text Text, scope :: [String] } | Allowed { scope :: [String], allowed :: [Text] } + | Unrestricted { scope :: [String] } deriving (Generic, Show) @@ -32,7 +33,7 @@ instance FromJSON Substitution where , rejectUnknownFields = True } -type SchemaSet = [(Text, Substitution)] +type SchemaSet = Map Text Substitution extractDomain :: Text -> Maybe Text @@ -78,20 +79,17 @@ applySubsts s substs uri = do $ Left VarsDisallowed parts@(schema, _, _) <- note NotALink $ parseUri uri - let rules = filter ((==) schema . fst) substs + let rule = M.lookup schema substs - case nonEmpty (map (applySubst parts . snd) rules) of + case map (applySubst parts) rule of Nothing -> Left (SchemaDoesNotExist schema) - Just results -> case rights (toList results) of - suc:_ -> Right suc - _ -> minimum results - + Just result -> result where note = maybeToRight applySubst (schema, domain, rest) rule = do unless (symbolVal s `elem` scope rule) $ Left (WrongScope schema - (fmap fst . filter (elem (symbolVal s) . scope . snd) $ substs)) + (map fst . filter (elem (symbolVal s) . scope . snd) $ toPairs substs)) case rule of DomainSubstitution table _ -> do prefix <- note (DomainDoesNotExist (schema <> toText "://" <> domain)) @@ -105,3 +103,4 @@ applySubsts s substs uri = do || toText "streamproxy.rc3.world" `T.isSuffixOf` domain then Right uri else Left (DomainIsBlocked domains) + Unrestricted _ -> Right uri |