module Network.AWS.Env
(
newEnv
, newEnvWith
, Env (..)
, HasEnv (..)
, within
, once
, timeout
) where
import Control.Applicative
import Control.Lens
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Retry
import Data.IORef
import Data.Monoid
import Network.AWS.Auth
import Network.AWS.Internal.Logger
import Network.AWS.Types
import Network.HTTP.Conduit
import Prelude
data Env = Env
{ _envRegion :: !Region
, _envLogger :: !Logger
, _envRetryCheck :: !(Int -> HttpException -> IO Bool)
, _envRetryPolicy :: !(Maybe RetryPolicy)
, _envTimeout :: !(Maybe Seconds)
, _envManager :: !Manager
, _envEC2 :: !(IORef (Maybe Bool))
, _envAuth :: !Auth
}
class HasEnv a where
environment :: Lens' a Env
envRegion :: Lens' a Region
envLogger :: Lens' a Logger
envRetryCheck :: Lens' a (Int -> HttpException -> IO Bool)
envRetryPolicy :: Lens' a (Maybe RetryPolicy)
envTimeout :: Lens' a (Maybe Seconds)
envManager :: Lens' a Manager
envAuth :: Lens' a Auth
envEC2 :: Getter a (IORef (Maybe Bool))
envRegion = environment . lens _envRegion (\s a -> s { _envRegion = a })
envLogger = environment . lens _envLogger (\s a -> s { _envLogger = a })
envRetryCheck = environment . lens _envRetryCheck (\s a -> s { _envRetryCheck = a })
envRetryPolicy = environment . lens _envRetryPolicy (\s a -> s { _envRetryPolicy = a })
envTimeout = environment . lens _envTimeout (\s a -> s { _envTimeout = a })
envManager = environment . lens _envManager (\s a -> s { _envManager = a })
envAuth = environment . lens _envAuth (\s a -> s { _envAuth = a })
envEC2 = environment . to _envEC2
instance HasEnv Env where
environment = id
instance ToLog Env where
build Env{..} = b <> "\n" <> build _envAuth
where
b = buildLines
[ "[Amazonka Env] {"
, " region = " <> build _envRegion
, " retry (n=0) = " <> build (join $ ($ 0) . getRetryPolicy <$> _envRetryPolicy)
, " timeout = " <> build _envTimeout
, "}"
]
within :: (MonadReader r m, HasEnv r) => Region -> m a -> m a
within r = local (envRegion .~ r)
once :: (MonadReader r m, HasEnv r) => m a -> m a
once = local $ \e -> e
& envRetryPolicy ?~ limitRetries 0
& envRetryCheck .~ (\_ _ -> return False)
timeout :: (MonadReader r m, HasEnv r) => Seconds -> m a -> m a
timeout s = local (envTimeout ?~ s)
newEnv :: (Applicative m, MonadIO m, MonadCatch m)
=> Region
-> Credentials
-> m Env
newEnv r c = liftIO (newManager conduitManagerSettings)
>>= newEnvWith r c Nothing
newEnvWith :: (Applicative m, MonadIO m, MonadCatch m)
=> Region
-> Credentials
-> Maybe Bool
-> Manager
-> m Env
newEnvWith r c p m = Env r logger check Nothing Nothing m
<$> liftIO (newIORef p)
<*> getAuth m c
where
logger _ _ = return ()
check _ _ = return True