{-# 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.Glue.UpdatePartition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a partition.
module Amazonka.Glue.UpdatePartition
  ( -- * Creating a Request
    UpdatePartition (..),
    newUpdatePartition,

    -- * Request Lenses
    updatePartition_catalogId,
    updatePartition_databaseName,
    updatePartition_tableName,
    updatePartition_partitionValueList,
    updatePartition_partitionInput,

    -- * Destructuring the Response
    UpdatePartitionResponse (..),
    newUpdatePartitionResponse,

    -- * Response Lenses
    updatePartitionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdatePartition' smart constructor.
data UpdatePartition = UpdatePartition'
  { -- | The ID of the Data Catalog where the partition to be updated resides. If
    -- none is provided, the Amazon Web Services account ID is used by default.
    UpdatePartition -> Maybe Text
catalogId :: Prelude.Maybe Prelude.Text,
    -- | The name of the catalog database in which the table in question resides.
    UpdatePartition -> Text
databaseName :: Prelude.Text,
    -- | The name of the table in which the partition to be updated is located.
    UpdatePartition -> Text
tableName :: Prelude.Text,
    -- | List of partition key values that define the partition to update.
    UpdatePartition -> [Text]
partitionValueList :: [Prelude.Text],
    -- | The new partition object to update the partition to.
    --
    -- The @Values@ property can\'t be changed. If you want to change the
    -- partition key values for a partition, delete and recreate the partition.
    UpdatePartition -> PartitionInput
partitionInput :: PartitionInput
  }
  deriving (UpdatePartition -> UpdatePartition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePartition -> UpdatePartition -> Bool
$c/= :: UpdatePartition -> UpdatePartition -> Bool
== :: UpdatePartition -> UpdatePartition -> Bool
$c== :: UpdatePartition -> UpdatePartition -> Bool
Prelude.Eq, ReadPrec [UpdatePartition]
ReadPrec UpdatePartition
Int -> ReadS UpdatePartition
ReadS [UpdatePartition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePartition]
$creadListPrec :: ReadPrec [UpdatePartition]
readPrec :: ReadPrec UpdatePartition
$creadPrec :: ReadPrec UpdatePartition
readList :: ReadS [UpdatePartition]
$creadList :: ReadS [UpdatePartition]
readsPrec :: Int -> ReadS UpdatePartition
$creadsPrec :: Int -> ReadS UpdatePartition
Prelude.Read, Int -> UpdatePartition -> ShowS
[UpdatePartition] -> ShowS
UpdatePartition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePartition] -> ShowS
$cshowList :: [UpdatePartition] -> ShowS
show :: UpdatePartition -> String
$cshow :: UpdatePartition -> String
showsPrec :: Int -> UpdatePartition -> ShowS
$cshowsPrec :: Int -> UpdatePartition -> ShowS
Prelude.Show, forall x. Rep UpdatePartition x -> UpdatePartition
forall x. UpdatePartition -> Rep UpdatePartition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePartition x -> UpdatePartition
$cfrom :: forall x. UpdatePartition -> Rep UpdatePartition x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePartition' 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:
--
-- 'catalogId', 'updatePartition_catalogId' - The ID of the Data Catalog where the partition to be updated resides. If
-- none is provided, the Amazon Web Services account ID is used by default.
--
-- 'databaseName', 'updatePartition_databaseName' - The name of the catalog database in which the table in question resides.
--
-- 'tableName', 'updatePartition_tableName' - The name of the table in which the partition to be updated is located.
--
-- 'partitionValueList', 'updatePartition_partitionValueList' - List of partition key values that define the partition to update.
--
-- 'partitionInput', 'updatePartition_partitionInput' - The new partition object to update the partition to.
--
-- The @Values@ property can\'t be changed. If you want to change the
-- partition key values for a partition, delete and recreate the partition.
newUpdatePartition ::
  -- | 'databaseName'
  Prelude.Text ->
  -- | 'tableName'
  Prelude.Text ->
  -- | 'partitionInput'
  PartitionInput ->
  UpdatePartition
newUpdatePartition :: Text -> Text -> PartitionInput -> UpdatePartition
newUpdatePartition
  Text
pDatabaseName_
  Text
pTableName_
  PartitionInput
pPartitionInput_ =
    UpdatePartition'
      { $sel:catalogId:UpdatePartition' :: Maybe Text
catalogId = forall a. Maybe a
Prelude.Nothing,
        $sel:databaseName:UpdatePartition' :: Text
databaseName = Text
pDatabaseName_,
        $sel:tableName:UpdatePartition' :: Text
tableName = Text
pTableName_,
        $sel:partitionValueList:UpdatePartition' :: [Text]
partitionValueList = forall a. Monoid a => a
Prelude.mempty,
        $sel:partitionInput:UpdatePartition' :: PartitionInput
partitionInput = PartitionInput
pPartitionInput_
      }

-- | The ID of the Data Catalog where the partition to be updated resides. If
-- none is provided, the Amazon Web Services account ID is used by default.
updatePartition_catalogId :: Lens.Lens' UpdatePartition (Prelude.Maybe Prelude.Text)
updatePartition_catalogId :: Lens' UpdatePartition (Maybe Text)
updatePartition_catalogId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePartition' {Maybe Text
catalogId :: Maybe Text
$sel:catalogId:UpdatePartition' :: UpdatePartition -> Maybe Text
catalogId} -> Maybe Text
catalogId) (\s :: UpdatePartition
s@UpdatePartition' {} Maybe Text
a -> UpdatePartition
s {$sel:catalogId:UpdatePartition' :: Maybe Text
catalogId = Maybe Text
a} :: UpdatePartition)

