diff --git a/src/Data/HTTPSEverywhere/Rules/Internal.hs b/src/Data/HTTPSEverywhere/Rules/Internal.hs index 5c6c25b..632cbee 100644 --- a/src/Data/HTTPSEverywhere/Rules/Internal.hs +++ b/src/Data/HTTPSEverywhere/Rules/Internal.hs @@ -1,8 +1,15 @@ +{-# LANGUAGE CPP #-} + module Data.HTTPSEverywhere.Rules.Internal ( getRulesetsMatching, havingRulesThatTrigger, havingCookieRulesThatTrigger, - setSecureFlag + setSecureFlag, +#ifdef TEST + hasTargetMatching, + hasTriggeringRuleOn, + hasExclusionMatching +#endif ) where import Prelude hiding (readFile, filter) diff --git a/test/Data/HTTPSEverywhere/Rules/Internal/ParserSpec.hs b/test/Data/HTTPSEverywhere/Rules/Internal/ParserSpec.hs index efa560d..3aeb1be 100644 --- a/test/Data/HTTPSEverywhere/Rules/Internal/ParserSpec.hs +++ b/test/Data/HTTPSEverywhere/Rules/Internal/ParserSpec.hs @@ -1,20 +1,24 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Data.HTTPSEverywhere.Rules.Internal.ParserSpec ( spec ) where -import Data.HTTPSEverywhere.Rules.Internal.Parser (parseTarget) -import Data.HTTPSEverywhere.Rules.Internal.Types (Target(..)) -import Data.Maybe (fromJust) +import Prelude hiding (unlines) +import Data.HTTPSEverywhere.Rules.Internal.Parser (parseTarget, parseRuleSets) +import Data.HTTPSEverywhere.Rules.Internal (hasTargetMatching, hasExclusionMatching, hasTriggeringRuleOn) +import Data.HTTPSEverywhere.Rules.Internal.Types (Target(..), RuleSet(..)) +import Data.Maybe (fromJust, isJust) +import Data.Text.Lazy (Text, unlines) import Network.URI (parseURI) -import Test.Hspec (Spec, describe, it, shouldBe) +import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) spec :: Spec spec = do + let unsafeParseURL = fromJust . parseURI describe "parseTarget" $ do - let checkTarget = \target domain -> ($ domain) . getTarget $ parseTarget target - unsafeParseURL = fromJust . parseURI + let checkTarget = \target domain -> ($ domain) . getTarget $ parseTarget target it "*.facebook.com should match s-static.ak.facebook.com" $ do let url = unsafeParseURL "http://s-static.ak.facebook.com" checkTarget "*.facebook.com" url `shouldBe` True @@ -24,3 +28,44 @@ spec = do it "*.google.* should not match google.com.id" $ do let url = unsafeParseURL "http://google.com.id" checkTarget "*.google.*" url `shouldBe` False + describe "parseRuleSets" $ do + let rulesets = parseRuleSets fixture + it "Should parse a ruleset out of the EFF fixture." $ do + rulesets `shouldSatisfy` not . null + let effRuleSet = head rulesets + it "Should parse out the name of the EFF fixture." $ do + ruleSetName effRuleSet `shouldBe` "EFF" + it "Should parse out two targets from the EFF fixture." $ do + length (ruleSetTargets effRuleSet) `shouldBe` 2 + it "Should parse out two rules from the EFF fixture." $ do + length (ruleSetRules effRuleSet) `shouldBe` 2 + it "Should parse out one exclusion from the EFF fixture." $ do + length (ruleSetExclusions effRuleSet) `shouldBe` 1 + + -- BE WARY: the succeeding may fail due to bugs in the parent module, which + -- has no tests yet. + + it "A target in the EFF fixture should match eff.org" $ do + let url = unsafeParseURL "http://eff.org/thing" + effRuleSet `hasTargetMatching` url `shouldBe` True + it "A rule in the EFF fixture should trigger on eff.org" $ do + let url = unsafeParseURL "http://eff.org/thing" + effRuleSet `hasTriggeringRuleOn` url `shouldSatisfy` isJust + it "An exclusion in the EFF fixture should trigger on action.eff.org" $ do + let url = unsafeParseURL "http://action.eff.org/thing" + effRuleSet `hasExclusionMatching` url `shouldBe` True + +fixture :: Text +fixture = unlines $ + [ "" + , " " + , " " + , "" + , " " + , " " + , " " + , "" + ] + +instance Show RuleSet where + show _ = ""