http-directory 0.1.5 → 0.1.6

raw patch · 7 files changed

+153/−23 lines, 7 filesdep +network-uriPVP ok

version bump matches the API change (PVP)

Dependencies added: network-uri

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• example/Makefile +7/−0
• example/latest-ghc.hs +11/−0
• example/list-page.hs +10/−0
• http-directory.cabal +9/−5
• src/Network/HTTP/Directory.hs +84/−15
• test/Spec.hs +27/−3

@@ -2,6 +2,11 @@  `http-directory` uses [PVP Versioning](https://pvp.haskell.org). +## 0.1.6 (2020-01-24)+- filter relative/paths and relative?queries+- add `url </> file`+- add trailingSlash for url and noTrailingSlash for filename+ ## 0.1.5 (2019-06-xx) - also filter "..", "#" and ":" from httpDirectory - export Manager

@@ -0,0 +1,7 @@+all: latest-ghc list-page++latest-ghc: latest-ghc.hs+	ghc latest-ghc++list-page: list-page.hs+	ghc list-page

@@ -0,0 +1,11 @@+import Network.HTTP.Directory+import qualified Data.Text as T+import Data.Char++main :: IO ()+main = do+  mgr <- httpManager+  let url = "https://downloads.haskell.org/~ghc/"+  dirs <- httpDirectory mgr url+  let vs = filter (isDigit . T.head) dirs+  putStrLn $ "Latest ghc: " <> url <> T.unpack (last vs)

@@ -0,0 +1,10 @@+import Network.HTTP.Directory+import qualified Data.Text.IO as T+import System.Environment++main :: IO ()+main = do+  [url] <- getArgs+  mgr <- httpManager+  dirs <- httpDirectory mgr url+  mapM_ T.putStrLn dirs

@@ -1,6 +1,6 @@ cabal-version:       1.18 name:                http-directory-version:             0.1.5+version:             0.1.6 synopsis:            http directory listing library description:             Library for listing the files (href's) in an http directory.@@ -17,8 +17,11 @@ build-type:          Simple extra-doc-files:     README.md                    , CHANGELOG.md-tested-with:         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+                   , 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  source-repository head   type:                git@@ -27,15 +30,15 @@ library   hs-source-dirs:      src   exposed-modules:     Network.HTTP.Directory-                           build-depends:       base < 5,                        bytestring,                        html-conduit,                        http-client,                        http-client-tls,-                       http-date,+                       http-date >= 0.0.7,                        http-types,+                       network-uri,                        text,                        time,                        xml-conduit@@ -61,3 +64,4 @@     build-depends: base >= 4 && < 5                  , hspec >= 1.3                  , http-directory+                 , text

@@ -9,10 +9,12 @@  main = do   mgr <- httpManager-  files <- httpDirectory mgr "https://example.com/some/dir/"+  let url = "https://example.com/some/dir/"+  files <- httpDirectory mgr url   mapM_ T.putStrLn files-  httpFileSize mgr (head files) >>= print-  httpLastModified mgr (head files) >>= print+  let file = url </> T.unpack (head files)+  httpFileSize mgr file >>= print+  httpLastModified mgr file >>= print @ -} @@ -28,7 +30,10 @@          httpRedirect',          httpRedirects,          isHttpUrl,-         Manager+         trailingSlash,+         noTrailingSlash,+         Manager,+         (</>)        ) where  #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))@@ -40,22 +45,26 @@ import qualified Data.ByteString.Char8 as B import qualified Data.List as L import Data.Maybe-import Data.Text (Text, isPrefixOf, isInfixOf)+import Data.Text (Text)+import qualified Data.Text as T import Data.Time.Clock (UTCTime)  import Network.HTTP.Client (hrRedirects, httpLbs, httpNoBody, Manager, method,-                            newManager, parseRequest,-                            Request, Response, responseBody, responseHeaders,+                            newManager, parseRequest, Request,+                            Response, responseBody, responseHeaders,                             responseOpenHistory, responseStatus) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Date (httpDateToUTC, parseHTTPDate) import Network.HTTP.Types (hContentLength, hLocation, methodHead, statusCode)+import Network.URI (parseURI, URI(..))  import Text.HTML.DOM (parseLBS) import Text.XML.Cursor --- | List the file links (hrefs) in an http directory+-- | List the files (hrefs) in an http directory --+-- It filters out absolute urls & paths, queries, '..', and '#' links.+-- -- Raises an error if the http request fails. -- -- Note if the directory (webpage) url is redirected to a different path@@ -63,16 +72,31 @@ -- the actual final url prefix for relative links -- (files). ----- (Filters "non-files/subdirs" @since 0.1.4 (before that was just httpRawDirectory)+-- (before 0.1.4 it was just httpRawDirectory) httpDirectory :: Manager -> String -> IO [Text] httpDirectory mgr url = do   hrefs <- httpRawDirectory mgr url-  return $ L.nub $ filter (not . or . flist (map isPrefixOf ["/","?"] ++ [(`elem` ["../", "..", "#"]), (":" `isInfixOf`)])) hrefs+  return $ defaultFilesFilter uri hrefs+  where+    uri = parseURI url --- picked from swish-flist :: [a->b] -> a -> [b]-flist fs a = map ($ a) fs+defaultFilesFilter :: Maybe URI -> [Text] -> [Text]+defaultFilesFilter mUri =+  L.nub . filter (not . or . flist (map T.isInfixOf [":", "?", "/"] ++ [(`elem` ["../", "..", "#"])])) . map removePath+  where+    -- picked from swish+    flist :: [a->b] -> a -> [b]+    flist fs a = map ($ a) fs +    removePath :: Text -> Text+    removePath t =+      case mpath of+        Nothing -> t+        Just path ->+          fromMaybe t $ T.stripPrefix (T.pack path) t++    mpath = uriPath <$> mUri+ -- | Like httpDirectory but uses own Manager -- -- @since 0.1.4@@ -130,13 +154,14 @@   checkResponse url response   let headers = responseHeaders response       mdate = lookup "Last-Modified" headers-  return $ httpDateToUTC <$> maybe Nothing parseHTTPDate mdate+  return $ httpDateToUTC <$> (parseHTTPDate =<< mdate) +-- conflicts with Request checkResponse :: String -> Response r -> IO () checkResponse url response =   when (statusCode (responseStatus response) /= 200) $ do     putStrLn url-    error $ show $ responseStatus response+    error' $ show $ responseStatus response  -- | alias for 'newManager tlsManagerSettings' -- so one does not need to import http-client etc@@ -183,3 +208,47 @@ isHttpUrl :: String -> Bool isHttpUrl loc = "http:" `L.isPrefixOf` loc || "https:" `L.isPrefixOf` loc +-- | This </> eats extra slashes.+--+-- @"dir//" </> "/subdir/" = "dir/subdir/"@+--+-- @since 0.1.6+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++-- | Make sure an url ends with "/"+--+-- @+-- trailingSlash "url" == "url/"+-- trailingSlash "url/" == "url/"+-- @+--+-- @since 0.1.6+trailingSlash :: String -> String+trailingSlash "" = ""+trailingSlash str =+  if last str == '/' then str else str ++ "/"++-- | Remove all trailing slashes from filename or url+--+-- @+-- noTrailingSlash "dir/" == "dir"+-- noTrailingSlash "dir//" == "dir"+-- @+--+-- @since 0.1.6+noTrailingSlash :: Text -> Text+noTrailingSlash = T.dropWhileEnd (== '/')++-- from simple-cmd+error' :: String -> a+#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,9,0))+error' = errorWithoutStackTrace+#else+error' = error+#endif

@@ -1,4 +1,5 @@ import Data.Maybe+import Data.Text (pack) import Test.Hspec import Network.HTTP.Directory @@ -50,7 +51,7 @@     it "httpbin/get" $ do       mgr <- httpManager       msize <- httpFileSize mgr "https://httpbin.org/get"-      msize `shouldBe` Nothing+      isJust msize `shouldBe` True      it "httpbin/0B" $ do       mgr <- httpManager@@ -93,12 +94,35 @@       length redirs `shouldBe` 2    describe "isHttpUrl" $ do-    it "urls" $+    it "http" $       all isHttpUrl         ["http://dl.fedoraproject.org", "https://haskell.org/"]           `shouldBe` True -    it "urls" $+    it "non-http" $       any isHttpUrl          ["mailto:one@where", "somefile", "an.iso", "package.tgz"]           `shouldBe` False++  describe "</>" $ do+    it "url + dir" $+      "http://example.com//" </> "dir/" `shouldBe` "http://example.com/dir/"++    it "dir + dir" $+      "abc" </> "def" `shouldBe` "abc/def"++    it "dir + dir" $+      "abc/" </> "/def" `shouldBe` "abc/def"++  describe "trailing slash" $ do+    it "add" $+      trailingSlash "http://example.com/dir" `shouldBe` "http://example.com/dir/"++    it "idempotent" $+      trailingSlash "http://example.com/" `shouldBe` "http://example.com/"++    it "remove" $+      noTrailingSlash (pack "abc/") `shouldBe` pack "abc"++    it "remove all" $+      noTrailingSlash (pack "abc/def//") `shouldBe` pack "abc/def"