-- | The name of the catalog database in which the table in question resides.
updatePartition_databaseName :: Lens.Lens' UpdatePartition Prelude.Text
updatePartition_databaseName :: Lens' UpdatePartition Text
updatePartition_databaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePartition' {Text
databaseName :: Text
$sel:databaseName:UpdatePartition' :: UpdatePartition -> Text
databaseName} -> Text
databaseName) (\s :: UpdatePartition
s@UpdatePartition' {} Text
a -> UpdatePartition
s {$sel:databaseName:UpdatePartition' :: Text
databaseName = Text
a} :: UpdatePartition)

-- | The name of the table in which the partition to be updated is located.
updatePartition_tableName :: Lens.Lens' UpdatePartition Prelude.Text
updatePartition_tableName :: Lens' UpdatePartition Text
updatePartition_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePartition' {Text
tableName :: Text
$sel:tableName:UpdatePartition' :: UpdatePartition -> Text
tableName} -> Text
tableName) (\s :: UpdatePartition
s@UpdatePartition' {} Text
a -> UpdatePartition
s {$sel:tableName:UpdatePartition' :: Text
tableName = Text
a} :: UpdatePartition)

-- | List of partition key values that define the partition to update.
updatePartition_partitionValueList :: Lens.Lens' UpdatePartition [Prelude.Text]
updatePartition_partitionValueList :: Lens' UpdatePartition [Text]
updatePartition_partitionValueList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePartition' {[Text]
partitionValueList :: [Text]
$sel:partitionValueList:UpdatePartition' :: UpdatePartition -> [Text]
partitionValueList} -> [Text]
partitionValueList) (\s :: UpdatePartition
s@UpdatePartition' {} [Text]
a -> UpdatePartition
s {$sel:partitionValueList:UpdatePartition' :: [Text]
partitionValueList = [Text]
a} :: UpdatePartition) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The new partition object to update the partition to.
--
-- The @Values@ property can\'t be changed. If you want to change the
-- partition key values for a partition, delete and recreate the partition.
updatePartition_partitionInput :: Lens.Lens' UpdatePartition PartitionInput
updatePartition_partitionInput :: Lens' UpdatePartition PartitionInput
updatePartition_partitionInput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePartition' {PartitionInput
partitionInput :: PartitionInput
$sel:partitionInput:UpdatePartition' :: UpdatePartition -> PartitionInput
partitionInput} -> PartitionInput
partitionInput) (\s :: UpdatePartition
s@UpdatePartition' {} PartitionInput
a -> UpdatePartition
s {$sel:partitionInput:UpdatePartition' :: PartitionInput
partitionInput = PartitionInput
a} :: UpdatePartition)

