{-# 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
tokenExpiration = Int -> Seconds
Seconds Int
900  -- 15 minutes

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://"

-- 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 -> Endpoint -> Int -> Endpoint -> Region -> IO ByteString
generateDbAuthToken Env
env Endpoint
endp Int
prt Endpoint
username Region
region = do
    -- it has some overhead, but we're just making sure we're composing a correct URL
    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
                                    }

    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
env (AWST' Env (ResourceT IO) ByteString -> IO ByteString)
-> AWST' Env (ResourceT IO) ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$
        Region
-> AWST' Env (ResourceT IO) ByteString
-> AWST' Env (ResourceT IO) ByteString
forall (m :: * -> *) a. MonadAWS m => Region -> AWS a -> m a
within Region
region (AWST' Env (ResourceT IO) ByteString
 -> AWST' Env (ResourceT IO) ByteString)
-> AWST' Env (ResourceT IO) ByteString
-> AWST' Env (ResourceT 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
env 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
env 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