{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Network.AWS.RDS.Utils
( generateDbAuthToken
, Endpoint
, Port
, DBUsername
, Region
, regionFromText
)
where
import Prelude hiding ( drop, length )
import Control.Lens ( (^.), (&), (.~) )
import Control.Monad.Trans.AWS ( runResourceT, runAWST )
import Data.ByteString ( ByteString, drop, length )
import Data.ByteString.Char8 ( pack )
import qualified Data.Text as T
import qualified Data.Time.Clock as Clock
import Network.AWS ( _svcPrefix
)
import qualified Network.AWS.RDS as RDS
import Network.AWS.Endpoint ( setEndpoint )
import qualified Network.AWS.Env as Env
import qualified Network.AWS.Request as AWSReq
import qualified Network.AWS.Response as AWSResp
import Network.AWS.Data.Text ( fromText )
import Network.AWS.Data.Path ( ToPath (..)
)
import Network.AWS.Data.Query ( ToQuery (..)
, QueryString ( QList )
)
import Network.AWS.Data.Headers ( ToHeaders (..)
)
import Network.AWS.Presign as Presign
import Network.AWS.Types ( Seconds (..)
, AWSRequest (..)
, Rs
, Service
, Region
)
type Endpoint = String
type Port = Int
type DBUsername = String
type Token = ByteString
tokenExpiration :: Seconds
tokenExpiration :: Seconds
tokenExpiration = Int -> Seconds
Seconds Int
900
serviceSigningName :: ByteString
serviceSigningName :: ByteString
serviceSigningName = ByteString
"rds-db"
thisService :: Service
thisService :: Service
thisService = Service
RDS.rds { _svcPrefix :: ByteString
_svcPrefix = ByteString
serviceSigningName }
dropPrefix :: ByteString -> ByteString
dropPrefix :: ByteString -> ByteString
dropPrefix = Int -> ByteString -> ByteString
drop (Int -> ByteString -> ByteString)
-> Int -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
length ByteString
"https://"
generateDbAuthToken :: Env.Env
-> Endpoint
-> Port
-> DBUsername
-> Region
-> IO Token
generateDbAuthToken :: Env -> Endpoint -> Int -> Endpoint -> Region -> IO ByteString
generateDbAuthToken Env
env Endpoint
endp Int
prt Endpoint
username Region
region = do
let action :: GetDBAuthToken
action = PresignParams -> GetDBAuthToken
GetDBAuthToken (PresignParams -> GetDBAuthToken)
-> PresignParams -> GetDBAuthToken
forall a b. (a -> b) -> a -> b
$ PresignParams :: Endpoint -> Int -> Endpoint -> PresignParams
PresignParams
{ endpoint :: Endpoint
endpoint = Endpoint
endp
, port :: Int
port = Int
prt
, dbUsername :: Endpoint
dbUsername = Endpoint
username
}
regionalEnv :: Env
regionalEnv = Env
env Env -> (Env -> Env) -> Env
forall a b. a -> (a -> b) -> b
& (Region -> Identity Region) -> Env -> Identity Env
forall a. HasEnv a => Lens' a Region
Env.envRegion ((Region -> Identity Region) -> Env -> Identity Env)
-> Region -> Env -> Env
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Region
region
UTCTime
signingTime <- IO UTCTime
Clock.getCurrentTime
ResourceT IO ByteString -> IO ByteString
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO ByteString -> IO ByteString)
-> (AWST' Env (ResourceT IO) ByteString -> ResourceT IO ByteString)
-> AWST' Env (ResourceT IO) ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env
-> AWST' Env (ResourceT IO) ByteString -> ResourceT IO ByteString
forall r (m :: * -> *) a. HasEnv r => r -> AWST' r m a -> m a
runAWST Env
regionalEnv (AWST' Env (ResourceT IO) ByteString -> IO ByteString)
-> AWST' Env (ResourceT IO) ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString
val <- Auth
-> Region
-> UTCTime
-> Seconds
-> GetDBAuthToken
-> AWST' Env (ResourceT IO) ByteString
forall (m :: * -> *) a.
(MonadIO m, AWSRequest a) =>
Auth -> Region -> UTCTime -> Seconds -> a -> m ByteString
Presign.presignURL
(Env
regionalEnv Env -> Getting Auth Env Auth -> Auth
forall s a. s -> Getting a s a -> a
^. Getting Auth Env Auth
forall a. HasEnv a => Lens' a Auth
Env.envAuth)
(Env
regionalEnv Env -> Getting Region Env Region -> Region
forall s a. s -> Getting a s a -> a
^. Getting Region Env Region
forall a. HasEnv a => Lens' a Region
Env.envRegion)
UTCTime
signingTime
Seconds
tokenExpiration
GetDBAuthToken
action
ByteString -> AWST' Env (ResourceT IO) ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> AWST' Env (ResourceT IO) ByteString)
-> ByteString -> AWST' Env (ResourceT IO) ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
dropPrefix ByteString
val
data PresignParams = PresignParams
{ PresignParams -> Endpoint
endpoint :: Endpoint
, PresignParams -> Int
port :: Port
, PresignParams -> Endpoint
dbUsername :: DBUsername
}
newtype GetDBAuthTokenResponse = GetDBAuthTokenResponse ByteString
newtype GetDBAuthToken = GetDBAuthToken PresignParams
instance AWSRequest GetDBAuthToken where
type Rs GetDBAuthToken = GetDBAuthTokenResponse
request :: GetDBAuthToken -> Request GetDBAuthToken
request (GetDBAuthToken PresignParams
params) =
Service -> GetDBAuthToken -> Request GetDBAuthToken
forall a. ToRequest a => Service -> a -> Request a
AWSReq.defaultRequest Service
svc (PresignParams -> GetDBAuthToken
GetDBAuthToken PresignParams
params) where
svc :: Service
svc = Bool -> ByteString -> Int -> Service -> Service
setEndpoint Bool
useHTTPS (Endpoint -> ByteString
pack (Endpoint -> ByteString)
-> (PresignParams -> Endpoint) -> PresignParams -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PresignParams -> Endpoint
endpoint (PresignParams -> ByteString) -> PresignParams -> ByteString
forall a b. (a -> b) -> a -> b
$ PresignParams
params) (PresignParams -> Int
port PresignParams
params) Service
thisService
useHTTPS :: Bool
useHTTPS = Bool
True
response :: Logger
-> Service
-> Proxy GetDBAuthToken
-> ClientResponse
-> m (Response GetDBAuthToken)
response = (Int
-> ResponseHeaders
-> ByteString
-> Either Endpoint (Rs GetDBAuthToken))
-> Logger
-> Service
-> Proxy GetDBAuthToken
-> ClientResponse
-> m (Response GetDBAuthToken)
forall (m :: * -> *) a.
(MonadResource m, MonadThrow m) =>
(Int -> ResponseHeaders -> ByteString -> Either Endpoint (Rs a))
-> Logger -> Service -> Proxy a -> ClientResponse -> m (Response a)
AWSResp.receiveBytes ((Int
-> ResponseHeaders
-> ByteString
-> Either Endpoint (Rs GetDBAuthToken))
-> Logger
-> Service
-> Proxy GetDBAuthToken
-> ClientResponse
-> m (Response GetDBAuthToken))
-> (Int
-> ResponseHeaders
-> ByteString
-> Either Endpoint (Rs GetDBAuthToken))
-> Logger
-> Service
-> Proxy GetDBAuthToken
-> ClientResponse
-> m (Response GetDBAuthToken)
forall a b. (a -> b) -> a -> b
$ \Int
_s ResponseHeaders
_h ByteString
x -> GetDBAuthTokenResponse -> Either Endpoint GetDBAuthTokenResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GetDBAuthTokenResponse -> Either Endpoint GetDBAuthTokenResponse)
-> GetDBAuthTokenResponse -> Either Endpoint GetDBAuthTokenResponse
forall a b. (a -> b) -> a -> b
$ ByteString -> GetDBAuthTokenResponse
GetDBAuthTokenResponse ByteString
x
instance ToPath GetDBAuthToken where
toPath :: GetDBAuthToken -> ByteString
toPath GetDBAuthToken
_ = ByteString
""
instance ToQuery String where
toQuery :: Endpoint -> QueryString
toQuery = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString -> QueryString)
-> (Endpoint -> ByteString) -> Endpoint -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoint -> ByteString
pack
instance ToQuery GetDBAuthToken where
toQuery :: GetDBAuthToken -> QueryString
toQuery (GetDBAuthToken PresignParams
params) = [QueryString] -> QueryString
QList ((Endpoint, Endpoint) -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery ((Endpoint, Endpoint) -> QueryString)
-> [(Endpoint, Endpoint)] -> [QueryString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Endpoint, Endpoint)]
xs) where
xs :: [(String, String)]
xs :: [(Endpoint, Endpoint)]
xs = [(Endpoint
"Action", Endpoint
"connect"), (Endpoint
"DBUser", PresignParams -> Endpoint
dbUsername PresignParams
params)]
instance ToHeaders GetDBAuthToken where
toHeaders :: GetDBAuthToken -> ResponseHeaders
toHeaders GetDBAuthToken
_ = []
regionFromText :: T.Text -> Either String Region
regionFromText :: Text -> Either Endpoint Region
regionFromText = Text -> Either Endpoint Region
forall a. FromText a => Text -> Either Endpoint a
fromText