Directory.hs

{-# LANGUAGE CPP #-}

{-|
A library for listing "files" in an http "directory".

@
import Network.HTTP.Directory
import qualified Data.Text as T

main = do
  files <- httpDirectory "https://example.com/some/dir/"
  mapM_ T.putStrLn files
  httpFileSize (head files) >>= print
@
-}

module Network.HTTP.Directory
       ( httpDirectory,
         httpFileSize,
         httpRedirect,
         httpRedirects
       ) where

#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))
#else
import Control.Applicative ((<$>))
#endif

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Text (Text)

import Network.HTTP.Client (hrRedirects, httpLbs, httpNoBody, Manager, method,
                            parseRequest, responseBody, responseHeaders,
                            responseOpenHistory, responseStatus)
import Network.HTTP.Types (hContentLength, hLocation, statusCode)

import Text.HTML.DOM (parseLBS)
import Text.XML.Cursor

-- | List the file links (hrefs) in an http directory
--
-- Note if the directory (webpage) url is redirected you may need to use
-- 'httpRedirect' to determine the actual final url prefix for relative links
-- (files).
httpDirectory :: Manager -> String -> IO [Text]
httpDirectory mgr url = do
  request <- parseRequest url
  response <- httpLbs request mgr
  if statusCode (responseStatus response) /= 200
    then error $ show $ responseStatus response
    else do
    let body = responseBody response
        doc = parseLBS body
        cursor = fromDocument doc
    return $ concatMap (attribute "href") $ cursor $// element "a"

-- | Try to get the filesize (Content-Length) of an http file
httpFileSize :: Manager -> String -> IO (Maybe Integer)
httpFileSize mgr url = do
  request <- parseRequest url
  response <- httpNoBody (request {method = "HEAD"}) mgr
  if statusCode (responseStatus response) /= 200
    then error $ show $ responseStatus response
    else do
    let headers = responseHeaders response
    return $ read . B.unpack <$> lookup hContentLength headers

-- | Returns the list of http redirects for an url in reverse order
-- (ie last redirect is first)
httpRedirects :: Manager -> String -> IO [B.ByteString]
httpRedirects mgr url = do
  request <- parseRequest url
  respHist <- responseOpenHistory (request {method = "HEAD"}) mgr
  return $ reverse $ mapMaybe (lookup hLocation . responseHeaders . snd) $ hrRedirects respHist

-- | Return final redirect for an url
httpRedirect :: Manager -> String -> IO (Maybe B.ByteString)
httpRedirect mgr url =
  listToMaybe <$> httpRedirects mgr url