instance Core.AWSRequest UpdatePartition where
  type
    AWSResponse UpdatePartition =
      UpdatePartitionResponse
  request :: (Service -> Service) -> UpdatePartition -> Request UpdatePartition
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 UpdatePartition
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdatePartition)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdatePartitionResponse
UpdatePartitionResponse'
            forall (f :: * -> *) a b. Functor 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 UpdatePartition where
  hashWithSalt :: Int -> UpdatePartition -> Int
hashWithSalt Int
_salt UpdatePartition' {[Text]
Maybe Text
Text
PartitionInput
partitionInput :: PartitionInput
partitionValueList :: [Text]
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:partitionInput:UpdatePartition' :: UpdatePartition -> PartitionInput
$sel:partitionValueList:UpdatePartition' :: UpdatePartition -> [Text]
$sel:tableName:UpdatePartition' :: UpdatePartition -> Text
$sel:databaseName:UpdatePartition' :: UpdatePartition -> Text
$sel:catalogId:UpdatePartition' :: UpdatePartition -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
catalogId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
databaseName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
partitionValueList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PartitionInput
partitionInput

instance Prelude.NFData UpdatePartition where
  rnf :: UpdatePartition -> ()
rnf UpdatePartition' {[Text]
Maybe Text
Text
PartitionInput
partitionInput :: PartitionInput
partitionValueList :: [Text]
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:partitionInput:UpdatePartition' :: UpdatePartition -> PartitionInput
$sel:partitionValueList:UpdatePartition' :: UpdatePartition -> [Text]
$sel:tableName:UpdatePartition' :: UpdatePartition -> Text
$sel:databaseName:UpdatePartition' :: UpdatePartition -> Text
$sel:catalogId:UpdatePartition' :: UpdatePartition -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
catalogId
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
tableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
partitionValueList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PartitionInput
partitionInput

instance Data.ToHeaders UpdatePartition where
  toHeaders :: UpdatePartition -> 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
"AWSGlue.UpdatePartition" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdatePartition where
  toJSON :: UpdatePartition -> Value
toJSON UpdatePartition' {[Text]
Maybe Text
Text
PartitionInput
partitionInput :: PartitionInput
partitionValueList :: [Text]
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:partitionInput:UpdatePartition' :: UpdatePartition -> PartitionInput
$sel:partitionValueList:UpdatePartition' :: UpdatePartition -> [Text]
$sel:tableName:UpdatePartition' :: UpdatePartition -> Text
$sel:databaseName:UpdatePartition' :: UpdatePartition -> Text
$sel:catalogId:UpdatePartition' :: UpdatePartition -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CatalogId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
catalogId,
            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
"TableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
tableName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"PartitionValueList" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
partitionValueList),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"PartitionInput" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PartitionInput
partitionInput)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdatePartitionResponse' 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:
--
-- 'httpStatus', 'updatePartitionResponse_httpStatus' - The response's http status code.
newUpdatePartitionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdatePartitionResponse
newUpdatePartitionResponse :: Int -> UpdatePartitionResponse
newUpdatePartitionResponse Int
pHttpStatus_ =
  UpdatePartitionResponse' {$sel:httpStatus:UpdatePartitionResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData UpdatePartitionResponse where
  rnf :: UpdatePartitionResponse -> ()
rnf UpdatePartitionResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdatePartitionResponse' :: UpdatePartitionResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus