http-directory 0.1.8 → 0.1.9

raw patch · 7 files changed

+224/−66 lines, 7 filesdep +http-conduitdep +tagstream-conduitdep ~xml-conduitsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: http-conduit, tagstream-conduit

Dependency ranges changed: xml-conduit

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +3/−4
• Setup.hs +0/−2
• example/list-page.hs +1/−2
• http-directory.cabal +47/−18
• src/Network/HTTP/Directory.hs +103/−29
• test/Spec.hs +64/−11

@@ -2,6 +2,12 @@  `http-directory` uses [PVP Versioning](https://pvp.haskell.org). +## 0.1.9 (2021-12-09)+- httpDirectory' now uses Network.HTTP.Simple+- also add httpRawDirectory', httpExists', httpFileSize', httpLastModified'+  which all use Network.HTTP.Simple too+- add +/+ path combinator+ ## 0.1.8 (2020-03-12) - fix regression in 0.1.6 and 0.1.7: do not filter "*/" files - more careful filter handling of '/'

@@ -4,18 +4,17 @@ [![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE) [![Stackage Lts](http://stackage.org/package/http-directory/badge/lts)](http://stackage.org/lts/package/http-directory) [![Stackage Nightly](http://stackage.org/package/http-directory/badge/nightly)](http://stackage.org/nightly/package/http-directory)-[![Build status](https://secure.travis-ci.org/juhp/http-directory.svg)](https://travis-ci.org/juhp/http-directory)  A simple library for reading http directories. -It uses http-client for http transport, and+It uses http-client or http-conduit for http transport, and html-conduit and xml-conduit to parse the html for links.  The library is intended for listing the files in http file directories, but since http directories are just html pages it can also be used to list the links (href's) on any html webpage. -## Usage Example+## Usage examples  ```haskell Network.HTTP.Directory> :type httpDirectory'@@ -25,4 +24,4 @@ "CPUTime","Console","Environment","IO","Mem","Posix"] ``` -See more [examples](https://github.com/juhp/http-directory/blob/master/example/) and the [latest haddock documentation](https://hackage.haskell.org/package/http-directory/docs/Network-HTTP-Directory.html) for more usage details.+See more [examples](https://github.com/juhp/http-directory/blob/main/example/) and the [latest haddock documentation](https://hackage.haskell.org/package/http-directory/docs/Network-HTTP-Directory.html) for more details.

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -5,6 +5,5 @@ main :: IO () main = do   [url] <- getArgs-  mgr <- httpManager-  dirs <- httpDirectory mgr url+  dirs <- httpDirectory' url   mapM_ T.putStrLn dirs

@@ -1,6 +1,6 @@ cabal-version:       1.18 name:                http-directory-version:             0.1.8+version:             0.1.9 synopsis:            http directory listing library description:             Library for listing the files (href's) in an http directory.@@ -12,7 +12,7 @@ license-file:        LICENSE author:              Jens Petersen maintainer:          juhpetersen@gmail.com-copyright:           2019-2020 Jens Petersen+copyright:           2019-2021 Jens Petersen category:            Network build-type:          Simple extra-doc-files:     README.md@@ -20,8 +20,9 @@                    , example/Makefile                    , example/latest-ghc.hs                    , example/list-page.hs-tested-with:         GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3,-                     GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5+tested-with:         GHC== 7.4.2 || == 7.6.3 || == 7.8.4 || == 7.10.3+                     || == 8.0.2 || == 8.2.2 || == 8.4.4 || == 8.6.5+                     || == 8.8.4 || == 8.10.5  source-repository head   type:                git@@ -36,6 +37,7 @@                        html-conduit,                        http-client,                        http-client-tls,+                       http-conduit,                        http-date >= 0.0.7,                        http-types,                        network-uri,@@ -45,23 +47,50 @@   if impl(ghc<8.0)       build-depends: semigroups,                      cryptonite < 0.26--  ghc-options:         -fwarn-missing-signatures-                       -Wall+  if impl(ghc < 8.3)+    build-depends:     tagstream-conduit < 0.5.6,+                       xml-conduit < 1.9    default-language:    Haskell2010-  default-extensions:  OverloadedStrings +  ghc-options:         -Wall+  if impl(ghc >= 8.0)+    ghc-options:       -Wcompat+                       -Widentities+                       -Wincomplete-uni-patterns+                       -Wincomplete-record-updates+                       -Wredundant-constraints+  if impl(ghc >= 8.2)+    ghc-options:       -fhide-source-paths+  if impl(ghc >= 8.4)+    ghc-options:       -Wmissing-export-lists+                       -Wpartial-fields+  if impl(ghc >= 8.10)+    ghc-options:       -Wunused-packages+ test-suite test-    main-is: Spec.hs-    type: exitcode-stdio-1.0-    hs-source-dirs: test+  main-is: Spec.hs+  type: exitcode-stdio-1.0+  hs-source-dirs: test -    default-language: Haskell2010+  default-language: Haskell2010 -    ghc-options:   -Wall -threaded -rtsopts -with-rtsopts=-N-    cpp-options:   -DDEBUG-    build-depends: base >= 4 && < 5-                 , hspec >= 1.3-                 , http-directory-                 , text+  build-depends: base >= 4 && < 5+               , hspec >= 1.3+               , http-directory+               , text++  ghc-options:         -Wall+  if impl(ghc >= 8.0)+    ghc-options:       -Wcompat+                       -Widentities+                       -Wincomplete-uni-patterns+                       -Wincomplete-record-updates+                       -Wredundant-constraints+  if impl(ghc >= 8.2)+    ghc-options:       -fhide-source-paths+  if impl(ghc >= 8.4)+    ghc-options:       -Wmissing-export-lists+                       -Wpartial-fields+  if impl(ghc >= 8.10)+    ghc-options:       -Wunused-packages

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, OverloadedStrings #-}  {-| A library for listing "files" in an http "directory".@@ -6,25 +6,31 @@ @ import Network.HTTP.Directory import qualified Data.Text as T+import qualified Data.Text.IO as T  main = do-  mgr <- httpManager-  let url = "https://example.com/some/dir/"-  files <- httpDirectory mgr url+  let url = \"https:\/\/example.com\/some\/dir\/\"+  files <- 'httpDirectory\'' url   mapM_ T.putStrLn files-  let file = url </> T.unpack (head files)-  httpFileSize mgr file >>= print-  httpLastModified mgr file >>= print+  let file = url '+/+' T.unpack (head files)+  'httpFileSize\'' file >>= print+  'httpLastModified\'' file >>= print @++The main methods use http-client and most of the primed ones http-conduit. -}  module Network.HTTP.Directory        ( httpDirectory,          httpDirectory',          httpRawDirectory,+         httpRawDirectory',          httpExists,+         httpExists',          httpFileSize,+         httpFileSize',          httpLastModified,+         httpLastModified',          httpManager,          httpRedirect,          httpRedirect',@@ -32,7 +38,8 @@          isHttpUrl,          trailingSlash,          noTrailingSlash,-         Manager+         Manager,+         (+/+)        ) where  #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))@@ -42,6 +49,7 @@ import Control.Monad (when)  import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.List as L import Data.Maybe import Data.Text (Text)@@ -54,6 +62,7 @@                             responseOpenHistory, responseStatus) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Date (httpDateToUTC, parseHTTPDate)+import qualified Network.HTTP.Simple as S import Network.HTTP.Types (hContentLength, hLocation, methodHead, statusCode) import Network.URI (parseURI, URI(..)) @@ -68,16 +77,13 @@ -- -- Note if the directory (webpage) url is redirected to a different path -- you may need to use 'httpRedirect' to determine--- the actual final url prefix for relative links--- (files).+-- the actual final url prefix for relative links (files). ----- (before 0.1.4 it was just httpRawDirectory)+-- (Before 0.1.4 this was the same as httpRawDirectory) httpDirectory :: Manager -> String -> IO [Text] httpDirectory mgr url = do   hrefs <- httpRawDirectory mgr url-  return $ defaultFilesFilter uri hrefs-  where-    uri = parseURI url+  return $ defaultFilesFilter (parseURI url) hrefs  defaultFilesFilter :: Maybe URI -> [Text] -> [Text] defaultFilesFilter mUri =@@ -110,9 +116,20 @@ -- @since 0.1.4 httpDirectory' :: String -> IO [Text] httpDirectory' url = do-  mgr <- httpManager-  httpDirectory mgr url+  hrefs <- httpRawDirectory' url+  return $ defaultFilesFilter (parseURI url) hrefs +httpRawDirectoryInternal :: (Request -> IO (Response BL.ByteString)) -> String+                         -> IO [Text]+httpRawDirectoryInternal httpreq url = do+  request <- parseRequest url+  response <- httpreq request+  checkResponse url response+  let body = responseBody response+      doc = parseLBS body+      cursor = fromDocument doc+  return $ concatMap (attribute "href") $ cursor $// element "a"+ -- | List all the hrefs in an http directory html file. -- -- Raises an error if the http request fails.@@ -123,16 +140,20 @@ -- (files). -- -- @since 0.1.4+{- HLINT ignore "Use section" -} httpRawDirectory :: Manager -> String -> IO [Text]-httpRawDirectory mgr url = do-  request <- parseRequest url-  response <- httpLbs request mgr-  checkResponse url response-  let body = responseBody response-      doc = parseLBS body-      cursor = fromDocument doc-  return $ concatMap (attribute "href") $ cursor $// element "a"+httpRawDirectory mgr = httpRawDirectoryInternal (flip httpLbs mgr) +-- | List all the hrefs in an http directory html file.+--+-- Raises an error if the http request fails.+--+-- Like httpRawDirectory but uses Network.HTTP.Simple (http-conduit)+--+-- @since 0.1.9+httpRawDirectory' :: String -> IO [Text]+httpRawDirectory' = httpRawDirectoryInternal S.httpLBS+ -- | Test if an file (url) exists -- -- @since 0.1.3@@ -141,6 +162,14 @@   response <- httpHead mgr url   return $ statusCode (responseStatus response) == 200 +-- | Test if an file (url) exists+--+-- @since 0.1.9+httpExists' :: String -> IO Bool+httpExists' url = do+  response <- httpHead' url+  return $ statusCode (responseStatus response) == 200+ -- | Try to get the filesize (Content-Length field) of an http file -- -- Raises an error if the http request fails.@@ -151,6 +180,18 @@   let headers = responseHeaders response   return $ read . B.unpack <$> lookup hContentLength headers +-- | Try to get the filesize (Content-Length field) of an http file+--+-- Raises an error if the http request fails.+--+-- @since 0.1.9+httpFileSize' :: String -> IO (Maybe Integer)+httpFileSize' url = do+  response <- httpHead' url+  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 -- -- Raises an error if the http request fails.@@ -164,6 +205,19 @@       mdate = lookup "Last-Modified" headers   return $ httpDateToUTC <$> (parseHTTPDate =<< mdate) +-- | Try to get the modification time (Last-Modified field) of an http file+--+-- Raises an error if the http request fails.+--+-- @since 0.1.9+httpLastModified' :: String -> IO (Maybe UTCTime)+httpLastModified' url = do+  response <- httpHead' url+  checkResponse url response+  let headers = responseHeaders response+      mdate = lookup "Last-Modified" headers+  return $ httpDateToUTC <$> (parseHTTPDate =<< mdate)+ -- conflicts with Request checkResponse :: String -> Response r -> IO () checkResponse url response =@@ -210,17 +264,22 @@   request <- parseRequestHead url   httpNoBody request mgr +httpHead' :: String -> IO (Response ())+httpHead' url = do+  request <- parseRequestHead url+  S.httpNoBody request+ -- | Test if string starts with http[s]: -- -- @since 0.1.5 isHttpUrl :: String -> Bool isHttpUrl loc = "http:" `L.isPrefixOf` loc || "https:" `L.isPrefixOf` loc --- | Make sure an url ends with "/"+-- | Make sure an url ends with "\/" -- -- @--- trailingSlash "url" == "url/"--- trailingSlash "url/" == "url/"+-- trailingSlash "url" == "url\/"+-- trailingSlash "url\/" == "url\/" -- @ -- -- @since 0.1.6@@ -232,8 +291,8 @@ -- | Remove all trailing slashes from filename or url -- -- @--- noTrailingSlash "dir/" == "dir"--- noTrailingSlash "dir//" == "dir"+-- noTrailingSlash "dir\/" == "dir"+-- noTrailingSlash "dir\/\/" == "dir" -- @ -- -- @since 0.1.6@@ -247,3 +306,18 @@ #else error' = error #endif++-- | This +\/+ eats extra slashes.+--+-- @+-- "dir\/\/" +\/+ "\/subdir\/" = "dir\/subdir\/"+-- @+--+-- @since 0.1.9+infixr 5 +/++(+/+) :: String -> String -> String+"" +/+ s = s+s +/+ "" = s+s +/+ t | last s == '/' = init s +/+ t+        | head t == '/' = s +/+ tail t+s +/+ t = s ++ "/" ++ t

@@ -50,6 +50,19 @@       httpExists mgr "http://nowhereparticular"       `shouldThrow` anyException +  describe "httpExists'" $ do+    it "google" $ do+      exists <- httpExists' "https://google.com/"+      exists `shouldBe` True++    it "404" $ do+      exists <- httpExists' "https://httpbin.org/404"+      exists `shouldBe` False++    it "domain" $ do+      httpExists' "http://nowhereparticular"+      `shouldThrow` anyException+   describe "httpFileSize" $ do     it "httpbin/get" $ do       mgr <- httpManager@@ -71,29 +84,47 @@       msize <- httpFileSize mgr "https://raw.githubusercontent.com/juhp/http-directory/master/http-directory.cabal"       isJust msize `shouldBe` True -  describe "httpLastModified" $+  describe "httpFileSize'" $ do+    it "httpbin/get" $ do+      msize <- httpFileSize' "https://httpbin.org/get"+      isJust msize `shouldBe` True++    it "httpbin/0B" $ do+      msize <- httpFileSize' "https://httpbin.org/bytes/0"+      msize `shouldBe` Just 0++    it "httpbin/64B" $ do+      msize <- httpFileSize' "https://httpbin.org/bytes/64"+      msize `shouldBe` Just 64++    it "cabal" $ do+      msize <- httpFileSize' "https://raw.githubusercontent.com/juhp/http-directory/master/http-directory.cabal"+      isJust msize `shouldBe` True++  describe "httpLastModified" $ do     it "httpbin" $ do       mgr <- httpManager       mtime <- httpLastModified mgr "https://haskell.org/"       isJust mtime `shouldBe` True -  describe "httpRedirect" $-    it "fedora" $ do-      mredir <- httpRedirect' "http://fedoraproject.org"-      isJust mredir `shouldBe` True+    it "httpbin'" $ do+      mtime <- httpLastModified' "https://haskell.org/"+      isJust mtime `shouldBe` True +  -- https://github.com/postmanlabs/httpbin/issues/617   describe "httpRedirect" $ do-    it "fedora" $ do-      mredir <- httpRedirect' "http://download.fedoraproject.org"+    it "httpbingo" $ do+      mgr <- httpManager+      mredir <- httpRedirect mgr "http://httpbingo.org/relative-redirect/1"       isJust mredir `shouldBe` True -    it "httpbin" $ do-      mredir <- httpRedirect' "http://httpbin.org/relative-redirect/1"+    it "httpbingo'" $ do+      mredir <- httpRedirect' "http://httpbingo.org/relative-redirect/1"       isJust mredir `shouldBe` True      it "3 redirs" $ do       mgr <- httpManager-      redirs <- httpRedirects mgr "http://httpbin.org/relative-redirect/2"+      redirs <- httpRedirects mgr "http://httpbingo.org/relative-redirect/2"       length redirs `shouldBe` 2    describe "isHttpUrl" $ do@@ -107,7 +138,7 @@          ["mailto:one@where", "somefile", "an.iso", "package.tgz"]           `shouldBe` False -  describe "trailing slash" $ do+  describe "trailingSlash" $ do     it "add" $       trailingSlash "http://example.com/dir" `shouldBe` "http://example.com/dir/" @@ -119,3 +150,25 @@      it "remove all" $       noTrailingSlash (pack "abc/def//") `shouldBe` pack "abc/def"++  describe "+/+" $ do+    it "join" $+      "http://example.com/dir" +/+ "file" `shouldBe` "http://example.com/dir/file"++    it "join/" $+      "http://example.com/dir" +/+ "/file" `shouldBe` "http://example.com/dir/file"++    it "/join" $+      "http://example.com/dir/" +/+ "file" `shouldBe` "http://example.com/dir/file"++    it "/join/" $+      "http://example.com/dir/" +/+ "/file" `shouldBe` "http://example.com/dir/file"++    it "join /" $+      "http://example.com/dir" +/+ "file/" `shouldBe` "http://example.com/dir/file/"++    it "identity" $+      "http://example.com/dir" +/+ "" `shouldBe` "http://example.com/dir"++    it "/identity" $+      "http://example.com/dir/" +/+ "" `shouldBe` "http://example.com/dir/"