Cull tests against volatile interfaces.
parent
b93ff6bbb6
commit
0ec419feca
|
|
@ -658,19 +658,9 @@ test-suite spec
|
|||
attoparsec,
|
||||
directory,
|
||||
errors,
|
||||
filepath,
|
||||
hspec,
|
||||
http-client,
|
||||
lens,
|
||||
mtl,
|
||||
network,
|
||||
network-uri,
|
||||
pipes,
|
||||
string-conversions,
|
||||
taggy-lens,
|
||||
text,
|
||||
text-icu,
|
||||
https-everywhere-rules
|
||||
text-icu
|
||||
main-is:
|
||||
Spec.hs
|
||||
hs-source-dirs:
|
||||
|
|
@ -683,12 +673,6 @@ test-suite spec
|
|||
ghc-options:
|
||||
-Wall
|
||||
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.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
|
||||
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Lens ((&))
|
||||
import Data.Text (Text)
|
||||
import Data.Text.ICU.Extras (match, findAndReplace, Segment(..), parseReplacement)
|
||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||
|
|
@ -16,8 +15,8 @@ spec = do
|
|||
it "Should be Nothing if provided an invalid regular expression." $ do
|
||||
match "(" `shouldBe` Nothing
|
||||
it "Should yield a match function if provided a regular expression." $ do
|
||||
("xa" &) <$> match "x" `shouldBe` Just True
|
||||
("xa" &) <$> match "y" `shouldBe` Just False
|
||||
($ "xa") <$> match "x" `shouldBe` Just True
|
||||
($ "xa") <$> match "y" `shouldBe` Just False
|
||||
describe "parseReplacement" $ 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]
|
||||
|
|
@ -28,9 +27,9 @@ spec = do
|
|||
parseReplacement "$10" `shouldBe` Just [Reference 1, Literal "0"]
|
||||
describe "findAndReplace" $ do
|
||||
it "Should find and replace based upon a regular expression and pattern." $ do
|
||||
("barqux" &) <$> findAndReplace "(bar)" "$1baz" `shouldBe` Just (Just "barbazqux")
|
||||
("barqux" &) <$> findAndReplace "(qux)" "baz$1" `shouldBe` Just (Just "barbazqux")
|
||||
("barqux" &) <$> findAndReplace "u" "uu" `shouldBe` Just (Just "barquux")
|
||||
($ "barqux") <$> findAndReplace "(bar)" "$1baz" `shouldBe` Just (Just "barbazqux")
|
||||
($ "barqux") <$> findAndReplace "(qux)" "baz$1" `shouldBe` Just (Just "barbazqux")
|
||||
($ "barqux") <$> findAndReplace "u" "uu" `shouldBe` Just (Just "barquux")
|
||||
|
||||
instance Show (Text -> Bool) where
|
||||
show _ = "Text -> Bool"
|
||||
|
|
|
|||
Loading…
Reference in New Issue