{-# 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.UpdateTrigger
-- 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 trigger definition.
module Amazonka.Glue.UpdateTrigger
  ( -- * Creating a Request
    UpdateTrigger (..),
    newUpdateTrigger,

    -- * Request Lenses
    updateTrigger_name,
    updateTrigger_triggerUpdate,

    -- * Destructuring the Response
    UpdateTriggerResponse (..),
    newUpdateTriggerResponse,

    -- * Response Lenses
    updateTriggerResponse_trigger,
    updateTriggerResponse_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:/ 'newUpdateTrigger' smart constructor.
data UpdateTrigger = UpdateTrigger'
  { -- | The name of the trigger to update.
    UpdateTrigger -> Text
name :: Prelude.Text,
    -- | The new values with which to update the trigger.
    UpdateTrigger -> TriggerUpdate
triggerUpdate :: TriggerUpdate
  }
  deriving (UpdateTrigger -> UpdateTrigger -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTrigger -> UpdateTrigger -> Bool
$c/= :: UpdateTrigger -> UpdateTrigger -> Bool
== :: UpdateTrigger -> UpdateTrigger -> Bool
$c== :: UpdateTrigger -> UpdateTrigger -> Bool
Prelude.Eq, ReadPrec [UpdateTrigger]
ReadPrec UpdateTrigger
Int -> ReadS UpdateTrigger
ReadS [UpdateTrigger]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTrigger]
$creadListPrec :: ReadPrec [UpdateTrigger]
readPrec :: ReadPrec UpdateTrigger
$creadPrec :: ReadPrec UpdateTrigger
readList :: ReadS [UpdateTrigger]
$creadList :: ReadS [UpdateTrigger]
readsPrec :: Int -> ReadS UpdateTrigger
$creadsPrec :: Int -> ReadS UpdateTrigger
Prelude.Read, Int -> UpdateTrigger -> ShowS
[UpdateTrigger] -> ShowS
UpdateTrigger -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTrigger] -> ShowS
$cshowList :: [UpdateTrigger] -> ShowS
show :: UpdateTrigger -> String
$cshow :: UpdateTrigger -> String
showsPrec :: Int -> UpdateTrigger -> ShowS
$cshowsPrec :: Int -> UpdateTrigger -> ShowS
Prelude.Show, forall x. Rep UpdateTrigger x -> UpdateTrigger
forall x. UpdateTrigger -> Rep UpdateTrigger x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTrigger x -> UpdateTrigger
$cfrom :: forall x. UpdateTrigger -> Rep UpdateTrigger x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTrigger' 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:
--
-- 'name', 'updateTrigger_name' - The name of the trigger to update.
--
-- 'triggerUpdate', 'updateTrigger_triggerUpdate' - The new values with which to update the trigger.
newUpdateTrigger ::
  -- | 'name'
  Prelude.Text ->
  -- | 'triggerUpdate'
  TriggerUpdate ->
  UpdateTrigger
newUpdateTrigger :: Text -> TriggerUpdate -> UpdateTrigger
newUpdateTrigger Text
pName_ TriggerUpdate
pTriggerUpdate_ =
  UpdateTrigger'
    { $sel:name:UpdateTrigger' :: Text
name = Text
pName_,
      $sel:triggerUpdate:UpdateTrigger' :: TriggerUpdate
triggerUpdate = TriggerUpdate
pTriggerUpdate_
    }

-- | The name of the trigger to update.
updateTrigger_name :: Lens.Lens' UpdateTrigger Prelude.Text
updateTrigger_name :: Lens' UpdateTrigger Text
updateTrigger_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrigger' {Text
name :: Text
$sel:name:UpdateTrigger' :: UpdateTrigger -> Text
name} -> Text
name) (\s :: UpdateTrigger
s@UpdateTrigger' {} Text
a -> UpdateTrigger
s {$sel:name:UpdateTrigger' :: Text
name = Text
a} :: UpdateTrigger)

-- | The new values with which to update the trigger.
updateTrigger_triggerUpdate :: Lens.Lens' UpdateTrigger TriggerUpdate
updateTrigger_triggerUpdate :: Lens' UpdateTrigger TriggerUpdate
updateTrigger_triggerUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrigger' {TriggerUpdate
triggerUpdate :: TriggerUpdate
$sel:triggerUpdate:UpdateTrigger' :: UpdateTrigger -> TriggerUpdate
triggerUpdate} -> TriggerUpdate
triggerUpdate) (\s :: UpdateTrigger
s@UpdateTrigger' {} TriggerUpdate
a -> UpdateTrigger
s {$sel:triggerUpdate:UpdateTrigger' :: TriggerUpdate
triggerUpdate = TriggerUpdate
a} :: UpdateTrigger)

instance Core.AWSRequest UpdateTrigger where
  type
    AWSResponse UpdateTrigger =
      UpdateTriggerResponse
  request :: (Service -> Service) -> UpdateTrigger -> Request UpdateTrigger
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 UpdateTrigger
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateTrigger)))
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 Trigger -> Int -> UpdateTriggerResponse
UpdateTriggerResponse'
            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
"Trigger")
            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 UpdateTrigger where
  hashWithSalt :: Int -> UpdateTrigger -> Int
hashWithSalt Int
_salt UpdateTrigger' {Text
TriggerUpdate
triggerUpdate :: TriggerUpdate
name :: Text
$sel:triggerUpdate:UpdateTrigger' :: UpdateTrigger -> TriggerUpdate
$sel:name:UpdateTrigger' :: UpdateTrigger -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TriggerUpdate
triggerUpdate

instance Prelude.NFData UpdateTrigger where
  rnf :: UpdateTrigger -> ()
rnf UpdateTrigger' {Text
TriggerUpdate
triggerUpdate :: TriggerUpdate
name :: Text
$sel:triggerUpdate:UpdateTrigger' :: UpdateTrigger -> TriggerUpdate
$sel:name:UpdateTrigger' :: UpdateTrigger -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TriggerUpdate
triggerUpdate

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

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

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

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

-- |
-- Create a value of 'UpdateTriggerResponse' 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:
--
-- 'trigger', 'updateTriggerResponse_trigger' - The resulting trigger definition.
--
-- 'httpStatus', 'updateTriggerResponse_httpStatus' - The response's http status code.
newUpdateTriggerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateTriggerResponse
newUpdateTriggerResponse :: Int -> UpdateTriggerResponse
newUpdateTriggerResponse Int
pHttpStatus_ =
  UpdateTriggerResponse'
    { $sel:trigger:UpdateTriggerResponse' :: Maybe Trigger
trigger = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateTriggerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The resulting trigger definition.
updateTriggerResponse_trigger :: Lens.Lens' UpdateTriggerResponse (Prelude.Maybe Trigger)
updateTriggerResponse_trigger :: Lens' UpdateTriggerResponse (Maybe Trigger)
updateTriggerResponse_trigger = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTriggerResponse' {Maybe Trigger
trigger :: Maybe Trigger
$sel:trigger:UpdateTriggerResponse' :: UpdateTriggerResponse -> Maybe Trigger
trigger} -> Maybe Trigger
trigger) (\s :: UpdateTriggerResponse
s@UpdateTriggerResponse' {} Maybe Trigger
a -> UpdateTriggerResponse
s {$sel:trigger:UpdateTriggerResponse' :: Maybe Trigger
trigger = Maybe Trigger
a} :: UpdateTriggerResponse)

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

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