1{-# LANGUAGE OverloadedStrings #-}
2
3import qualified Aws
4import qualified Aws.S3 as S3
5import qualified Data.Conduit as C
6import qualified Data.Conduit.List as CL
7import           Data.Text (pack)
8import           Control.Monad ((<=<))
9import           Control.Monad.IO.Class (liftIO)
10import           Control.Monad.Trans.Resource
11import           Network.HTTP.Conduit (newManager, tlsManagerSettings, responseBody)
12import           System.Environment (getArgs)
13
14main :: IO ()
15main = do
16  [bucket] <- fmap (map pack) getArgs
17
18  {- Set up AWS credentials and the default configuration. -}
19  cfg <- Aws.baseConfiguration
20  let s3cfg = Aws.defServiceConfig :: S3.S3Configuration Aws.NormalQuery
21
22  {- Set up a ResourceT region with an available HTTP manager. -}
23  mgr <- newManager tlsManagerSettings
24  runResourceT $ do
25    let src = Aws.awsIteratedSource cfg s3cfg mgr (S3.getBucket bucket)
26    let deleteObjects [] = return ()
27        deleteObjects os =
28          do
29            let keys = map S3.objectKey os
30            liftIO $ putStrLn ("Deleting objects: " ++ show keys)
31            _ <- Aws.pureAws cfg s3cfg mgr (S3.deleteObjects bucket (map S3.objectKey os))
32            return ()
33    src C.$$ CL.mapM_ (deleteObjects . S3.gbrContents <=< Aws.readResponseIO)
34    liftIO $ putStrLn ("Deleting bucket: " ++ show bucket)
35    _ <- Aws.pureAws cfg s3cfg mgr (S3.DeleteBucket bucket)
36    return ()
37