{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.TimeStreamWrite.UpdateDatabase
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the KMS key for an existing database. While updating the
-- database, you must specify the database name and the identifier of the
-- new KMS key to be used (@KmsKeyId@). If there are any concurrent
-- @UpdateDatabase@ requests, first writer wins.
--
-- See
-- <https://docs.aws.amazon.com/timestream/latest/developerguide/code-samples.update-db.html code sample>
-- for details.
module Amazonka.TimeStreamWrite.UpdateDatabase
  ( -- * Creating a Request
    UpdateDatabase (..),
    newUpdateDatabase,

    -- * Request Lenses
    updateDatabase_databaseName,
    updateDatabase_kmsKeyId,

    -- * Destructuring the Response
    UpdateDatabaseResponse (..),
    newUpdateDatabaseResponse,

    -- * Response Lenses
    updateDatabaseResponse_database,
    updateDatabaseResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.TimeStreamWrite.Types

-- | /See:/ 'newUpdateDatabase' smart constructor.
data UpdateDatabase = UpdateDatabase'
  { -- | The name of the database.
    UpdateDatabase -> Text
databaseName :: Prelude.Text,
    -- | The identifier of the new KMS key (@KmsKeyId@) to be used to encrypt the
    -- data stored in the database. If the @KmsKeyId@ currently registered with
    -- the database is the same as the @KmsKeyId@ in the request, there will
    -- not be any update.
    --
    -- You can specify the @KmsKeyId@ using any of the following:
    --
    -- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- -   Key ARN:
    --     @arn:aws:kms:us-east-1:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- -   Alias name: @alias\/ExampleAlias@
    --
    -- -   Alias ARN: @arn:aws:kms:us-east-1:111122223333:alias\/ExampleAlias@
    UpdateDatabase -> Text
kmsKeyId :: Prelude.Text
  }
  deriving (UpdateDatabase -> UpdateDatabase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDatabase -> UpdateDatabase -> Bool
$c/= :: UpdateDatabase -> UpdateDatabase -> Bool
== :: UpdateDatabase -> UpdateDatabase -> Bool
$c== :: UpdateDatabase -> UpdateDatabase -> Bool
Prelude.Eq, ReadPrec [UpdateDatabase]
ReadPrec UpdateDatabase
Int -> ReadS UpdateDatabase
ReadS [UpdateDatabase]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDatabase]
$creadListPrec :: ReadPrec [UpdateDatabase]
readPrec :: ReadPrec UpdateDatabase
$creadPrec :: ReadPrec UpdateDatabase
readList :: ReadS [UpdateDatabase]
$creadList :: ReadS [UpdateDatabase]
readsPrec :: Int -> ReadS UpdateDatabase
$creadsPrec :: Int -> ReadS UpdateDatabase
Prelude.Read, Int -> UpdateDatabase -> ShowS
[UpdateDatabase] -> ShowS
UpdateDatabase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDatabase] -> ShowS
$cshowList :: [UpdateDatabase] -> ShowS
show :: UpdateDatabase -> String
$cshow :: UpdateDatabase -> String
showsPrec :: Int -> UpdateDatabase -> ShowS
$cshowsPrec :: Int -> UpdateDatabase -> ShowS
Prelude.Show, forall x. Rep UpdateDatabase x -> UpdateDatabase
forall x. UpdateDatabase -> Rep UpdateDatabase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDatabase x -> UpdateDatabase
$cfrom :: forall x. UpdateDatabase -> Rep UpdateDatabase x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDatabase' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'databaseName', 'updateDatabase_databaseName' - The name of the database.
--
-- 'kmsKeyId', 'updateDatabase_kmsKeyId' - The identifier of the new KMS key (@KmsKeyId@) to be used to encrypt the
-- data stored in the database. If the @KmsKeyId@ currently registered with
-- the database is the same as the @KmsKeyId@ in the request, there will
-- not be any update.
--
-- You can specify the @KmsKeyId@ using any of the following:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-east-1:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Alias name: @alias\/ExampleAlias@
--
-- -   Alias ARN: @arn:aws:kms:us-east-1:111122223333:alias\/ExampleAlias@
newUpdateDatabase ::
  -- | 'databaseName'
  Prelude.Text ->
  -- | 'kmsKeyId'
  Prelude.Text ->
  UpdateDatabase
newUpdateDatabase :: Text -> Text -> UpdateDatabase
newUpdateDatabase Text
pDatabaseName_ Text
pKmsKeyId_ =
  UpdateDatabase'
    { $sel:databaseName:UpdateDatabase' :: Text
databaseName = Text
pDatabaseName_,
      $sel:kmsKeyId:UpdateDatabase' :: Text
kmsKeyId = Text
pKmsKeyId_
    }

-- | The name of the database.
updateDatabase_databaseName :: Lens.Lens' UpdateDatabase Prelude.Text
updateDatabase_databaseName :: Lens' UpdateDatabase Text
updateDatabase_databaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDatabase' {Text
databaseName :: Text
$sel:databaseName:UpdateDatabase' :: UpdateDatabase -> Text
databaseName} -> Text
databaseName) (\s :: UpdateDatabase
s@UpdateDatabase' {} Text
a -> UpdateDatabase
s {$sel:databaseName:UpdateDatabase' :: Text
databaseName = Text
a} :: UpdateDatabase)

