{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Network.AWS.Easy.Service
( AWSConfig
, Endpoint(..)
, HostName
, Logging(..)
, Port
, awscCredentials
, awscEndpoint
, awscLogging
, awsConfig
, connect
, withAWS
) where
import Control.Lens ((<&>), makeLenses, set)
import Control.Monad.Trans.AWS
( AWST'
, reconfigure
, runAWST
, within
)
import Data.ByteString (ByteString)
import Network.AWS
( Credentials(..)
, Env
, LogLevel(..)
, Region(..)
, Service
, envLogger
, newEnv
, newLogger
, runResourceT
, setEndpoint
)
import Network.AWS.Easy.Classes
import Network.AWS.Easy.Types
import System.IO (stdout)
#if __GLASGOW_HASKELL__ >= 802
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Resource
( MonadUnliftIO
, ResourceT
)
#else
import Control.Monad.Trans.Resource
( MonadBaseControl
, ResourceT
)
#endif
type HostName = ByteString
type Port = Int
data Logging = LoggingEnabled | LoggingDisabled
data Endpoint = AWSRegion Region | Local HostName Port
data AWSConfig = AWSConfig
{ AWSConfig -> Endpoint
_awscEndpoint :: Endpoint
, AWSConfig -> Logging
_awscLogging :: Logging
, AWSConfig -> Credentials
_awscCredentials :: Credentials
}
makeLenses ''AWSConfig
awsConfig :: Endpoint -> AWSConfig
awsConfig :: Endpoint -> AWSConfig
awsConfig Endpoint
endpoint = Endpoint -> Logging -> Credentials -> AWSConfig
AWSConfig Endpoint
endpoint Logging
LoggingDisabled Credentials
Discover
connect :: forall a . ServiceClass a => AWSConfig -> a -> IO (TypedSession a)
connect :: AWSConfig -> a -> IO (TypedSession a)
connect (AWSConfig Endpoint
endpoint Logging
logging Credentials
credentials) a
service = do
let serviceRaw :: Service
serviceRaw = a -> Service
forall a. ServiceClass a => a -> Service
rawService a
service
Env
e <- Logging -> Credentials -> IO Env
mkEnv Logging
logging Credentials
credentials
let (Region
r, Service
s) = Endpoint -> Service -> (Region, Service)
regionService Endpoint
endpoint Service
serviceRaw
Session
session' <- Session -> IO Session
forall (m :: * -> *) a. Monad m => a -> m a
return (Session -> IO Session) -> Session -> IO Session
forall a b. (a -> b) -> a -> b
$ Env -> Region -> Service -> Session
Session Env
e Region
r Service
s
let session :: TypedSession a
session = Session -> TypedSession a
forall a. ServiceClass a => Session -> TypedSession a
wrappedSession @a Session
session'
TypedSession a -> IO (TypedSession a)
forall (m :: * -> *) a. Monad m => a -> m a
return TypedSession a
session
mkEnv :: Logging -> Credentials -> IO Env
mkEnv :: Logging -> Credentials -> IO Env
mkEnv Logging
LoggingEnabled Credentials
c = do
Logger
logger <- LogLevel -> Handle -> IO Logger
forall (m :: * -> *). MonadIO m => LogLevel -> Handle -> m Logger
newLogger LogLevel
Debug Handle
stdout
Credentials -> IO Env
forall (m :: * -> *).
(Applicative m, MonadIO m, MonadCatch m) =>
Credentials -> m Env
newEnv Credentials
c IO Env -> (Env -> Env) -> IO Env
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ASetter Env Env Logger Logger -> Logger -> Env -> Env
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Env Env Logger Logger
forall a. HasEnv a => Lens' a Logger
envLogger Logger
logger
mkEnv Logging
LoggingDisabled Credentials
c = Credentials -> IO Env
forall (m :: * -> *).
(Applicative m, MonadIO m, MonadCatch m) =>
Credentials -> m Env
newEnv Credentials
c
regionService :: Endpoint -> Service -> (Region, Service)
regionService :: Endpoint -> Service -> (Region, Service)
regionService (AWSRegion Region
region) Service
s = (Region
region, Service
s)
regionService (Local HostName
hostName Port
port) Service
s = (Region
NorthVirginia, Bool -> HostName -> Port -> Service -> Service
setEndpoint Bool
False HostName
hostName Port
port Service
s)
#if __GLASGOW_HASKELL__ >= 802
withAWS :: (MonadBaseControl IO m, MonadUnliftIO m, SessionClass b) =>
#else
withAWS :: (MonadBaseControl IO m, SessionClass b) =>
#endif
AWST' Env (ResourceT m) a
-> b
-> m a
withAWS :: AWST' Env (ResourceT m) a -> b -> m a
withAWS AWST' Env (ResourceT m) a
action b
session =
let Session{Env
Region
Service
_sService :: Session -> Service
_sRegion :: Session -> Region
_sEnv :: Session -> Env
_sService :: Service
_sRegion :: Region
_sEnv :: Env
..} = b -> Session
forall a. SessionClass a => a -> Session
rawSession b
session
in
ResourceT m a -> m a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT m a -> m a)
-> (AWST' Env (ResourceT m) a -> ResourceT m a)
-> AWST' Env (ResourceT m) a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> AWST' Env (ResourceT m) a -> ResourceT m a
forall r (m :: * -> *) a. HasEnv r => r -> AWST' r m a -> m a
runAWST Env
_sEnv (AWST' Env (ResourceT m) a -> ResourceT m a)
-> (AWST' Env (ResourceT m) a -> AWST' Env (ResourceT m) a)
-> AWST' Env (ResourceT m) a
-> ResourceT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Region -> AWST' Env (ResourceT m) a -> AWST' Env (ResourceT m) a
forall r (m :: * -> *) a.
(MonadReader r m, HasEnv r) =>
Region -> m a -> m a
within Region
_sRegion (AWST' Env (ResourceT m) a -> m a)
-> AWST' Env (ResourceT m) a -> m a
forall a b. (a -> b) -> a -> b
$ do
Service -> AWST' Env (ResourceT m) a -> AWST' Env (ResourceT m) a
forall r (m :: * -> *) a.
(MonadReader r m, HasEnv r) =>
Service -> m a -> m a
reconfigure Service
_sService AWST' Env (ResourceT m) a
action