From 0ec419feca71216cd78213ba98373e082cafc2b5 Mon Sep 17 00:00:00 2001 From: vi Date: Thu, 28 Jun 2018 01:45:41 -0600 Subject: [PATCH] Cull tests against volatile interfaces. --- https-everywhere-rules.cabal | 18 +---- .../Rules/Internal/ParserSpec.hs | 72 ------------------- .../HTTPSEverywhere/Rules/InternalSpec.hs | 63 ---------------- test/Data/Text/ICU/ExtrasSpec.hs | 11 ++- 4 files changed, 6 insertions(+), 158 deletions(-) delete mode 100644 test/Data/HTTPSEverywhere/Rules/Internal/ParserSpec.hs delete mode 100644 test/Data/HTTPSEverywhere/Rules/InternalSpec.hs diff --git a/https-everywhere-rules.cabal b/https-everywhere-rules.cabal index da41620..d996717 100644 --- a/https-everywhere-rules.cabal +++ b/https-everywhere-rules.cabal @@ -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 diff --git a/test/Data/HTTPSEverywhere/Rules/Internal/ParserSpec.hs b/test/Data/HTTPSEverywhere/Rules/Internal/ParserSpec.hs deleted file mode 100644 index ac48b41..0000000 --- a/test/Data/HTTPSEverywhere/Rules/Internal/ParserSpec.hs +++ /dev/null @@ -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 $ - [ "" - , " " - , " " - , "" - , " " - , " " - , " " - , "" - ] - -instance Show RuleSet where - show _ = "" diff --git a/test/Data/HTTPSEverywhere/Rules/InternalSpec.hs b/test/Data/HTTPSEverywhere/Rules/InternalSpec.hs deleted file mode 100644 index 91f7f57..0000000 --- a/test/Data/HTTPSEverywhere/Rules/InternalSpec.hs +++ /dev/null @@ -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 diff --git a/test/Data/Text/ICU/ExtrasSpec.hs b/test/Data/Text/ICU/ExtrasSpec.hs index 775bed7..997c143 100644 --- a/test/Data/Text/ICU/ExtrasSpec.hs +++ b/test/Data/Text/ICU/ExtrasSpec.hs @@ -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"