{-# 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.Athena.UpdateWorkGroup
-- 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 the workgroup with the specified name. The workgroup\'s name
-- cannot be changed. Only one of @ConfigurationsUpdates@ or
-- @ConfigurationUpdates@ can be specified; @ConfigurationsUpdates@ for a
-- workgroup with multi engine support (for example, an Apache Spark
-- enabled workgroup) or @ConfigurationUpdates@ for an Athena SQL
-- workgroup.
module Amazonka.Athena.UpdateWorkGroup
  ( -- * Creating a Request
    UpdateWorkGroup (..),
    newUpdateWorkGroup,

    -- * Request Lenses
    updateWorkGroup_configurationUpdates,
    updateWorkGroup_description,
    updateWorkGroup_state,
    updateWorkGroup_workGroup,

    -- * Destructuring the Response
    UpdateWorkGroupResponse (..),
    newUpdateWorkGroupResponse,

    -- * Response Lenses
    updateWorkGroupResponse_httpStatus,
  )
where

import Amazonka.Athena.Types
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

-- | /See:/ 'newUpdateWorkGroup' smart constructor.
data UpdateWorkGroup = UpdateWorkGroup'
  { -- | Contains configuration updates for an Athena SQL workgroup.
    UpdateWorkGroup -> Maybe WorkGroupConfigurationUpdates
configurationUpdates :: Prelude.Maybe WorkGroupConfigurationUpdates,
    -- | The workgroup description.
    UpdateWorkGroup -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The workgroup state that will be updated for the given workgroup.
    UpdateWorkGroup -> Maybe WorkGroupState
state :: Prelude.Maybe WorkGroupState,
    -- | The specified workgroup that will be updated.
    UpdateWorkGroup -> Text
workGroup :: Prelude.Text
  }
  deriving (UpdateWorkGroup -> UpdateWorkGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWorkGroup -> UpdateWorkGroup -> Bool
$c/= :: UpdateWorkGroup -> UpdateWorkGroup -> Bool
== :: UpdateWorkGroup -> UpdateWorkGroup -> Bool
$c== :: UpdateWorkGroup -> UpdateWorkGroup -> Bool
Prelude.Eq, ReadPrec [UpdateWorkGroup]
ReadPrec UpdateWorkGroup
Int -> ReadS UpdateWorkGroup
ReadS [UpdateWorkGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWorkGroup]
$creadListPrec :: ReadPrec [UpdateWorkGroup]
readPrec :: ReadPrec UpdateWorkGroup
$creadPrec :: ReadPrec UpdateWorkGroup
readList :: ReadS [UpdateWorkGroup]
$creadList :: ReadS [UpdateWorkGroup]
readsPrec :: Int -> ReadS UpdateWorkGroup
$creadsPrec :: Int -> ReadS UpdateWorkGroup
Prelude.Read, Int -> UpdateWorkGroup -> ShowS
[UpdateWorkGroup] -> ShowS
UpdateWorkGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWorkGroup] -> ShowS
$cshowList :: [UpdateWorkGroup] -> ShowS
show :: UpdateWorkGroup -> String
$cshow :: UpdateWorkGroup -> String
showsPrec :: Int -> UpdateWorkGroup -> ShowS
$cshowsPrec :: Int -> UpdateWorkGroup -> ShowS
Prelude.Show, forall x. Rep UpdateWorkGroup x -> UpdateWorkGroup
forall x. UpdateWorkGroup -> Rep UpdateWorkGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateWorkGroup x -> UpdateWorkGroup
$cfrom :: forall x. UpdateWorkGroup -> Rep UpdateWorkGroup x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWorkGroup' 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:
--
-- 'configurationUpdates', 'updateWorkGroup_configurationUpdates' - Contains configuration updates for an Athena SQL workgroup.
--
-- 'description', 'updateWorkGroup_description' - The workgroup description.
--
-- 'state', 'updateWorkGroup_state' - The workgroup state that will be updated for the given workgroup.
--
-- 'workGroup', 'updateWorkGroup_workGroup' - The specified workgroup that will be updated.
newUpdateWorkGroup ::
  -- | 'workGroup'
  Prelude.Text ->
  UpdateWorkGroup
newUpdateWorkGroup :: Text -> UpdateWorkGroup
newUpdateWorkGroup Text
pWorkGroup_ =
  UpdateWorkGroup'
    { $sel:configurationUpdates:UpdateWorkGroup' :: Maybe WorkGroupConfigurationUpdates
configurationUpdates =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateWorkGroup' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:state:UpdateWorkGroup' :: Maybe WorkGroupState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:workGroup:UpdateWorkGroup' :: Text
workGroup = Text
pWorkGroup_
    }

-- | Contains configuration updates for an Athena SQL workgroup.
updateWorkGroup_configurationUpdates :: Lens.Lens' UpdateWorkGroup (Prelude.Maybe WorkGroupConfigurationUpdates)
updateWorkGroup_configurationUpdates :: Lens' UpdateWorkGroup (Maybe WorkGroupConfigurationUpdates)
updateWorkGroup_configurationUpdates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkGroup' {Maybe WorkGroupConfigurationUpdates
configurationUpdates :: Maybe WorkGroupConfigurationUpdates
$sel:configurationUpdates:UpdateWorkGroup' :: UpdateWorkGroup -> Maybe WorkGroupConfigurationUpdates
configurationUpdates} -> Maybe WorkGroupConfigurationUpdates
configurationUpdates) (\s :: UpdateWorkGroup
s@UpdateWorkGroup' {} Maybe WorkGroupConfigurationUpdates
a -> UpdateWorkGroup
s {$sel:configurationUpdates:UpdateWorkGroup' :: Maybe WorkGroupConfigurationUpdates
configurationUpdates = Maybe WorkGroupConfigurationUpdates
a} :: UpdateWorkGroup)

