summaryrefslogtreecommitdiff
path: root/lib/Properties.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Properties.hs')
-rw-r--r--lib/Properties.hs18
1 files changed, 14 insertions, 4 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 74fd72a..3169e4d 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -20,7 +20,7 @@ import LintConfig (LintConfig (..))
import LintWriter (LintWriter, adjust, askContext, askFileDepth,
complain, dependsOn, forbid, lintConfig,
offersEntrypoint, suggest, warn)
-import Paths (RelPath (..), parsePath)
+import Paths (RelPath (..), parsePath, extractDomain)
import Types (Dep (Link, Local, LocalMap, MapLink))
@@ -174,9 +174,19 @@ checkLayerProperty p@(Property name _value) = case name of
suggestProperty $ Property "openWebsiteTrigger" (StrProp "onaction")
unwrapLink p $ \link -> if "https://" `isPrefixOf` link
then do
- dependsOn $ Link link
- prefix <- lintConfig configLinkPrefix
- setProperty "openWebsite" (prefix <> link)
+ config <- lintConfig id
+ case extractDomain link of
+ Just domain
+ | domain `elem` configBlockedDomains config
+ -> complain $ "domain " <> domain <> " is blocked."
+ | domain `elem` configAllowedDomains config
+ -> dependsOn $ Link link
+ | otherwise
+ -> do
+ dependsOn $ Link link
+ prefix <- lintConfig configLinkPrefix
+ setProperty "openWebsite" (prefix <> link)
+ Nothing -> complain "invalid link?"
else unwrapPath link (dependsOn . Local)
"openWebsiteTrigger" -> do
isString p