Failing tests for parseRuleSets.
parent
49be7aa1a0
commit
8ec3419492
|
@ -1,8 +1,15 @@
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
module Data.HTTPSEverywhere.Rules.Internal (
|
module Data.HTTPSEverywhere.Rules.Internal (
|
||||||
getRulesetsMatching,
|
getRulesetsMatching,
|
||||||
havingRulesThatTrigger,
|
havingRulesThatTrigger,
|
||||||
havingCookieRulesThatTrigger,
|
havingCookieRulesThatTrigger,
|
||||||
setSecureFlag
|
setSecureFlag,
|
||||||
|
#ifdef TEST
|
||||||
|
hasTargetMatching,
|
||||||
|
hasTriggeringRuleOn,
|
||||||
|
hasExclusionMatching
|
||||||
|
#endif
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Prelude hiding (readFile, filter)
|
import Prelude hiding (readFile, filter)
|
||||||
|
|
|
@ -1,20 +1,24 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
|
|
||||||
module Data.HTTPSEverywhere.Rules.Internal.ParserSpec (
|
module Data.HTTPSEverywhere.Rules.Internal.ParserSpec (
|
||||||
spec
|
spec
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.HTTPSEverywhere.Rules.Internal.Parser (parseTarget)
|
import Prelude hiding (unlines)
|
||||||
import Data.HTTPSEverywhere.Rules.Internal.Types (Target(..))
|
import Data.HTTPSEverywhere.Rules.Internal.Parser (parseTarget, parseRuleSets)
|
||||||
import Data.Maybe (fromJust)
|
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 Network.URI (parseURI)
|
||||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
|
let unsafeParseURL = fromJust . parseURI
|
||||||
describe "parseTarget" $ do
|
describe "parseTarget" $ do
|
||||||
let checkTarget = \target domain -> ($ domain) . getTarget $ parseTarget target
|
let checkTarget = \target domain -> ($ domain) . getTarget $ parseTarget target
|
||||||
unsafeParseURL = fromJust . parseURI
|
|
||||||
it "*.facebook.com should match s-static.ak.facebook.com" $ do
|
it "*.facebook.com should match s-static.ak.facebook.com" $ do
|
||||||
let url = unsafeParseURL "http://s-static.ak.facebook.com"
|
let url = unsafeParseURL "http://s-static.ak.facebook.com"
|
||||||
checkTarget "*.facebook.com" url `shouldBe` True
|
checkTarget "*.facebook.com" url `shouldBe` True
|
||||||
|
@ -24,3 +28,44 @@ spec = do
|
||||||
it "*.google.* should not match google.com.id" $ do
|
it "*.google.* should not match google.com.id" $ do
|
||||||
let url = unsafeParseURL "http://google.com.id"
|
let url = unsafeParseURL "http://google.com.id"
|
||||||
checkTarget "*.google.*" url `shouldBe` False
|
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 $
|
||||||
|
[ "<ruleset name=\"EFF\">"
|
||||||
|
, " <target host=\"eff.org\" />"
|
||||||
|
, " <target host=\"*.eff.org\" />"
|
||||||
|
, ""
|
||||||
|
, " <exclusion pattern=\"^http://action\\.eff\\.org/\"/>"
|
||||||
|
, " <rule from=\"^http://eff\\.org/\" to=\"https://eff.org/\"/>"
|
||||||
|
, " <rule from=\"^http://([^/:@]*)\\.eff\\.org/\" to=\"https://$1.eff.org/\"/>"
|
||||||
|
, "</ruleset>"
|
||||||
|
]
|
||||||
|
|
||||||
|
instance Show RuleSet where
|
||||||
|
show _ = "<RuleSet>"
|
||||||
|
|
Loading…
Reference in New Issue