-- | The workgroup description.
updateWorkGroup_description :: Lens.Lens' UpdateWorkGroup (Prelude.Maybe Prelude.Text)
updateWorkGroup_description :: Lens' UpdateWorkGroup (Maybe Text)
updateWorkGroup_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkGroup' {Maybe Text
description :: Maybe Text
$sel:description:UpdateWorkGroup' :: UpdateWorkGroup -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateWorkGroup
s@UpdateWorkGroup' {} Maybe Text
a -> UpdateWorkGroup
s {$sel:description:UpdateWorkGroup' :: Maybe Text
description = Maybe Text
a} :: UpdateWorkGroup)

-- | The workgroup state that will be updated for the given workgroup.
updateWorkGroup_state :: Lens.Lens' UpdateWorkGroup (Prelude.Maybe WorkGroupState)
updateWorkGroup_state :: Lens' UpdateWorkGroup (Maybe WorkGroupState)
updateWorkGroup_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkGroup' {Maybe WorkGroupState
state :: Maybe WorkGroupState
$sel:state:UpdateWorkGroup' :: UpdateWorkGroup -> Maybe WorkGroupState
state} -> Maybe WorkGroupState
state) (\s :: UpdateWorkGroup
s@UpdateWorkGroup' {} Maybe WorkGroupState
a -> UpdateWorkGroup
s {$sel:state:UpdateWorkGroup' :: Maybe WorkGroupState
state = Maybe WorkGroupState
a} :: UpdateWorkGroup)

-- | The specified workgroup that will be updated.
updateWorkGroup_workGroup :: Lens.Lens' UpdateWorkGroup Prelude.Text
updateWorkGroup_workGroup :: Lens' UpdateWorkGroup Text
updateWorkGroup_workGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkGroup' {Text
workGroup :: Text
$sel:workGroup:UpdateWorkGroup' :: UpdateWorkGroup -> Text
workGroup} -> Text
workGroup) (\s :: UpdateWorkGroup
s@UpdateWorkGroup' {} Text
a -> UpdateWorkGroup
s {$sel:workGroup:UpdateWorkGroup' :: Text
workGroup = Text
a} :: UpdateWorkGroup)