-- | The identifier of the new KMS key (@KmsKeyId@) to be used to encrypt the
-- data stored in the database. If the @KmsKeyId@ currently registered with
-- the database is the same as the @KmsKeyId@ in the request, there will
-- not be any update.
--
-- You can specify the @KmsKeyId@ using any of the following:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-east-1:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Alias name: @alias\/ExampleAlias@
--
-- -   Alias ARN: @arn:aws:kms:us-east-1:111122223333:alias\/ExampleAlias@
updateDatabase_kmsKeyId :: Lens.Lens' UpdateDatabase Prelude.Text
updateDatabase_kmsKeyId :: Lens' UpdateDatabase Text
updateDatabase_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDatabase' {Text
kmsKeyId :: Text
$sel:kmsKeyId:UpdateDatabase' :: UpdateDatabase -> Text
kmsKeyId} -> Text
kmsKeyId) (\s :: UpdateDatabase
s@UpdateDatabase' {} Text
a -> UpdateDatabase
s {$sel:kmsKeyId:UpdateDatabase' :: Text
kmsKeyId = Text
a} :: UpdateDatabase)

instance Core.AWSRequest UpdateDatabase where
  type
    AWSResponse UpdateDatabase =
      UpdateDatabaseResponse
  request :: (Service -> Service) -> UpdateDatabase -> Request UpdateDatabase
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateDatabase
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateDatabase)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Database -> Int -> UpdateDatabaseResponse
UpdateDatabaseResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Database")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateDatabase where
  hashWithSalt :: Int -> UpdateDatabase -> Int
hashWithSalt Int
_salt UpdateDatabase' {Text
kmsKeyId :: Text
databaseName :: Text
$sel:kmsKeyId:UpdateDatabase' :: UpdateDatabase -> Text
$sel:databaseName:UpdateDatabase' :: UpdateDatabase -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
databaseName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
kmsKeyId

instance Prelude.NFData UpdateDatabase where
  rnf :: UpdateDatabase -> ()
rnf UpdateDatabase' {Text
kmsKeyId :: Text
databaseName :: Text
$sel:kmsKeyId:UpdateDatabase' :: UpdateDatabase -> Text
$sel:databaseName:UpdateDatabase' :: UpdateDatabase -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
databaseName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
kmsKeyId

instance Data.ToHeaders UpdateDatabase where
  toHeaders :: UpdateDatabase -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Timestream_20181101.UpdateDatabase" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateDatabase where
  toJSON :: UpdateDatabase -> Value
toJSON UpdateDatabase' {Text
kmsKeyId :: Text
databaseName :: Text
$sel:kmsKeyId:UpdateDatabase' :: UpdateDatabase -> Text
$sel:databaseName:UpdateDatabase' :: UpdateDatabase -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"DatabaseName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
databaseName),
            forall a. a -> Maybe a
Prelude.Just (Key
"KmsKeyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
kmsKeyId)
          ]
      )

instance Data.ToPath UpdateDatabase where
  toPath :: UpdateDatabase -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery UpdateDatabase where
  toQuery :: UpdateDatabase -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newUpdateDatabaseResponse' smart constructor.
