{-# 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.DataBrew.UpdateSchedule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the definition of an existing DataBrew schedule.
module Amazonka.DataBrew.UpdateSchedule
  ( -- * Creating a Request
    UpdateSchedule (..),
    newUpdateSchedule,

    -- * Request Lenses
    updateSchedule_jobNames,
    updateSchedule_cronExpression,
    updateSchedule_name,

    -- * Destructuring the Response
    UpdateScheduleResponse (..),
    newUpdateScheduleResponse,

    -- * Response Lenses
    updateScheduleResponse_httpStatus,
    updateScheduleResponse_name,
  )
where

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

-- | /See:/ 'newUpdateSchedule' smart constructor.
data UpdateSchedule = UpdateSchedule'
  { -- | The name or names of one or more jobs to be run for this schedule.
    UpdateSchedule -> Maybe [Text]
jobNames :: Prelude.Maybe [Prelude.Text],
    -- | The date or dates and time or times when the jobs are to be run. For
    -- more information, see
    -- <https://docs.aws.amazon.com/databrew/latest/dg/jobs.cron.html Cron expressions>
    -- in the /Glue DataBrew Developer Guide/.
    UpdateSchedule -> Text
cronExpression :: Prelude.Text,
    -- | The name of the schedule to update.
    UpdateSchedule -> Text
name :: Prelude.Text
  }
  deriving (UpdateSchedule -> UpdateSchedule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSchedule -> UpdateSchedule -> Bool
$c/= :: UpdateSchedule -> UpdateSchedule -> Bool
== :: UpdateSchedule -> UpdateSchedule -> Bool
$c== :: UpdateSchedule -> UpdateSchedule -> Bool
Prelude.Eq, ReadPrec [UpdateSchedule]
ReadPrec UpdateSchedule
Int -> ReadS UpdateSchedule
ReadS [UpdateSchedule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSchedule]
$creadListPrec :: ReadPrec [UpdateSchedule]
readPrec :: ReadPrec UpdateSchedule
$creadPrec :: ReadPrec UpdateSchedule
readList :: ReadS [UpdateSchedule]
$creadList :: ReadS [UpdateSchedule]
readsPrec :: Int -> ReadS UpdateSchedule
$creadsPrec :: Int -> ReadS UpdateSchedule
Prelude.Read, Int -> UpdateSchedule -> ShowS
[UpdateSchedule] -> ShowS
UpdateSchedule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSchedule] -> ShowS
$cshowList :: [UpdateSchedule] -> ShowS
show :: UpdateSchedule -> String
$cshow :: UpdateSchedule -> String
showsPrec :: Int -> UpdateSchedule -> ShowS
$cshowsPrec :: Int -> UpdateSchedule -> ShowS
Prelude.Show, forall x. Rep UpdateSchedule x -> UpdateSchedule
forall x. UpdateSchedule -> Rep UpdateSchedule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateSchedule x -> UpdateSchedule
$cfrom :: forall x. UpdateSchedule -> Rep UpdateSchedule x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSchedule' 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:
--
-- 'jobNames', 'updateSchedule_jobNames' - The name or names of one or more jobs to be run for this schedule.
--
-- 'cronExpression', 'updateSchedule_cronExpression' - The date or dates and time or times when the jobs are to be run. For
-- more information, see
-- <https://docs.aws.amazon.com/databrew/latest/dg/jobs.cron.html Cron expressions>
-- in the /Glue DataBrew Developer Guide/.
--
-- 'name', 'updateSchedule_name' - The name of the schedule to update.
newUpdateSchedule ::
  -- | 'cronExpression'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  UpdateSchedule
newUpdateSchedule :: Text -> Text -> UpdateSchedule
newUpdateSchedule Text
pCronExpression_ Text
pName_ =
  UpdateSchedule'
    { $sel:jobNames:UpdateSchedule' :: Maybe [Text]
jobNames = forall a. Maybe a
Prelude.Nothing,
      $sel:cronExpression:UpdateSchedule' :: Text
cronExpression = Text
pCronExpression_,
      $sel:name:UpdateSchedule' :: Text
name = Text
pName_
    }

-- | The name or names of one or more jobs to be run for this schedule.
updateSchedule_jobNames :: Lens.Lens' UpdateSchedule (Prelude.Maybe [Prelude.Text])
updateSchedule_jobNames :: Lens' UpdateSchedule (Maybe [Text])
updateSchedule_jobNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSchedule' {Maybe [Text]
jobNames :: Maybe [Text]
$sel:jobNames:UpdateSchedule' :: UpdateSchedule -> Maybe [Text]
jobNames} -> Maybe [Text]
jobNames) (\s :: UpdateSchedule
s@UpdateSchedule' {} Maybe [Text]
a -> UpdateSchedule
s {$sel:jobNames:UpdateSchedule' :: Maybe [Text]
jobNames = Maybe [Text]
a} :: UpdateSchedule) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The date or dates and time or times when the jobs are to be run. For
-- more information, see
-- <https://docs.aws.amazon.com/databrew/latest/dg/jobs.cron.html Cron expressions>
-- in the /Glue DataBrew Developer Guide/.
updateSchedule_cronExpression :: Lens.Lens' UpdateSchedule Prelude.Text
updateSchedule_cronExpression :: Lens' UpdateSchedule Text
updateSchedule_cronExpression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSchedule' {Text
cronExpression :: Text
$sel:cronExpression:UpdateSchedule' :: UpdateSchedule -> Text
cronExpression} -> Text
cronExpression) (\s :: UpdateSchedule
s@UpdateSchedule' {} Text
a -> UpdateSchedule
s {$sel:cronExpression:UpdateSchedule' :: Text
cronExpression = Text
a} :: UpdateSchedule)

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

