{-# 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.CreatePartitionIndex
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a specified partition index in an existing table.
module Amazonka.Glue.CreatePartitionIndex
  ( -- * Creating a Request
    CreatePartitionIndex (..),
    newCreatePartitionIndex,

    -- * Request Lenses
    createPartitionIndex_catalogId,
    createPartitionIndex_databaseName,
    createPartitionIndex_tableName,
    createPartitionIndex_partitionIndex,

    -- * Destructuring the Response
    CreatePartitionIndexResponse (..),
    newCreatePartitionIndexResponse,

    -- * Response Lenses
    createPartitionIndexResponse_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:/ 'newCreatePartitionIndex' smart constructor.
data CreatePartitionIndex = CreatePartitionIndex'
  { -- | The catalog ID where the table resides.
    CreatePartitionIndex -> Maybe Text
catalogId :: Prelude.Maybe Prelude.Text,
    -- | Specifies the name of a database in which you want to create a partition
    -- index.
    CreatePartitionIndex -> Text
databaseName :: Prelude.Text,
    -- | Specifies the name of a table in which you want to create a partition
    -- index.
    CreatePartitionIndex -> Text
tableName :: Prelude.Text,
    -- | Specifies a @PartitionIndex@ structure to create a partition index in an
    -- existing table.
    CreatePartitionIndex -> PartitionIndex
partitionIndex :: PartitionIndex
  }
  deriving (CreatePartitionIndex -> CreatePartitionIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePartitionIndex -> CreatePartitionIndex -> Bool
$c/= :: CreatePartitionIndex -> CreatePartitionIndex -> Bool
== :: CreatePartitionIndex -> CreatePartitionIndex -> Bool
$c== :: CreatePartitionIndex -> CreatePartitionIndex -> Bool
Prelude.Eq, ReadPrec [CreatePartitionIndex]
ReadPrec CreatePartitionIndex
Int -> ReadS CreatePartitionIndex
ReadS [CreatePartitionIndex]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePartitionIndex]
$creadListPrec :: ReadPrec [CreatePartitionIndex]
readPrec :: ReadPrec CreatePartitionIndex
$creadPrec :: ReadPrec CreatePartitionIndex
readList :: ReadS [CreatePartitionIndex]
$creadList :: ReadS [CreatePartitionIndex]
readsPrec :: Int -> ReadS CreatePartitionIndex
$creadsPrec :: Int -> ReadS CreatePartitionIndex
Prelude.Read, Int -> CreatePartitionIndex -> ShowS
[CreatePartitionIndex] -> ShowS
CreatePartitionIndex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePartitionIndex] -> ShowS
$cshowList :: [CreatePartitionIndex] -> ShowS
show :: CreatePartitionIndex -> String
$cshow :: CreatePartitionIndex -> String
showsPrec :: Int -> CreatePartitionIndex -> ShowS
$cshowsPrec :: Int -> CreatePartitionIndex -> ShowS
Prelude.Show, forall x. Rep CreatePartitionIndex x -> CreatePartitionIndex
forall x. CreatePartitionIndex -> Rep CreatePartitionIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePartitionIndex x -> CreatePartitionIndex
$cfrom :: forall x. CreatePartitionIndex -> Rep CreatePartitionIndex x
Prelude.Generic)

-- |
-- Create a value of 'CreatePartitionIndex' 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', 'createPartitionIndex_catalogId' - The catalog ID where the table resides.
--
-- 'databaseName', 'createPartitionIndex_databaseName' - Specifies the name of a database in which you want to create a partition
-- index.
--
-- 'tableName', 'createPartitionIndex_tableName' - Specifies the name of a table in which you want to create a partition
-- index.
--
-- 'partitionIndex', 'createPartitionIndex_partitionIndex' - Specifies a @PartitionIndex@ structure to create a partition index in an
-- existing table.
newCreatePartitionIndex ::
  -- | 'databaseName'
  Prelude.Text ->
  -- | 'tableName'
  Prelude.Text ->
  -- | 'partitionIndex'
  PartitionIndex ->
  CreatePartitionIndex
newCreatePartitionIndex :: Text -> Text -> PartitionIndex -> CreatePartitionIndex
newCreatePartitionIndex
  Text
pDatabaseName_
  Text
pTableName_
  PartitionIndex
pPartitionIndex_ =
    CreatePartitionIndex'
      { $sel:catalogId:CreatePartitionIndex' :: Maybe Text
catalogId = forall a. Maybe a
Prelude.Nothing,
        $sel:databaseName:CreatePartitionIndex' :: Text
databaseName = Text
pDatabaseName_,
        $sel:tableName:CreatePartitionIndex' :: Text
tableName = Text
pTableName_,
        $sel:partitionIndex:CreatePartitionIndex' :: PartitionIndex
partitionIndex = PartitionIndex
pPartitionIndex_
      }

-- | The catalog ID where the table resides.
createPartitionIndex_catalogId :: Lens.Lens' CreatePartitionIndex (Prelude.Maybe Prelude.Text)
createPartitionIndex_catalogId :: Lens' CreatePartitionIndex (Maybe Text)
createPartitionIndex_catalogId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePartitionIndex' {Maybe Text
catalogId :: Maybe Text
$sel:catalogId:CreatePartitionIndex' :: CreatePartitionIndex -> Maybe Text
catalogId} -> Maybe Text
catalogId) (\s :: CreatePartitionIndex
s@CreatePartitionIndex' {} Maybe Text
a -> CreatePartitionIndex
s {$sel:catalogId:CreatePartitionIndex' :: Maybe Text
catalogId = Maybe Text
a} :: CreatePartitionIndex)

