summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--config.json23
-rw-r--r--lib/Uris.hs15
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