{-# LANGUAGE TypeFamilies #-} -- required for 'Rs'
{-# LANGUAGE FlexibleInstances #-} -- required for ToQuery String
{-# 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
, within
)
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 900 -- 15 minutes
serviceSigningName :: ByteString
serviceSigningName = "rds-db"
thisService :: Service
thisService = RDS.rds { _svcPrefix = serviceSigningName }
dropPrefix :: ByteString -> ByteString
dropPrefix = drop $ length "https://"
-- Amazon docs: https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/UsingWithRDS.IAMDBAuth.html
-- Python implementation: https://github.com/boto/botocore/blob/77527250093fc97cbf078adab04bdd74b1fd3c03/botocore/signers.py#L409
-- Go implementation: https://github.com/aws/aws-sdk-go/blob/e2d6cb448883e4f4fcc5246650f89bde349041ec/service/rds/rdsutils/connect.go#L36-L67
-- | Generates RDS auth token that can be used as a temporary password for Postgres connections.
generateDbAuthToken :: Env.Env
-> Endpoint
-> Port
-> DBUsername
-> Region
-> IO Token
generateDbAuthToken env endp prt username region = do
-- it has some overhead, but we're just making sure we're composing a correct URL
let action = GetDBAuthToken $ PresignParams
{ endpoint = endp
, port = prt
, dbUsername = username
}
signingTime <- Clock.getCurrentTime
runResourceT . runAWST env $
within region $ do
val <- Presign.presignURL
(env ^. Env.envAuth)
(env ^. Env.envRegion)
signingTime
tokenExpiration
action
pure $ dropPrefix val
data PresignParams = PresignParams
{ endpoint :: Endpoint
, port :: Port
, dbUsername :: DBUsername
}
newtype GetDBAuthTokenResponse = GetDBAuthTokenResponse ByteString
newtype GetDBAuthToken = GetDBAuthToken PresignParams
instance AWSRequest GetDBAuthToken where
type Rs GetDBAuthToken = GetDBAuthTokenResponse
request (GetDBAuthToken params) =
AWSReq.defaultRequest svc (GetDBAuthToken params) where
svc = setEndpoint useHTTPS (pack . endpoint $ params) (port params) thisService
useHTTPS = True
response = AWSResp.receiveBytes $ \_s _h x -> pure $ GetDBAuthTokenResponse x
instance ToPath GetDBAuthToken where
toPath _ = ""
instance ToQuery String where
toQuery = toQuery . pack
instance ToQuery GetDBAuthToken where
toQuery (GetDBAuthToken params) = QList (toQuery <$> xs) where
xs :: [(String, String)]
xs = [("Action", "connect"), ("DBUser", dbUsername params)]
instance ToHeaders GetDBAuthToken where
toHeaders _ = []
regionFromText :: T.Text -> Either String Region
regionFromText = fromText