instance Core.AWSRequest UpdateWorkGroup where
  type
    AWSResponse UpdateWorkGroup =
      UpdateWorkGroupResponse
  request :: (Service -> Service) -> UpdateWorkGroup -> Request UpdateWorkGroup
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 UpdateWorkGroup
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateWorkGroup)))
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 -> UpdateWorkGroupResponse
UpdateWorkGroupResponse'
            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 UpdateWorkGroup where
  hashWithSalt :: Int -> UpdateWorkGroup -> Int
hashWithSalt Int
_salt UpdateWorkGroup' {Maybe Text
Maybe WorkGroupConfigurationUpdates
Maybe WorkGroupState
Text
workGroup :: Text
state :: Maybe WorkGroupState
description :: Maybe Text
configurationUpdates :: Maybe WorkGroupConfigurationUpdates
$sel:workGroup:UpdateWorkGroup' :: UpdateWorkGroup -> Text
$sel:state:UpdateWorkGroup' :: UpdateWorkGroup -> Maybe WorkGroupState
$sel:description:UpdateWorkGroup' :: UpdateWorkGroup -> Maybe Text
$sel:configurationUpdates:UpdateWorkGroup' :: UpdateWorkGroup -> Maybe WorkGroupConfigurationUpdates
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkGroupConfigurationUpdates
configurationUpdates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkGroupState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workGroup

instance Prelude.NFData UpdateWorkGroup where
  rnf :: UpdateWorkGroup -> ()
rnf UpdateWorkGroup' {Maybe Text
Maybe WorkGroupConfigurationUpdates
Maybe WorkGroupState
Text
workGroup :: Text
state :: Maybe WorkGroupState
description :: Maybe Text
configurationUpdates :: Maybe WorkGroupConfigurationUpdates
$sel:workGroup:UpdateWorkGroup' :: UpdateWorkGroup -> Text
$sel:state:UpdateWorkGroup' :: UpdateWorkGroup -> Maybe WorkGroupState
$sel:description:UpdateWorkGroup' :: UpdateWorkGroup -> Maybe Text
$sel:configurationUpdates:UpdateWorkGroup' :: UpdateWorkGroup -> Maybe WorkGroupConfigurationUpdates
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkGroupConfigurationUpdates
configurationUpdates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkGroupState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workGroup

instance Data.ToHeaders UpdateWorkGroup where
  toHeaders :: UpdateWorkGroup -> 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
"AmazonAthena.UpdateWorkGroup" ::
                          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 UpdateWorkGroup where
  toJSON :: UpdateWorkGroup -> Value
toJSON UpdateWorkGroup' {Maybe Text
Maybe WorkGroupConfigurationUpdates
Maybe WorkGroupState
Text
workGroup :: Text
state :: Maybe WorkGroupState
description :: Maybe Text
configurationUpdates :: Maybe WorkGroupConfigurationUpdates
$sel:workGroup:UpdateWorkGroup' :: UpdateWorkGroup -> Text
$sel:state:UpdateWorkGroup' :: UpdateWorkGroup -> Maybe WorkGroupState
$sel:description:UpdateWorkGroup' :: UpdateWorkGroup -> Maybe Text
$sel:configurationUpdates:UpdateWorkGroup' :: UpdateWorkGroup -> Maybe WorkGroupConfigurationUpdates
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ConfigurationUpdates" 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 WorkGroupConfigurationUpdates
configurationUpdates,
            (Key
"Description" 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
description,
            (Key
"State" 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 WorkGroupState
state,
            forall a. a -> Maybe a
Prelude.Just (Key
"WorkGroup" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
workGroup)
          ]
      )

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

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

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

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

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

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