Cull tests against volatile interfaces.
This commit is contained in:
parent
b93ff6bbb6
commit
0ec419feca
|
@ -658,19 +658,9 @@ test-suite spec
|
||||||
attoparsec,
|
attoparsec,
|
||||||
directory,
|
directory,
|
||||||
errors,
|
errors,
|
||||||
filepath,
|
|
||||||
hspec,
|
hspec,
|
||||||
http-client,
|
|
||||||
lens,
|
|
||||||
mtl,
|
|
||||||
network,
|
|
||||||
network-uri,
|
|
||||||
pipes,
|
|
||||||
string-conversions,
|
|
||||||
taggy-lens,
|
|
||||||
text,
|
text,
|
||||||
text-icu,
|
text-icu
|
||||||
https-everywhere-rules
|
|
||||||
main-is:
|
main-is:
|
||||||
Spec.hs
|
Spec.hs
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
|
@ -683,12 +673,6 @@ test-suite spec
|
||||||
ghc-options:
|
ghc-options:
|
||||||
-Wall
|
-Wall
|
||||||
other-modules:
|
other-modules:
|
||||||
Data.HTTPSEverywhere.Rules.Internal,
|
|
||||||
Data.HTTPSEverywhere.Rules.Internal.Parser,
|
|
||||||
Data.HTTPSEverywhere.Rules.Internal.ParserSpec,
|
|
||||||
Data.HTTPSEverywhere.Rules.Internal.Raw,
|
|
||||||
Data.HTTPSEverywhere.Rules.Internal.Types,
|
|
||||||
Data.HTTPSEverywhere.Rules.InternalSpec,
|
|
||||||
Data.Text.ICU.Extras,
|
Data.Text.ICU.Extras,
|
||||||
Data.Text.ICU.ExtrasSpec
|
Data.Text.ICU.ExtrasSpec
|
||||||
|
|
||||||
|
|
|
@ -1,72 +0,0 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
||||||
|
|
||||||
module Data.HTTPSEverywhere.Rules.Internal.ParserSpec (
|
|
||||||
spec
|
|
||||||
) where
|
|
||||||
|
|
||||||
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, shouldSatisfy)
|
|
||||||
|
|
||||||
spec :: Spec
|
|
||||||
spec = do
|
|
||||||
let unsafeParseURL = fromJust . parseURI
|
|
||||||
describe "parseTarget" $ do
|
|
||||||
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
|
|
||||||
it "google.* should match google.nl" $ do
|
|
||||||
let url = unsafeParseURL "http://google.nl"
|
|
||||||
checkTarget "google.*" url `shouldBe` True
|
|
||||||
-- Right-side wildcards apply only one-level deep.
|
|
||||||
it "google.* should not match google.com.id" $ do
|
|
||||||
let url = unsafeParseURL "http://google.com.id"
|
|
||||||
checkTarget "google.*" url `shouldBe` False
|
|
||||||
-- Wildcards expect there exist some prefix.
|
|
||||||
it "*.google.* should not match google.nl" $ do
|
|
||||||
let url = unsafeParseURL "http://google.nl"
|
|
||||||
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
|
|
||||||
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>"
|
|
|
@ -1,63 +0,0 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
|
|
||||||
module Data.HTTPSEverywhere.Rules.InternalSpec (
|
|
||||||
spec
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Prelude hiding (unlines)
|
|
||||||
import Control.Monad (join)
|
|
||||||
import Data.Functor ((<$>))
|
|
||||||
import Data.HTTPSEverywhere.Rules.Internal (hasTargetMatching, hasTriggeringRuleOn, hasExclusionMatching)
|
|
||||||
import Data.HTTPSEverywhere.Rules.Internal.Types (RuleSet(..), Target(..), Exclusion(..), Rule(..))
|
|
||||||
import Data.Maybe (fromJust, catMaybes)
|
|
||||||
import Data.Text (pack, unpack)
|
|
||||||
import Data.Text.ICU.Extras (match, findAndReplace)
|
|
||||||
import Network.URI (parseURI)
|
|
||||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
|
||||||
|
|
||||||
spec :: Spec
|
|
||||||
spec = do
|
|
||||||
let unsafeParseURL = fromJust . parseURI
|
|
||||||
describe "hasTargetMatching" $ do
|
|
||||||
it "Should be True for matching targets." $ do
|
|
||||||
let url = unsafeParseURL "http://eff.org/thing"
|
|
||||||
fixture `hasTargetMatching` url `shouldBe` True
|
|
||||||
it "Should be False for mis-matching targets." $ do
|
|
||||||
let url = unsafeParseURL "http://gnu.org/thing"
|
|
||||||
fixture `hasTargetMatching` url `shouldBe` False
|
|
||||||
describe "hasTriggeringRuleOn" $ do
|
|
||||||
it "Should be 'Just https://...' for matching rules." $ do
|
|
||||||
let url = unsafeParseURL "http://eff.org/thing"
|
|
||||||
fixture `hasTriggeringRuleOn` url `shouldBe` parseURI "https://eff.org/thing"
|
|
||||||
it "Should be Nothing for mis-matching rules." $ do
|
|
||||||
let url = unsafeParseURL "http://gnu.org/thing"
|
|
||||||
fixture `hasTriggeringRuleOn` url `shouldBe` Nothing
|
|
||||||
describe "hasExclusionMatching" $ do
|
|
||||||
it "Should be True for matching targets." $ do
|
|
||||||
let url = unsafeParseURL "http://action.eff.org/thing"
|
|
||||||
fixture `hasExclusionMatching` url `shouldBe` True
|
|
||||||
it "Should be False for mis-matching targets." $ do
|
|
||||||
let url = unsafeParseURL "http://eff.org/thing"
|
|
||||||
fixture `hasExclusionMatching` url `shouldBe` False
|
|
||||||
|
|
||||||
-- We avoid the parser here, for purposes of isolation:
|
|
||||||
|
|
||||||
fixture :: RuleSet
|
|
||||||
fixture = RuleSet
|
|
||||||
{ ruleSetName = "EFF"
|
|
||||||
, ruleSetTargets = catMaybes
|
|
||||||
[ Target . checkURI <$> match "eff\\.org"
|
|
||||||
, Target . checkURI <$> match ".*\\.eff\\.org"
|
|
||||||
]
|
|
||||||
, ruleSetExclusions = catMaybes
|
|
||||||
[ Exclusion . checkURI <$> match "^http://action\\.eff\\.org/"
|
|
||||||
]
|
|
||||||
, ruleSetRules = catMaybes
|
|
||||||
[ Rule . changeURI <$> findAndReplace "^http://eff\\.org/" "https://eff.org/"
|
|
||||||
, Rule . changeURI <$> findAndReplace "^http://([^/:@]*)\\.eff\\.org/" "https://$1.eff.org/"
|
|
||||||
]
|
|
||||||
, ruleSetCookieRules =
|
|
||||||
[]
|
|
||||||
}
|
|
||||||
where checkURI = (. pack . show)
|
|
||||||
changeURI f = join . fmap (parseURI . unpack) . checkURI f
|
|
|
@ -5,7 +5,6 @@
|
||||||
module Data.Text.ICU.ExtrasSpec (spec) where
|
module Data.Text.ICU.ExtrasSpec (spec) where
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
import Control.Lens ((&))
|
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Text.ICU.Extras (match, findAndReplace, Segment(..), parseReplacement)
|
import Data.Text.ICU.Extras (match, findAndReplace, Segment(..), parseReplacement)
|
||||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||||
|
@ -16,8 +15,8 @@ spec = do
|
||||||
it "Should be Nothing if provided an invalid regular expression." $ do
|
it "Should be Nothing if provided an invalid regular expression." $ do
|
||||||
match "(" `shouldBe` Nothing
|
match "(" `shouldBe` Nothing
|
||||||
it "Should yield a match function if provided a regular expression." $ do
|
it "Should yield a match function if provided a regular expression." $ do
|
||||||
("xa" &) <$> match "x" `shouldBe` Just True
|
($ "xa") <$> match "x" `shouldBe` Just True
|
||||||
("xa" &) <$> match "y" `shouldBe` Just False
|
($ "xa") <$> match "y" `shouldBe` Just False
|
||||||
describe "parseReplacement" $ do
|
describe "parseReplacement" $ do
|
||||||
it "Should decompose a replacement string into a sequence [Segment]." $ do
|
it "Should decompose a replacement string into a sequence [Segment]." $ do
|
||||||
parseReplacement "foo$1bar$4$1" `shouldBe` Just [Literal "foo", Reference 1, Literal "bar", Reference 4, Reference 1]
|
parseReplacement "foo$1bar$4$1" `shouldBe` Just [Literal "foo", Reference 1, Literal "bar", Reference 4, Reference 1]
|
||||||
|
@ -28,9 +27,9 @@ spec = do
|
||||||
parseReplacement "$10" `shouldBe` Just [Reference 1, Literal "0"]
|
parseReplacement "$10" `shouldBe` Just [Reference 1, Literal "0"]
|
||||||
describe "findAndReplace" $ do
|
describe "findAndReplace" $ do
|
||||||
it "Should find and replace based upon a regular expression and pattern." $ do
|
it "Should find and replace based upon a regular expression and pattern." $ do
|
||||||
("barqux" &) <$> findAndReplace "(bar)" "$1baz" `shouldBe` Just (Just "barbazqux")
|
($ "barqux") <$> findAndReplace "(bar)" "$1baz" `shouldBe` Just (Just "barbazqux")
|
||||||
("barqux" &) <$> findAndReplace "(qux)" "baz$1" `shouldBe` Just (Just "barbazqux")
|
($ "barqux") <$> findAndReplace "(qux)" "baz$1" `shouldBe` Just (Just "barbazqux")
|
||||||
("barqux" &) <$> findAndReplace "u" "uu" `shouldBe` Just (Just "barquux")
|
($ "barqux") <$> findAndReplace "u" "uu" `shouldBe` Just (Just "barquux")
|
||||||
|
|
||||||
instance Show (Text -> Bool) where
|
instance Show (Text -> Bool) where
|
||||||
show _ = "Text -> Bool"
|
show _ = "Text -> Bool"
|
||||||
|
|
Loading…
Reference in a new issue