Iterate through a public S3 bucket and print all elements

ListBucket.hs

#!/usr/bin/env stack
-- stack --resolver lts-9.8 --install-ghc runghc --package http-conduit --package xml
{-# LANGUAGE OverloadedStrings #-}

import System.Environment (getArgs)
import Network.HTTP.Simple
import Data.ByteString.Char8 (pack)
import Text.XML.Light
import Data.Maybe
import Data.List (intercalate)

-- Iterates through public S3 bucket listings, from the given URL:
-- http://gocardless.com.s3-eu-west-1.amazonaws.com/?marker=/some/path

main :: IO ()
main = do
    [bucketUrl] <- getArgs
    paths <- traverseBucket (parseRequest_ bucketUrl)
    putStrLn $ intercalate "\n" paths

traverseBucket :: Request -> IO [String]
traverseBucket request = traverse' ""
  where
    query marker = [(pack "marker", Just (pack marker))]
    qname tag = QName tag (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing

    traverse' :: String -> IO [String]
    traverse' marker = do
      response <- httpLBS (setRequestQueryString (query marker) request)
      let page = parseXML (getResponseBody response)
          contents = concatMap (findElements $ qname "Contents") (onlyElems page)
          keys = [strContent key | key <- mapMaybe (findElement $ qname "Key") contents]

      case keys of
        [] -> return keys
        ks -> fmap (ks ++) (traverse' (last ks))