robots-txt 0.4.1.7 → 0.4.1.8
raw patch · 4 files changed
+162/−146 lines, 4 filesdep ~attoparsecPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: attoparsec
API changes (from Hackage documentation)
Files
- robots-txt.cabal +2/−2
- test/RegressionsSpec.hs +21/−26
- test/RobotSpec.hs +113/−97
- test/SmokeSpec.hs +26/−21
robots-txt.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: robots-txt-version: 0.4.1.7+version: 0.4.1.8 synopsis: Parser for robots.txt description: This is an attoparsec parser for robots.txt files homepage: http://github.com/mwotton/robots@@ -26,7 +26,7 @@ hs-source-dirs: src build-depends: base >= 4 && <= 5 , bytestring- , attoparsec >= 0.12.1.6 && < 0.14+ , attoparsec >= 0.12.1.6 && < 0.15 , time >= 1.4 , old-locale >= 1.0.0.5 && < 1.1 default-language: Haskell98
test/RegressionsSpec.hs view
@@ -1,51 +1,48 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+ module RegressionsSpec where-import Network.HTTP.Robots-import System.Directory-import Test.Hspec -import Control.Applicative-import Control.Monad (filterM, forM_)-import Control.Monad.IO.Class-import Data.Attoparsec.ByteString.Char8-import qualified Data.ByteString.Char8 as BS-import Data.Either-import System.IO.Unsafe (unsafePerformIO)+import Control.Monad (filterM)+import Control.Monad.IO.Class+import Data.Attoparsec.ByteString.Char8+import qualified Data.ByteString.Char8 as BS+import Network.HTTP.Robots+import System.Directory+import System.IO.Unsafe (unsafePerformIO)+import Test.Hspec -- apparently not a utility function. myIsLeft :: Either a b -> Bool myIsLeft (Left _) = True-myIsLeft _ = False+myIsLeft _ = False dirname :: String dirname = reverse $ dropWhile (/= '/') $ reverse __FILE__+ -- forgive me father, i know not what i do. texts :: [(FilePath, BS.ByteString)]+{-# NOINLINE texts #-} texts = unsafePerformIO $ do- contents <- map ((dirname ++ "/examples/") ++) <$> (getDirectoryContents $ dirname ++ "/examples")+ contents <- map ((dirname ++ "/examples/") ++) <$> getDirectoryContents (dirname ++ "/examples") files <- filterM doesFileExist contents- res <- mapM (\x -> BS.readFile x >>= \c -> return (x,c )) files- return res+ mapM (\x -> BS.readFile x >>= \c -> return (x, c)) files - -- this is just an ugly burn-in test - we collect examples of- -- robots.txt and check we can read them all.+-- this is just an ugly burn-in test - we collect examples of+-- robots.txt and check we can read them all. spec :: Spec spec = do- describe "regressions" $ do it "cellularphonedepot regression" $ do f <- BS.readFile (dirname ++ "/examples/cellularphonedepot.com")- parseOnly robotP f `shouldBe` Right ([([Wildcard],[Disallow "/*",Allow "/?okparam=",Allow "/$"])],[])+ parseOnly robotP f `shouldBe` Right ([([Wildcard], [Disallow "/*", Allow "/?okparam=", Allow "/$"])], []) it "valueweb.gr regression" $ do- f <- BS.readFile (dirname ++ "/examples/valueweb.gr")- let Right r = parseOnly robotP f+ Right r <- parseOnly robotP <$> BS.readFile (dirname ++ "/examples/valueweb.gr") canAccess "Mozilla/5.0 (compatible; meanpathbot/1.0; +http://www.meanpath.com/meanpathbot.html)" r "/" `shouldBe` False - it "chooses the most specific user agent from helloworldweb" $ do (Right hellobot) <- parseOnly robotP <$> liftIO (BS.readFile "./test/examples/helloworldweb2.com") canAccess "Mozilla/5.0 (compatible; meanpathbot/1.0; +http://www.meanpath.com/meanpathbot.html)" hellobot "/" `shouldBe` False@@ -56,15 +53,13 @@ canAccess "Mozilla/5.0 (compatible; meanpathbot/1.0; +http://www.meanpath.com/meanpathbot.html)" hellobot "/" `shouldBe` False it "operates correctly on kvsupply.com" $ do- (Right hellobot) <- parseOnly robotP <$> liftIO (BS.readFile "./test/examples/kvsupply.com")- canAccess "Mozilla/5.0 (compatible; meanpathbot/1.0; +http://www.meanpath.com/meanpathbot.html)" hellobot "/" `shouldBe` False-+ (Right hellobot) <- parseOnly robotP <$> liftIO (BS.readFile "./test/examples/kvsupply.com")+ canAccess "Mozilla/5.0 (compatible; meanpathbot/1.0; +http://www.meanpath.com/meanpathbot.html)" hellobot "/" `shouldBe` False describe "incorrect robots files" $ do it "treats HTML as garbage" $ do parseRobots "<html><head>a thing</head><body>yo, i'm not a robots file</body></html>\n" `shouldSatisfy` myIsLeft- it "can handle no-newline files" $ do parseRobots "<html><head>a thing</head><body>yo, i'm not a robots file</body></html>"
test/RobotSpec.hs view
@@ -1,67 +1,66 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+ module RobotSpec where-import Network.HTTP.Robots-import System.Directory-import Test.Hspec -import Control.Applicative-import Control.Monad (filterM, forM_)-import Control.Monad.IO.Class-import Data.Attoparsec.ByteString.Char8-import qualified Data.ByteString.Char8 as BS-import Data.Either-import System.IO.Unsafe (unsafePerformIO)+import Control.Monad (filterM, forM_)+import Data.Attoparsec.ByteString.Char8+import qualified Data.ByteString.Char8 as BS+import Network.HTTP.Robots+import System.Directory+import System.IO.Unsafe (unsafePerformIO)+import Test.Hspec -- apparently not a utility function. myIsLeft :: Either a b -> Bool myIsLeft (Left _) = True-myIsLeft _ = False+myIsLeft _ = False dirname :: String dirname = reverse $ dropWhile (/= '/') $ reverse __FILE__+ -- forgive me father, i know not what i do. texts :: [(FilePath, BS.ByteString)]+{-# NOINLINE texts #-} texts = unsafePerformIO $ do- contents <- map ((dirname ++ "/examples/") ++) <$> (getDirectoryContents $ dirname ++ "/examples")+ contents <- map ((dirname ++ "/examples/") ++) <$> getDirectoryContents (dirname ++ "/examples") files <- filterM doesFileExist contents- res <- mapM (\x -> BS.readFile x >>= \c -> return (x,c )) files- return res+ mapM (\x -> BS.readFile x >>= \c -> return (x, c)) files - -- this is just an ugly burn-in test - we collect examples of- -- robots.txt and check we can read them all.+-- this is just an ugly burn-in test - we collect examples of+-- robots.txt and check we can read them all. spec :: Spec spec = do describe "simple parsing" $ do- it "can read a token" $ do- (parseOnly tokenP "foo") `shouldBe`- Right "foo"- it "stringCI does something sane" $ do- parseOnly (stringCI "user-agent:") "User-agent:" `shouldBe`- Right "User-agent:"- it "can read a user agent" $ do- (parseOnly agentP "User-agent: *\n") `shouldBe`- Right Wildcard- it "can read a specific user agent" $ do- (parseOnly agentP "User-agent: Buzzbot\n") `shouldBe`- Right (Literal "Buzzbot")- it "can read allow directives" $ do- (parseOnly directiveP "Allow: /\n") `shouldBe`- Right (Allow "/")- it "should read a full robots.txt" $ do- (parseOnly robotP "User-agent: *\nDisallow: /\n")- `shouldBe` Right ([([Wildcard], [Disallow "/"])],[])- it "should cope with end-of-line comments" $ do- (parseOnly robotP "User-agent: *\nDisallow: / # don't read my site\nAllow: /foo")- `shouldBe` Right ([([Wildcard], [Disallow "/", Allow "/foo"])],[])- it "can parse this stupid empty disallow line that the BNF suggests should be illegal" $ do- (parseOnly robotP "User-agent: *\nDisallow:\n")- `shouldBe` Right (([([Wildcard], [Allow "/"])]),[])- it "ignores the sitemap extension (and any other unrecognised text" $ do- (parseOnly robotP "Sitemap: http:www.ebay.com/lst/PDP_US_main_index.xml\nUser-agent: *\nDisallow: /\n")- `shouldBe` Right (([([Wildcard], [Disallow "/"])]), ["Sitemap: http:www.ebay.com/lst/PDP_US_main_index.xml"])+ it "can read a token" $+ parseOnly tokenP "foo"+ `shouldBe` Right "foo"+ it "stringCI does something sane" $+ parseOnly (stringCI "user-agent:") "User-agent:"+ `shouldBe` Right "User-agent:"+ it "can read a user agent" $+ parseOnly agentP "User-agent: *\n"+ `shouldBe` Right Wildcard+ it "can read a specific user agent" $+ parseOnly agentP "User-agent: Buzzbot\n"+ `shouldBe` Right (Literal "Buzzbot")+ it "can read allow directives" $+ parseOnly directiveP "Allow: /\n"+ `shouldBe` Right (Allow "/")+ it "should read a full robots.txt" $+ parseOnly robotP "User-agent: *\nDisallow: /\n"+ `shouldBe` Right ([([Wildcard], [Disallow "/"])], [])+ it "should cope with end-of-line comments" $+ parseOnly robotP "User-agent: *\nDisallow: / # don't read my site\nAllow: /foo"+ `shouldBe` Right ([([Wildcard], [Disallow "/", Allow "/foo"])], [])+ it "can parse this stupid empty disallow line that the BNF suggests should be illegal" $+ parseOnly robotP "User-agent: *\nDisallow:\n"+ `shouldBe` Right ([([Wildcard], [Allow "/"])], [])+ it "ignores the sitemap extension (and any other unrecognised text" $+ parseOnly robotP "Sitemap: http:www.ebay.com/lst/PDP_US_main_index.xml\nUser-agent: *\nDisallow: /\n"+ `shouldBe` Right ([([Wildcard], [Disallow "/"])], ["Sitemap: http:www.ebay.com/lst/PDP_US_main_index.xml"]) -- the behaviour here doesn't seem to be rigorously specified: it -- seems obvious that if * can access a resource but FooBot is@@ -78,64 +77,81 @@ -- ganked from http://www.robotstxt.org/norobots-rfc.txt describe "canAccess" $ do let robot =- ([([Literal "unhipbot"],- [Disallow "/"]),- ([Literal "webcrawler", Literal "excite"],- [Allow "/"]),- ([Wildcard],- [Disallow "/org/plans.html",- Allow "/org/",- Allow "/serv",- Allow "/~mak",- Disallow "/"])], [])--+ ( [ ( [Literal "unhipbot"],+ [Disallow "/"]+ ),+ ( [Literal "webcrawler", Literal "excite"],+ [Allow "/"]+ ),+ ( [Wildcard],+ [ Disallow "/org/plans.html",+ Allow "/org/",+ Allow "/serv",+ Allow "/~mak",+ Disallow "/"+ ]+ )+ ],+ []+ ) - -- unhipbot webcrawler other- -- & excite- let tests = [("/",- (False, True, False)),- ("/index.html",- (False, True, False)),- ("/robots.txt",- (True, True, True)),- ("/server.html",- (False, True, True)),- ("/services/fast.html",- (False, True, True)),- ("/services/slow.html",- (False, True, True)),- ("/orgo.gif",- (False, True, False)),- ("/org/about.html",- (False, True, True)),- ("/org/plans.html",- (False, True, False)),- ("/~jim/jim.html",- (False, True, False)),- ("/~mak/mak.html",- (False, True, True))]+ -- unhipbot webcrawler other+ -- & excite+ let tests =+ [ ( "/",+ (False, True, False)+ ),+ ( "/index.html",+ (False, True, False)+ ),+ ( "/robots.txt",+ (True, True, True)+ ),+ ( "/server.html",+ (False, True, True)+ ),+ ( "/services/fast.html",+ (False, True, True)+ ),+ ( "/services/slow.html",+ (False, True, True)+ ),+ ( "/orgo.gif",+ (False, True, False)+ ),+ ( "/org/about.html",+ (False, True, True)+ ),+ ( "/org/plans.html",+ (False, True, False)+ ),+ ( "/~jim/jim.html",+ (False, True, False)+ ),+ ( "/~mak/mak.html",+ (False, True, True)+ )+ ] forM_ tests $ \(path, (unhip, web_and_excite, other)) -> do it ("unhipbot access to " ++ show path) $ canAccess "unhipbot" robot path `shouldBe` unhip it ("webcrawler & excite access to " ++ show path) $ do canAccess "webcrawler" robot path `shouldBe` web_and_excite canAccess "excite" robot path `shouldBe` web_and_excite- it ("otherbot access to " ++ show path) $ do- canAccess "otherbot" robot path `shouldBe` other+ it ("otherbot access to " ++ show path) $ canAccess "otherbot" robot path `shouldBe` other - -- describe "allowable" $ do- -- let robot = [([Wildcard], [Disallow "/", Allow "/anyone"]),- -- ([Literal "OtherSpecial", Literal "SpecialBot"], [Allow "/", Allow "/only_special"])]- -- it "should allow access to anyone" $ do- -- canAccess "anyone" robot "/anyone" `shouldBe` True- -- it "should deny access to root for most bots" $ do- -- canAccess "anyone" robot "/" `shouldBe` False- -- it "should deny access to only_special for most bots" $ do- -- canAccess "anyone" robot "/only_special" `shouldBe` False- -- it "allows access to specialbot" $ do- -- canAccess "SpecialBot" robot "/" `shouldBe` True- -- it "allows access to specialbot special area" $ do- -- canAccess "SpecialBot" robot "/only_special" `shouldBe` True- -- it "allows access to specialbot special area" $ do- -- canAccess "OtherSpecial" robot "/only_special" `shouldBe` True+-- describe "allowable" $ do+-- let robot = [([Wildcard], [Disallow "/", Allow "/anyone"]),+-- ([Literal "OtherSpecial", Literal "SpecialBot"], [Allow "/", Allow "/only_special"])]+-- it "should allow access to anyone" $ do+-- canAccess "anyone" robot "/anyone" `shouldBe` True+-- it "should deny access to root for most bots" $ do+-- canAccess "anyone" robot "/" `shouldBe` False+-- it "should deny access to only_special for most bots" $ do+-- canAccess "anyone" robot "/only_special" `shouldBe` False+-- it "allows access to specialbot" $ do+-- canAccess "SpecialBot" robot "/" `shouldBe` True+-- it "allows access to specialbot special area" $ do+-- canAccess "SpecialBot" robot "/only_special" `shouldBe` True+-- it "allows access to specialbot special area" $ do+-- canAccess "OtherSpecial" robot "/only_special" `shouldBe` True
test/SmokeSpec.hs view
@@ -1,43 +1,48 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+ module SmokeSpec where-import Network.HTTP.Robots-import System.Directory-import Test.Hspec -import Control.Applicative-import Control.Monad (filterM, forM_)+import Control.Monad (filterM, forM_) import qualified Data.ByteString.Char8 as BS-import Data.Either-import System.IO.Unsafe (unsafePerformIO)+import Data.Either+import Network.HTTP.Robots+import System.Directory+import System.IO.Unsafe (unsafePerformIO)+import Test.Hspec -- apparently not a utility function. myIsLeft :: Either a b -> Bool myIsLeft (Left _) = True-myIsLeft _ = False+myIsLeft _ = False dirname :: String dirname = reverse $ dropWhile (/= '/') $ reverse __FILE__+ -- forgive me father, i know not what i do. texts :: [(FilePath, BS.ByteString)]+{-# NOINLINE texts #-} texts = unsafePerformIO $ do- contents <- map ((dirname ++ "/examples/") ++) <$> (getDirectoryContents $ dirname ++ "/examples")+ contents <- map ((dirname ++ "/examples/") ++) <$> getDirectoryContents (dirname ++ "/examples") files <- filterM doesFileExist contents- res <- mapM (\x -> BS.readFile x >>= \c -> return (x,c )) files- return res+ mapM (\x -> BS.readFile x >>= \c -> return (x, c)) files - -- this is just an ugly burn-in test - we collect examples of- -- robots.txt and check we can read them all.+-- this is just an ugly burn-in test - we collect examples of+-- robots.txt and check we can read them all. spec :: Spec spec = do- describe "smoke test - check we can read all the robots.txt examples" $- -- we should also verify if there were unparsed items- forM_ texts $ \(name,text) ->+ forM_ texts $ \(name, text) -> it ("should parse " ++ name) $- parseRobots text `shouldSatisfy`- (\x -> 1 == length (rights [x])- -- head is safe here if first condition is met- && 0 == length (snd . head . rights $ [x]))+ parseRobots text+ `shouldSatisfy` ( \x ->+ 1 == length (rights [x])+ -- head is safe here if first condition is met+ && Just 0 == (fmap (length . snd) . headMay . rights $ [x])+ )++headMay :: [a] -> Maybe a+headMay (x : _) = Just x+headMay [] = Nothing