data UpdateDatabaseResponse = UpdateDatabaseResponse'
  { UpdateDatabaseResponse -> Maybe Database
database :: Prelude.Maybe Database,
    -- | The response's http status code.
    UpdateDatabaseResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateDatabaseResponse -> UpdateDatabaseResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDatabaseResponse -> UpdateDatabaseResponse -> Bool
$c/= :: UpdateDatabaseResponse -> UpdateDatabaseResponse -> Bool
== :: UpdateDatabaseResponse -> UpdateDatabaseResponse -> Bool
$c== :: UpdateDatabaseResponse -> UpdateDatabaseResponse -> Bool
Prelude.Eq, ReadPrec [UpdateDatabaseResponse]
ReadPrec UpdateDatabaseResponse
Int -> ReadS UpdateDatabaseResponse
ReadS [UpdateDatabaseResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDatabaseResponse]
$creadListPrec :: ReadPrec [UpdateDatabaseResponse]
readPrec :: ReadPrec UpdateDatabaseResponse
$creadPrec :: ReadPrec UpdateDatabaseResponse
readList :: ReadS [UpdateDatabaseResponse]
$creadList :: ReadS [UpdateDatabaseResponse]
readsPrec :: Int -> ReadS UpdateDatabaseResponse
$creadsPrec :: Int -> ReadS UpdateDatabaseResponse
Prelude.Read, Int -> UpdateDatabaseResponse -> ShowS
[UpdateDatabaseResponse] -> ShowS
UpdateDatabaseResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDatabaseResponse] -> ShowS
$cshowList :: [UpdateDatabaseResponse] -> ShowS
show :: UpdateDatabaseResponse -> String
$cshow :: UpdateDatabaseResponse -> String
showsPrec :: Int -> UpdateDatabaseResponse -> ShowS
$cshowsPrec :: Int -> UpdateDatabaseResponse -> ShowS
Prelude.Show, forall x. Rep UpdateDatabaseResponse x -> UpdateDatabaseResponse
forall x. UpdateDatabaseResponse -> Rep UpdateDatabaseResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDatabaseResponse x -> UpdateDatabaseResponse
$cfrom :: forall x. UpdateDatabaseResponse -> Rep UpdateDatabaseResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDatabaseResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'database', 'updateDatabaseResponse_database' - Undocumented member.
--
-- 'httpStatus', 'updateDatabaseResponse_httpStatus' - The response's http status code.
newUpdateDatabaseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDatabaseResponse
newUpdateDatabaseResponse :: Int -> UpdateDatabaseResponse
newUpdateDatabaseResponse Int
pHttpStatus_ =
  UpdateDatabaseResponse'
    { $sel:database:UpdateDatabaseResponse' :: Maybe Database
database = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDatabaseResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
updateDatabaseResponse_database :: Lens.Lens' UpdateDatabaseResponse (Prelude.Maybe Database)
updateDatabaseResponse_database :: Lens' UpdateDatabaseResponse (Maybe Database)
updateDatabaseResponse_database = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDatabaseResponse' {Maybe Database
database :: Maybe Database
$sel:database:UpdateDatabaseResponse' :: UpdateDatabaseResponse -> Maybe Database
database} -> Maybe Database
database) (\s :: UpdateDatabaseResponse
s@UpdateDatabaseResponse' {} Maybe Database
a -> UpdateDatabaseResponse
s {$sel:database:UpdateDatabaseResponse' :: Maybe Database
database = Maybe Database
a} :: UpdateDatabaseResponse)

-- | The response's http status code.
updateDatabaseResponse_httpStatus :: Lens.Lens' UpdateDatabaseResponse Prelude.Int
updateDatabaseResponse_httpStatus :: Lens' UpdateDatabaseResponse Int
updateDatabaseResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDatabaseResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateDatabaseResponse' :: UpdateDatabaseResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateDatabaseResponse
s@UpdateDatabaseResponse' {} Int
a -> UpdateDatabaseResponse
s {$sel:httpStatus:UpdateDatabaseResponse' :: Int
httpStatus = Int
a} :: UpdateDatabaseResponse)

instance Prelude.NFData UpdateDatabaseResponse where
  rnf :: UpdateDatabaseResponse -> ()
rnf UpdateDatabaseResponse' {Int
Maybe Database
httpStatus :: Int
database :: Maybe Database
$sel:httpStatus:UpdateDatabaseResponse' :: UpdateDatabaseResponse -> Int
$sel:database:UpdateDatabaseResponse' :: UpdateDatabaseResponse -> Maybe Database
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Database
database
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus