amazonka-localstack-repro.cabal

name:                                       amazonka-localstack-repro
version:                                    0.1.0.0
homepage:                                   https://github.com/rcook/amazonka-localstack-repro#readme
author:                                     Richard Cook
maintainer:                                 [email protected]
copyright:                                  2017 Richard Cook
category:                                   Command Line
build-type:                                 Simple
cabal-version:                              >= 1.10

source-repository head
  type:                                     git
  location:                                 https://github.com/rcook/amazonka-localstack-repro.git

executable s3-app
  default-language:                         Haskell2010
  hs-source-dirs:                           .
  main-is:                                  Main.hs
  ghc-options:                              -threaded -rtsopts -with-rtsopts=-N -W -Wall -fwarn-incomplete-patterns -fwarn-unused-imports
  build-depends:                            amazonka
                                          , amazonka-s3
                                          , base >= 4.7 && < 5
                                          , bytestring
                                          , conduit-extra
                                          , lens
                                          , resourcet
                                          , text

Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}

module Main (main) where

import           Control.Exception.Lens (handling)
import           Control.Lens ((<&>), (^.), (.~), (&), set)
import           Control.Monad.Trans.AWS
                    ( AWST'
                    , Credentials(..)
                    , Env
                    , LogLevel(..)
                    , Region(..)
                    , Service
                    , envLogger
                    , newEnv
                    , newLogger
                    , reconfigure
                    , runAWST
                    , runResourceT
                    , setEndpoint
                    , within
                    )
import           Control.Monad.Trans.Resource
                    ( MonadBaseControl
                    , ResourceT
                    )
import           Control.Monad (forM_, void, when)
import           Data.ByteString (ByteString)
import           Data.Monoid ((<>))
import qualified Data.Text.IO as Text (putStrLn)
import           Network.AWS
                    ( await
                    , send
                    )
import           Network.AWS.Data (toText)
import           Network.AWS.S3
                    ( _BucketAlreadyOwnedByYou
                    , BucketName(..)
                    , LocationConstraint(..)
                    , ObjectKey(..)
                    , bucketExists
                    , cbCreateBucketConfiguration
                    , cbcLocationConstraint
                    , createBucketConfiguration
                    , createBucket
                    , headBucket
                    , listObjectsV
                    , lrsContents
                    , oKey
                    , s3
                    )
import           System.IO (stdout)

type HostName = ByteString

type Port = Int

data ServiceEndpoint = AWS Region | Local HostName Port

data S3Info = S3Info
    { env :: Env
    , region :: Region
    , service :: Service
    }

bucketName :: BucketName
bucketName = "mybucket"

getS3Info :: ServiceEndpoint -> IO S3Info
getS3Info serviceEndpoint = do
    logger <- newLogger Debug stdout
    e <- newEnv Discover <&> set envLogger logger
    let (r, s) = regionService serviceEndpoint
    return $ S3Info e r s
    where
        -- Run against a DynamoDB instance running on AWS in specified region
        regionService (AWS region) = (region, s3)
        -- Run against a local DynamoDB instance on a given host and port
        regionService (Local hostName port) = (NorthVirginia, setEndpoint False hostName port s3)

withS3 :: MonadBaseControl IO m =>
    AWST' Env (ResourceT m) a
    -> S3Info
    -> m a
withS3 action S3Info{..} =
    runResourceT . runAWST env . within region $ do
        reconfigure service action

doCreateBucketIfNotExists :: S3Info -> IO ()
doCreateBucketIfNotExists s3Info = (flip withS3) s3Info $ do
    let cbc = createBucketConfiguration
                & cbcLocationConstraint .~ Just (LocationConstraint (region s3Info))
    newlyCreated <- handling _BucketAlreadyOwnedByYou (const (pure False)) $ do
        void $ send $ createBucket bucketName
                        & cbCreateBucketConfiguration .~ Just cbc
        return True
    when newlyCreated (void $ await bucketExists (headBucket bucketName))

doListObjects :: S3Info -> IO [ObjectKey]
doListObjects = withS3 $ do
    result <- send $ listObjectsV bucketName
    return $ [ x ^. oKey | x <- result ^. lrsContents ]

main :: IO ()
main = do
    --s3Info <- getS3Info (AWS Ohio)
    s3Info <- getS3Info (Local "localhost" 4572)

    putStrLn "CreateBucket"
    doCreateBucketIfNotExists s3Info

    putStrLn "ListObjects"
    objectKeys <- doListObjects s3Info
    forM_ objectKeys $ \k ->
        Text.putStrLn $ "  " <> toText k

stack.yaml

resolver: lts-9.14