Failing tests for parseRuleSets.

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)

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 $
+  [ "<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>"