diff --git a/robots-txt.cabal b/robots-txt.cabal --- a/robots-txt.cabal +++ b/robots-txt.cabal @@ -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 diff --git a/test/RegressionsSpec.hs b/test/RegressionsSpec.hs --- a/test/RegressionsSpec.hs +++ b/test/RegressionsSpec.hs @@ -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 "a thingyo, i'm not a robots file\n" `shouldSatisfy` myIsLeft - it "can handle no-newline files" $ do parseRobots "a thingyo, i'm not a robots file" diff --git a/test/RobotSpec.hs b/test/RobotSpec.hs --- a/test/RobotSpec.hs +++ b/test/RobotSpec.hs @@ -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 diff --git a/test/SmokeSpec.hs b/test/SmokeSpec.hs --- a/test/SmokeSpec.hs +++ b/test/SmokeSpec.hs @@ -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