http-directory 0.1.4 → 0.1.5
raw patch · 4 files changed
+157/−36 lines, 4 filesdep +hspecdep +http-directorydep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: hspec, http-directory
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Network.HTTP.Directory: data Manager
+ Network.HTTP.Directory: isHttpUrl :: String -> Bool
Files
- CHANGELOG.md +7/−1
- http-directory.cabal +16/−3
- src/Network/HTTP/Directory.hs +30/−32
- test/Spec.hs +104/−0
CHANGELOG.md view
@@ -2,7 +2,13 @@ `http-directory` uses [PVP Versioning](https://pvp.haskell.org). -## 0.1.4 (2019-06-xx)+## 0.1.5 (2019-06-xx)+- also filter "..", "#" and ":" from httpDirectory+- export Manager+- add isHttpUrl+- testsuite added++## 0.1.4 (2019-06-07) - add httpRawDirectory - httpDirectory now filters out absolutes hrefs and sort links - add httpDirectory' and httpRedirect' variants with own Manager
http-directory.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.18 name: http-directory-version: 0.1.4+version: 0.1.5 synopsis: http directory listing library description:- Library for listing the files (links) in an http directory.+ Library for listing the files (href's) in an http directory. It can also check the size, existence, modtime of files,- and url redirects.+ and for url redirects. homepage: https://github.com/juhp/http-directory bug-reports: https://github.com/juhp/http-directory/issues license: MIT@@ -48,3 +48,16 @@ default-language: Haskell2010 default-extensions: OverloadedStrings++test-suite test+ main-is: Spec.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: test++ default-language: Haskell2010++ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ cpp-options: -DDEBUG+ build-depends: base >= 4 && < 5+ , hspec >= 1.3+ , http-directory
src/Network/HTTP/Directory.hs view
@@ -26,18 +26,21 @@ httpManager, httpRedirect, httpRedirect',- httpRedirects+ httpRedirects,+ isHttpUrl,+ Manager ) where #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0)) #else import Control.Applicative ((<$>)) #endif+import Control.Monad (when) import qualified Data.ByteString.Char8 as B-import Data.List (nub)+import qualified Data.List as L import Data.Maybe-import Data.Text (Text, isPrefixOf, pack)+import Data.Text (Text, isPrefixOf, isInfixOf) import Data.Time.Clock (UTCTime) import Network.HTTP.Client (hrRedirects, httpLbs, httpNoBody, Manager, method,@@ -64,9 +67,7 @@ httpDirectory :: Manager -> String -> IO [Text] httpDirectory mgr url = do hrefs <- httpRawDirectory mgr url- return $ nub $ filter (not . or . flist [isHttp, ("/" `isPrefixOf`), (pack "../" ==), ("?" `isPrefixOf`)]) hrefs- where- isHttp loc = "http:" `isPrefixOf` loc || "https:" `isPrefixOf` loc+ return $ L.nub $ filter (not . or . flist (map isPrefixOf ["/","?"] ++ [(`elem` ["../", "..", "#"]), (":" `isInfixOf`)])) hrefs -- picked from swish flist :: [a->b] -> a -> [b]@@ -94,15 +95,11 @@ httpRawDirectory mgr url = do request <- parseRequest url response <- httpLbs request mgr- if statusCode (responseStatus response) /= 200- then do- putStrLn url- error $ show $ responseStatus response- else do- let body = responseBody response- doc = parseLBS body- cursor = fromDocument doc- return $ concatMap (attribute "href") $ cursor $// element "a"+ checkResponse url response+ let body = responseBody response+ doc = parseLBS body+ cursor = fromDocument doc+ return $ concatMap (attribute "href") $ cursor $// element "a" -- | Test if an file (url) exists --@@ -118,13 +115,9 @@ httpFileSize :: Manager -> String -> IO (Maybe Integer) httpFileSize mgr url = do response <- httpHead mgr url- if statusCode (responseStatus response) /= 200- then do- putStrLn url- error $ show $ responseStatus response- else do- let headers = responseHeaders response- return $ read . B.unpack <$> lookup hContentLength headers+ checkResponse url response+ let headers = responseHeaders response+ return $ read . B.unpack <$> lookup hContentLength headers -- | Try to get the modification time (Last-Modified field) of an http file --@@ -134,14 +127,16 @@ httpLastModified :: Manager -> String -> IO (Maybe UTCTime) httpLastModified mgr url = do response <- httpHead mgr url- if statusCode (responseStatus response) /= 200- then do+ checkResponse url response+ let headers = responseHeaders response+ mdate = lookup "Last-Modified" headers+ return $ httpDateToUTC <$> maybe Nothing parseHTTPDate mdate++checkResponse :: String -> Response r -> IO ()+checkResponse url response =+ when (statusCode (responseStatus response) /= 200) $ do putStrLn url error $ show $ responseStatus response- else do- let headers = responseHeaders response- mdate = lookup "Last-Modified" headers- return $ httpDateToUTC <$> maybe Nothing parseHTTPDate mdate -- | alias for 'newManager tlsManagerSettings' -- so one does not need to import http-client etc@@ -172,16 +167,19 @@ mgr <- httpManager listToMaybe <$> httpRedirects mgr url --- parseRequest with HEAD------ @since 0.1.3 parseRequestHead :: String -> IO Request parseRequestHead url = do request <- parseRequest url return $ request {method = methodHead} --- @since 0.1.3 httpHead :: Manager -> String -> IO (Response ()) httpHead mgr url = do request <- parseRequestHead url httpNoBody request mgr++-- | Test if string starts with http[s]:+--+-- @since 0.1.5+isHttpUrl :: String -> Bool+isHttpUrl loc = "http:" `L.isPrefixOf` loc || "https:" `L.isPrefixOf` loc+
+ test/Spec.hs view
@@ -0,0 +1,104 @@+import Data.Maybe+import Test.Hspec+import Network.HTTP.Directory++main :: IO ()+main = hspec $ parallel spec++spec :: Spec+spec = do+ describe "httpDirectory" $ do+ it "empty google" $ do+ mgr <- httpManager+ fs <- httpDirectory mgr "https://google.com/"+ fs `shouldBe` []++ it "empty httpbin" $ do+ mgr <- httpManager+ fs <- httpDirectory mgr "http://httpbin.org/"+ fs `shouldBe` []++ it "my src hackage" $ do+ fs <- httpDirectory' "https://hackage.haskell.org/package/http-directory/src/"+ null fs `shouldBe` False++ it "myself hackage" $ do+ fs <- httpDirectory' "https://hackage.haskell.org/package/http-directory"+ null fs `shouldBe` False++ it "404" $+ httpDirectory' "https://httpbin.org/404"+ `shouldThrow` anyException++ describe "httpExists" $ do+ it "google" $ do+ mgr <- httpManager+ exists <- httpExists mgr "https://google.com/"+ exists `shouldBe` True++ it "404" $ do+ mgr <- httpManager+ exists <- httpExists mgr "https://httpbin.org/404"+ exists `shouldBe` False++ it "domain" $ do+ mgr <- httpManager+ httpExists mgr "http://nowhereparticular"+ `shouldThrow` anyException++ describe "httpFileSize" $ do+ it "httpbin/get" $ do+ mgr <- httpManager+ msize <- httpFileSize mgr "https://httpbin.org/get"+ msize `shouldBe` Nothing++ it "httpbin/0B" $ do+ mgr <- httpManager+ msize <- httpFileSize mgr "https://httpbin.org/bytes/0"+ msize `shouldBe` Just 0++ it "httpbin/64B" $ do+ mgr <- httpManager+ msize <- httpFileSize mgr "https://httpbin.org/bytes/64"+ msize `shouldBe` Just 64++ it "cabal" $ do+ mgr <- httpManager+ msize <- httpFileSize mgr "https://raw.githubusercontent.com/juhp/http-directory/master/http-directory.cabal"+ isJust msize `shouldBe` True++ describe "httpLastModified" $+ it "httpbin" $ do+ mgr <- httpManager+ mtime <- httpLastModified mgr "https://haskell.org/"+ isJust mtime `shouldBe` True++ describe "httpRedirect" $+ it "fedora" $ do+ mredir <- httpRedirect' "http://dl.fedoraproject.org"+ isJust mredir `shouldBe` True++ describe "httpRedirect" $ do+ it "fedora" $ do+ mredir <- httpRedirect' "http://download.fedoraproject.org"+ isJust mredir `shouldBe` True++ it "httpbin" $ do+ mredir <- httpRedirect' "http://httpbin.org/relative-redirect/1"+ isJust mredir `shouldBe` True++ it "3 redirs" $ do+ mgr <- httpManager+ redirs <- httpRedirects mgr "http://httpbin.org/relative-redirect/2"+ length redirs `shouldBe` 2++ describe "isHttpUrl" $ do+ it "urls" $+ all isHttpUrl+ ["http://dl.fedoraproject.org", "https://haskell.org/"]+ `shouldBe` True++ it "urls" $+ any isHttpUrl+ ["mailto:one@where", "somefile", "an.iso", "package.tgz"]+ `shouldBe` False