-- | Specifies the name of a database in which you want to create a partition
-- index.
createPartitionIndex_databaseName :: Lens.Lens' CreatePartitionIndex Prelude.Text
createPartitionIndex_databaseName :: Lens' CreatePartitionIndex Text
createPartitionIndex_databaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePartitionIndex' {Text
databaseName :: Text
$sel:databaseName:CreatePartitionIndex' :: CreatePartitionIndex -> Text
databaseName} -> Text
databaseName) (\s :: CreatePartitionIndex
s@CreatePartitionIndex' {} Text
a -> CreatePartitionIndex
s {$sel:databaseName:CreatePartitionIndex' :: Text
databaseName = Text
a} :: CreatePartitionIndex)

-- | Specifies the name of a table in which you want to create a partition
-- index.
createPartitionIndex_tableName :: Lens.Lens' CreatePartitionIndex Prelude.Text
createPartitionIndex_tableName :: Lens' CreatePartitionIndex Text
createPartitionIndex_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePartitionIndex' {Text
tableName :: Text
$sel:tableName:CreatePartitionIndex' :: CreatePartitionIndex -> Text
tableName} -> Text
tableName) (\s :: CreatePartitionIndex
s@CreatePartitionIndex' {} Text
a -> CreatePartitionIndex
s {$sel:tableName:CreatePartitionIndex' :: Text
tableName = Text
a} :: CreatePartitionIndex)

-- | Specifies a @PartitionIndex@ structure to create a partition index in an
-- existing table.
createPartitionIndex_partitionIndex :: Lens.Lens' CreatePartitionIndex PartitionIndex
createPartitionIndex_partitionIndex :: Lens' CreatePartitionIndex PartitionIndex
createPartitionIndex_partitionIndex = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePartitionIndex' {PartitionIndex
partitionIndex :: PartitionIndex
$sel:partitionIndex:CreatePartitionIndex' :: CreatePartitionIndex -> PartitionIndex
partitionIndex} -> PartitionIndex
partitionIndex) (\s :: CreatePartitionIndex
s@CreatePartitionIndex' {} PartitionIndex
a -> CreatePartitionIndex
s {$sel:partitionIndex:CreatePartitionIndex' :: PartitionIndex
partitionIndex = PartitionIndex
a} :: CreatePartitionIndex)

instance Core.AWSRequest CreatePartitionIndex where
  type
    AWSResponse CreatePartitionIndex =
      CreatePartitionIndexResponse
  request :: (Service -> Service)
-> CreatePartitionIndex -> Request CreatePartitionIndex
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 CreatePartitionIndex
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreatePartitionIndex)))
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 -> CreatePartitionIndexResponse
CreatePartitionIndexResponse'
            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 CreatePartitionIndex where
  hashWithSalt :: Int -> CreatePartitionIndex -> Int
hashWithSalt Int
_salt CreatePartitionIndex' {Maybe Text
Text
PartitionIndex
partitionIndex :: PartitionIndex
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:partitionIndex:CreatePartitionIndex' :: CreatePartitionIndex -> PartitionIndex
$sel:tableName:CreatePartitionIndex' :: CreatePartitionIndex -> Text
$sel:databaseName:CreatePartitionIndex' :: CreatePartitionIndex -> Text
$sel:catalogId:CreatePartitionIndex' :: CreatePartitionIndex -> 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` PartitionIndex
partitionIndex

instance Prelude.NFData CreatePartitionIndex where
  rnf :: CreatePartitionIndex -> ()
rnf CreatePartitionIndex' {Maybe Text
Text
PartitionIndex
partitionIndex :: PartitionIndex
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:partitionIndex:CreatePartitionIndex' :: CreatePartitionIndex -> PartitionIndex
$sel:tableName:CreatePartitionIndex' :: CreatePartitionIndex -> Text
$sel:databaseName:CreatePartitionIndex' :: CreatePartitionIndex -> Text
$sel:catalogId:CreatePartitionIndex' :: CreatePartitionIndex -> 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 PartitionIndex
partitionIndex

instance Data.ToHeaders CreatePartitionIndex where
  toHeaders :: CreatePartitionIndex -> 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.CreatePartitionIndex" ::
                          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 CreatePartitionIndex where
  toJSON :: CreatePartitionIndex -> Value
toJSON CreatePartitionIndex' {Maybe Text
Text
PartitionIndex
partitionIndex :: PartitionIndex
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:partitionIndex:CreatePartitionIndex' :: CreatePartitionIndex -> PartitionIndex
$sel:tableName:CreatePartitionIndex' :: CreatePartitionIndex -> Text
$sel:databaseName:CreatePartitionIndex' :: CreatePartitionIndex -> Text
$sel:catalogId:CreatePartitionIndex' :: CreatePartitionIndex -> 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
"PartitionIndex" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PartitionIndex
partitionIndex)
          ]
      )

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

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

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

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

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

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