{-# 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.UpdateJob
-- 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 an existing job definition. The previous job definition is
-- completely overwritten by this information.
module Amazonka.Glue.UpdateJob
  ( -- * Creating a Request
    UpdateJob (..),
    newUpdateJob,

    -- * Request Lenses
    updateJob_jobName,
    updateJob_jobUpdate,

    -- * Destructuring the Response
    UpdateJobResponse (..),
    newUpdateJobResponse,

    -- * Response Lenses
    updateJobResponse_jobName,
    updateJobResponse_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:/ 'newUpdateJob' smart constructor.
data UpdateJob = UpdateJob'
  { -- | The name of the job definition to update.
    UpdateJob -> Text
jobName :: Prelude.Text,
    -- | Specifies the values with which to update the job definition.
    -- Unspecified configuration is removed or reset to default values.
    UpdateJob -> JobUpdate
jobUpdate :: JobUpdate
  }
  deriving (UpdateJob -> UpdateJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateJob -> UpdateJob -> Bool
$c/= :: UpdateJob -> UpdateJob -> Bool
== :: UpdateJob -> UpdateJob -> Bool
$c== :: UpdateJob -> UpdateJob -> Bool
Prelude.Eq, Int -> UpdateJob -> ShowS
[UpdateJob] -> ShowS
UpdateJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateJob] -> ShowS
$cshowList :: [UpdateJob] -> ShowS
show :: UpdateJob -> String
$cshow :: UpdateJob -> String
showsPrec :: Int -> UpdateJob -> ShowS
$cshowsPrec :: Int -> UpdateJob -> ShowS
Prelude.Show, forall x. Rep UpdateJob x -> UpdateJob
forall x. UpdateJob -> Rep UpdateJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateJob x -> UpdateJob
$cfrom :: forall x. UpdateJob -> Rep UpdateJob x
Prelude.Generic)

-- |
-- Create a value of 'UpdateJob' 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:
--
-- 'jobName', 'updateJob_jobName' - The name of the job definition to update.
--
-- 'jobUpdate', 'updateJob_jobUpdate' - Specifies the values with which to update the job definition.
-- Unspecified configuration is removed or reset to default values.
newUpdateJob ::
  -- | 'jobName'
  Prelude.Text ->
  -- | 'jobUpdate'
  JobUpdate ->
  UpdateJob
newUpdateJob :: Text -> JobUpdate -> UpdateJob
newUpdateJob Text
pJobName_ JobUpdate
pJobUpdate_ =
  UpdateJob'
    { $sel:jobName:UpdateJob' :: Text
jobName = Text
pJobName_,
      $sel:jobUpdate:UpdateJob' :: JobUpdate
jobUpdate = JobUpdate
pJobUpdate_
    }

-- | The name of the job definition to update.
updateJob_jobName :: Lens.Lens' UpdateJob Prelude.Text
updateJob_jobName :: Lens' UpdateJob Text
updateJob_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateJob' {Text
jobName :: Text
$sel:jobName:UpdateJob' :: UpdateJob -> Text
jobName} -> Text
jobName) (\s :: UpdateJob
s@UpdateJob' {} Text
a -> UpdateJob
s {$sel:jobName:UpdateJob' :: Text
jobName = Text
a} :: UpdateJob)

-- | Specifies the values with which to update the job definition.
-- Unspecified configuration is removed or reset to default values.
updateJob_jobUpdate :: Lens.Lens' UpdateJob JobUpdate
updateJob_jobUpdate :: Lens' UpdateJob JobUpdate
updateJob_jobUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateJob' {JobUpdate
jobUpdate :: JobUpdate
$sel:jobUpdate:UpdateJob' :: UpdateJob -> JobUpdate
jobUpdate} -> JobUpdate
jobUpdate) (\s :: UpdateJob
s@UpdateJob' {} JobUpdate
a -> UpdateJob
s {$sel:jobUpdate:UpdateJob' :: JobUpdate
jobUpdate = JobUpdate
a} :: UpdateJob)

instance Core.AWSRequest UpdateJob where
  type AWSResponse UpdateJob = UpdateJobResponse
  request :: (Service -> Service) -> UpdateJob -> Request UpdateJob
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 UpdateJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateJob)))
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 Text -> Int -> UpdateJobResponse
UpdateJobResponse'
            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
"JobName")
            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 UpdateJob where
  hashWithSalt :: Int -> UpdateJob -> Int
hashWithSalt Int
_salt UpdateJob' {Text
JobUpdate
jobUpdate :: JobUpdate
jobName :: Text
$sel:jobUpdate:UpdateJob' :: UpdateJob -> JobUpdate
$sel:jobName:UpdateJob' :: UpdateJob -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` JobUpdate
jobUpdate

instance Prelude.NFData UpdateJob where
  rnf :: UpdateJob -> ()
rnf UpdateJob' {Text
JobUpdate
jobUpdate :: JobUpdate
jobName :: Text
$sel:jobUpdate:UpdateJob' :: UpdateJob -> JobUpdate
$sel:jobName:UpdateJob' :: UpdateJob -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
jobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf JobUpdate
jobUpdate

instance Data.ToHeaders UpdateJob where
  toHeaders :: UpdateJob -> 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.UpdateJob" :: 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 UpdateJob where
  toJSON :: UpdateJob -> Value
toJSON UpdateJob' {Text
JobUpdate
jobUpdate :: JobUpdate
jobName :: Text
$sel:jobUpdate:UpdateJob' :: UpdateJob -> JobUpdate
$sel:jobName:UpdateJob' :: UpdateJob -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"JobName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobName),
            forall a. a -> Maybe a
Prelude.Just (Key
"JobUpdate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= JobUpdate
jobUpdate)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateJobResponse' 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:
--
-- 'jobName', 'updateJobResponse_jobName' - Returns the name of the updated job definition.
--
-- 'httpStatus', 'updateJobResponse_httpStatus' - The response's http status code.
newUpdateJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateJobResponse
newUpdateJobResponse :: Int -> UpdateJobResponse
newUpdateJobResponse Int
pHttpStatus_ =
  UpdateJobResponse'
    { $sel:jobName:UpdateJobResponse' :: Maybe Text
jobName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns the name of the updated job definition.
updateJobResponse_jobName :: Lens.Lens' UpdateJobResponse (Prelude.Maybe Prelude.Text)
updateJobResponse_jobName :: Lens' UpdateJobResponse (Maybe Text)
updateJobResponse_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateJobResponse' {Maybe Text
jobName :: Maybe Text
$sel:jobName:UpdateJobResponse' :: UpdateJobResponse -> Maybe Text
jobName} -> Maybe Text
jobName) (\s :: UpdateJobResponse
s@UpdateJobResponse' {} Maybe Text
a -> UpdateJobResponse
s {$sel:jobName:UpdateJobResponse' :: Maybe Text
jobName = Maybe Text
a} :: UpdateJobResponse)

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

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