instance Core.AWSRequest UpdateSchedule where
  type
    AWSResponse UpdateSchedule =
      UpdateScheduleResponse
  request :: (Service -> Service) -> UpdateSchedule -> Request UpdateSchedule
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateSchedule
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateSchedule)))
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 ->
          Int -> Text -> UpdateScheduleResponse
UpdateScheduleResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Name")
      )

instance Prelude.Hashable UpdateSchedule where
  hashWithSalt :: Int -> UpdateSchedule -> Int
hashWithSalt Int
_salt UpdateSchedule' {Maybe [Text]
Text
name :: Text
cronExpression :: Text
jobNames :: Maybe [Text]
$sel:name:UpdateSchedule' :: UpdateSchedule -> Text
$sel:cronExpression:UpdateSchedule' :: UpdateSchedule -> Text
$sel:jobNames:UpdateSchedule' :: UpdateSchedule -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
jobNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
cronExpression
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData UpdateSchedule where
  rnf :: UpdateSchedule -> ()
rnf UpdateSchedule' {Maybe [Text]
Text
name :: Text
cronExpression :: Text
jobNames :: Maybe [Text]
$sel:name:UpdateSchedule' :: UpdateSchedule -> Text
$sel:cronExpression:UpdateSchedule' :: UpdateSchedule -> Text
$sel:jobNames:UpdateSchedule' :: UpdateSchedule -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
jobNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
cronExpression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders UpdateSchedule where
  toHeaders :: UpdateSchedule -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateSchedule where
  toJSON :: UpdateSchedule -> Value
toJSON UpdateSchedule' {Maybe [Text]
Text
name :: Text
cronExpression :: Text
jobNames :: Maybe [Text]
$sel:name:UpdateSchedule' :: UpdateSchedule -> Text
$sel:cronExpression:UpdateSchedule' :: UpdateSchedule -> Text
$sel:jobNames:UpdateSchedule' :: UpdateSchedule -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"JobNames" 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]
jobNames,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"CronExpression" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
cronExpression)
          ]
      )

instance Data.ToPath UpdateSchedule where
  toPath :: UpdateSchedule -> ByteString
toPath UpdateSchedule' {Maybe [Text]
Text
name :: Text
cronExpression :: Text
jobNames :: Maybe [Text]
$sel:name:UpdateSchedule' :: UpdateSchedule -> Text
$sel:cronExpression:UpdateSchedule' :: UpdateSchedule -> Text
$sel:jobNames:UpdateSchedule' :: UpdateSchedule -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/schedules/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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

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

-- |
-- Create a value of 'UpdateScheduleResponse' 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', 'updateScheduleResponse_httpStatus' - The response's http status code.
--
-- 'name', 'updateScheduleResponse_name' - The name of the schedule that was updated.
newUpdateScheduleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'name'
  Prelude.Text ->
  UpdateScheduleResponse
newUpdateScheduleResponse :: Int -> Text -> UpdateScheduleResponse
newUpdateScheduleResponse Int
pHttpStatus_ Text
pName_ =
  UpdateScheduleResponse'
    { $sel:httpStatus:UpdateScheduleResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:name:UpdateScheduleResponse' :: Text
name = Text
pName_
    }

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

-- | The name of the schedule that was updated.
updateScheduleResponse_name :: Lens.Lens' UpdateScheduleResponse Prelude.Text
updateScheduleResponse_name :: Lens' UpdateScheduleResponse Text
updateScheduleResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateScheduleResponse' {Text
name :: Text
$sel:name:UpdateScheduleResponse' :: UpdateScheduleResponse -> Text
name} -> Text
name) (\s :: UpdateScheduleResponse
s@UpdateScheduleResponse' {} Text
a -> UpdateScheduleResponse
s {$sel:name:UpdateScheduleResponse' :: Text
name = Text
a} :: UpdateScheduleResponse)

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