{-# 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.AutoScaling.PutScheduledUpdateGroupAction
-- 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 or updates a scheduled scaling action for an Auto Scaling group.
--
-- For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/schedule_time.html Scheduled scaling>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- You can view the scheduled actions for an Auto Scaling group using the
-- DescribeScheduledActions API call. If you are no longer using a
-- scheduled action, you can delete it by calling the DeleteScheduledAction
-- API.
--
-- If you try to schedule your action in the past, Amazon EC2 Auto Scaling
-- returns an error message.
module Amazonka.AutoScaling.PutScheduledUpdateGroupAction
  ( -- * Creating a Request
    PutScheduledUpdateGroupAction (..),
    newPutScheduledUpdateGroupAction,

    -- * Request Lenses
    putScheduledUpdateGroupAction_desiredCapacity,
    putScheduledUpdateGroupAction_endTime,
    putScheduledUpdateGroupAction_maxSize,
    putScheduledUpdateGroupAction_minSize,
    putScheduledUpdateGroupAction_recurrence,
    putScheduledUpdateGroupAction_startTime,
    putScheduledUpdateGroupAction_time,
    putScheduledUpdateGroupAction_timeZone,
    putScheduledUpdateGroupAction_autoScalingGroupName,
    putScheduledUpdateGroupAction_scheduledActionName,

    -- * Destructuring the Response
    PutScheduledUpdateGroupActionResponse (..),
    newPutScheduledUpdateGroupActionResponse,
  )
where

import Amazonka.AutoScaling.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:/ 'newPutScheduledUpdateGroupAction' smart constructor.
data PutScheduledUpdateGroupAction = PutScheduledUpdateGroupAction'
  { -- | The desired capacity is the initial capacity of the Auto Scaling group
    -- after the scheduled action runs and the capacity it attempts to
    -- maintain. It can scale beyond this capacity if you add more scaling
    -- conditions.
    --
    -- You must specify at least one of the following properties: @MaxSize@,
    -- @MinSize@, or @DesiredCapacity@.
    PutScheduledUpdateGroupAction -> Maybe Int
desiredCapacity :: Prelude.Maybe Prelude.Int,
    -- | The date and time for the recurring schedule to end, in UTC. For
    -- example, @\"2021-06-01T00:00:00Z\"@.
    PutScheduledUpdateGroupAction -> Maybe ISO8601
endTime :: Prelude.Maybe Data.ISO8601,
    -- | The maximum size of the Auto Scaling group.
    PutScheduledUpdateGroupAction -> Maybe Int
maxSize :: Prelude.Maybe Prelude.Int,
    -- | The minimum size of the Auto Scaling group.
    PutScheduledUpdateGroupAction -> Maybe Int
minSize :: Prelude.Maybe Prelude.Int,
    -- | The recurring schedule for this action. This format consists of five
    -- fields separated by white spaces: [Minute] [Hour] [Day_of_Month]
    -- [Month_of_Year] [Day_of_Week]. The value must be in quotes (for example,
    -- @\"30 0 1 1,6,12 *\"@). For more information about this format, see
    -- <http://crontab.org Crontab>.
    --
    -- When @StartTime@ and @EndTime@ are specified with @Recurrence@, they
    -- form the boundaries of when the recurring action starts and stops.
    --
    -- Cron expressions use Universal Coordinated Time (UTC) by default.
    PutScheduledUpdateGroupAction -> Maybe Text
recurrence :: Prelude.Maybe Prelude.Text,
    -- | The date and time for this action to start, in YYYY-MM-DDThh:mm:ssZ
    -- format in UTC\/GMT only and in quotes (for example,
    -- @\"2021-06-01T00:00:00Z\"@).
    --
    -- If you specify @Recurrence@ and @StartTime@, Amazon EC2 Auto Scaling
    -- performs the action at this time, and then performs the action based on
    -- the specified recurrence.
    PutScheduledUpdateGroupAction -> Maybe ISO8601
startTime :: Prelude.Maybe Data.ISO8601,
    -- | This property is no longer used.
    PutScheduledUpdateGroupAction -> Maybe ISO8601
time :: Prelude.Maybe Data.ISO8601,
    -- | Specifies the time zone for a cron expression. If a time zone is not
    -- provided, UTC is used by default.
    --
    -- Valid values are the canonical names of the IANA time zones, derived
    -- from the IANA Time Zone Database (such as @Etc\/GMT+9@ or
    -- @Pacific\/Tahiti@). For more information, see
    -- <https://en.wikipedia.org/wiki/List_of_tz_database_time_zones>.
    PutScheduledUpdateGroupAction -> Maybe Text
timeZone :: Prelude.Maybe Prelude.Text,
    -- | The name of the Auto Scaling group.
    PutScheduledUpdateGroupAction -> Text
autoScalingGroupName :: Prelude.Text,
    -- | The name of this scaling action.
    PutScheduledUpdateGroupAction -> Text
scheduledActionName :: Prelude.Text
  }
  deriving (PutScheduledUpdateGroupAction
-> PutScheduledUpdateGroupAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutScheduledUpdateGroupAction
-> PutScheduledUpdateGroupAction -> Bool
$c/= :: PutScheduledUpdateGroupAction
-> PutScheduledUpdateGroupAction -> Bool
== :: PutScheduledUpdateGroupAction
-> PutScheduledUpdateGroupAction -> Bool
$c== :: PutScheduledUpdateGroupAction
-> PutScheduledUpdateGroupAction -> Bool
Prelude.Eq, ReadPrec [PutScheduledUpdateGroupAction]
ReadPrec PutScheduledUpdateGroupAction
Int -> ReadS PutScheduledUpdateGroupAction
ReadS [PutScheduledUpdateGroupAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutScheduledUpdateGroupAction]
$creadListPrec :: ReadPrec [PutScheduledUpdateGroupAction]
readPrec :: ReadPrec PutScheduledUpdateGroupAction
$creadPrec :: ReadPrec PutScheduledUpdateGroupAction
readList :: ReadS [PutScheduledUpdateGroupAction]
$creadList :: ReadS [PutScheduledUpdateGroupAction]
readsPrec :: Int -> ReadS PutScheduledUpdateGroupAction
$creadsPrec :: Int -> ReadS PutScheduledUpdateGroupAction
Prelude.Read, Int -> PutScheduledUpdateGroupAction -> ShowS
[PutScheduledUpdateGroupAction] -> ShowS
PutScheduledUpdateGroupAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutScheduledUpdateGroupAction] -> ShowS
$cshowList :: [PutScheduledUpdateGroupAction] -> ShowS
show :: PutScheduledUpdateGroupAction -> String
$cshow :: PutScheduledUpdateGroupAction -> String
showsPrec :: Int -> PutScheduledUpdateGroupAction -> ShowS
$cshowsPrec :: Int -> PutScheduledUpdateGroupAction -> ShowS
Prelude.Show, forall x.
Rep PutScheduledUpdateGroupAction x
-> PutScheduledUpdateGroupAction
forall x.
PutScheduledUpdateGroupAction
-> Rep PutScheduledUpdateGroupAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutScheduledUpdateGroupAction x
-> PutScheduledUpdateGroupAction
$cfrom :: forall x.
PutScheduledUpdateGroupAction
-> Rep PutScheduledUpdateGroupAction x
Prelude.Generic)

-- |
-- Create a value of 'PutScheduledUpdateGroupAction' 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:
--
-- 'desiredCapacity', 'putScheduledUpdateGroupAction_desiredCapacity' - The desired capacity is the initial capacity of the Auto Scaling group
-- after the scheduled action runs and the capacity it attempts to
-- maintain. It can scale beyond this capacity if you add more scaling
-- conditions.
--
-- You must specify at least one of the following properties: @MaxSize@,
-- @MinSize@, or @DesiredCapacity@.
--
-- 'endTime', 'putScheduledUpdateGroupAction_endTime' - The date and time for the recurring schedule to end, in UTC. For
-- example, @\"2021-06-01T00:00:00Z\"@.
--
-- 'maxSize', 'putScheduledUpdateGroupAction_maxSize' - The maximum size of the Auto Scaling group.
--
-- 'minSize', 'putScheduledUpdateGroupAction_minSize' - The minimum size of the Auto Scaling group.
--
-- 'recurrence', 'putScheduledUpdateGroupAction_recurrence' - The recurring schedule for this action. This format consists of five
-- fields separated by white spaces: [Minute] [Hour] [Day_of_Month]
-- [Month_of_Year] [Day_of_Week]. The value must be in quotes (for example,
-- @\"30 0 1 1,6,12 *\"@). For more information about this format, see
-- <http://crontab.org Crontab>.
--
-- When @StartTime@ and @EndTime@ are specified with @Recurrence@, they
-- form the boundaries of when the recurring action starts and stops.
--
-- Cron expressions use Universal Coordinated Time (UTC) by default.
--
-- 'startTime', 'putScheduledUpdateGroupAction_startTime' - The date and time for this action to start, in YYYY-MM-DDThh:mm:ssZ
-- format in UTC\/GMT only and in quotes (for example,
-- @\"2021-06-01T00:00:00Z\"@).
--
-- If you specify @Recurrence@ and @StartTime@, Amazon EC2 Auto Scaling
-- performs the action at this time, and then performs the action based on
-- the specified recurrence.
--
-- 'time', 'putScheduledUpdateGroupAction_time' - This property is no longer used.
--
-- 'timeZone', 'putScheduledUpdateGroupAction_timeZone' - Specifies the time zone for a cron expression. If a time zone is not
-- provided, UTC is used by default.
--
-- Valid values are the canonical names of the IANA time zones, derived
-- from the IANA Time Zone Database (such as @Etc\/GMT+9@ or
-- @Pacific\/Tahiti@). For more information, see
-- <https://en.wikipedia.org/wiki/List_of_tz_database_time_zones>.
--
-- 'autoScalingGroupName', 'putScheduledUpdateGroupAction_autoScalingGroupName' - The name of the Auto Scaling group.
--
-- 'scheduledActionName', 'putScheduledUpdateGroupAction_scheduledActionName' - The name of this scaling action.
newPutScheduledUpdateGroupAction ::
  -- | 'autoScalingGroupName'
  Prelude.Text ->
  -- | 'scheduledActionName'
  Prelude.Text ->
  PutScheduledUpdateGroupAction
newPutScheduledUpdateGroupAction :: Text -> Text -> PutScheduledUpdateGroupAction
newPutScheduledUpdateGroupAction
  Text
pAutoScalingGroupName_
  Text
pScheduledActionName_ =
    PutScheduledUpdateGroupAction'
      { $sel:desiredCapacity:PutScheduledUpdateGroupAction' :: Maybe Int
desiredCapacity =
          forall a. Maybe a
Prelude.Nothing,
        $sel:endTime:PutScheduledUpdateGroupAction' :: Maybe ISO8601
endTime = forall a. Maybe a
Prelude.Nothing,
        $sel:maxSize:PutScheduledUpdateGroupAction' :: Maybe Int
maxSize = forall a. Maybe a
Prelude.Nothing,
        $sel:minSize:PutScheduledUpdateGroupAction' :: Maybe Int
minSize = forall a. Maybe a
Prelude.Nothing,
        $sel:recurrence:PutScheduledUpdateGroupAction' :: Maybe Text
recurrence = forall a. Maybe a
Prelude.Nothing,
        $sel:startTime:PutScheduledUpdateGroupAction' :: Maybe ISO8601
startTime = forall a. Maybe a
Prelude.Nothing,
        $sel:time:PutScheduledUpdateGroupAction' :: Maybe ISO8601
time = forall a. Maybe a
Prelude.Nothing,
        $sel:timeZone:PutScheduledUpdateGroupAction' :: Maybe Text
timeZone = forall a. Maybe a
Prelude.Nothing,
        $sel:autoScalingGroupName:PutScheduledUpdateGroupAction' :: Text
autoScalingGroupName =
          Text
pAutoScalingGroupName_,
        $sel:scheduledActionName:PutScheduledUpdateGroupAction' :: Text
scheduledActionName = Text
pScheduledActionName_
      }

-- | The desired capacity is the initial capacity of the Auto Scaling group
-- after the scheduled action runs and the capacity it attempts to
-- maintain. It can scale beyond this capacity if you add more scaling
-- conditions.
--
-- You must specify at least one of the following properties: @MaxSize@,
-- @MinSize@, or @DesiredCapacity@.
putScheduledUpdateGroupAction_desiredCapacity :: Lens.Lens' PutScheduledUpdateGroupAction (Prelude.Maybe Prelude.Int)
putScheduledUpdateGroupAction_desiredCapacity :: Lens' PutScheduledUpdateGroupAction (Maybe Int)
putScheduledUpdateGroupAction_desiredCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScheduledUpdateGroupAction' {Maybe Int
desiredCapacity :: Maybe Int
$sel:desiredCapacity:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Int
desiredCapacity} -> Maybe Int
desiredCapacity) (\s :: PutScheduledUpdateGroupAction
s@PutScheduledUpdateGroupAction' {} Maybe Int
a -> PutScheduledUpdateGroupAction
s {$sel:desiredCapacity:PutScheduledUpdateGroupAction' :: Maybe Int
desiredCapacity = Maybe Int
a} :: PutScheduledUpdateGroupAction)

-- | The date and time for the recurring schedule to end, in UTC. For
-- example, @\"2021-06-01T00:00:00Z\"@.
putScheduledUpdateGroupAction_endTime :: Lens.Lens' PutScheduledUpdateGroupAction (Prelude.Maybe Prelude.UTCTime)
putScheduledUpdateGroupAction_endTime :: Lens' PutScheduledUpdateGroupAction (Maybe UTCTime)
putScheduledUpdateGroupAction_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScheduledUpdateGroupAction' {Maybe ISO8601
endTime :: Maybe ISO8601
$sel:endTime:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe ISO8601
endTime} -> Maybe ISO8601
endTime) (\s :: PutScheduledUpdateGroupAction
s@PutScheduledUpdateGroupAction' {} Maybe ISO8601
a -> PutScheduledUpdateGroupAction
s {$sel:endTime:PutScheduledUpdateGroupAction' :: Maybe ISO8601
endTime = Maybe ISO8601
a} :: PutScheduledUpdateGroupAction) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The maximum size of the Auto Scaling group.
putScheduledUpdateGroupAction_maxSize :: Lens.Lens' PutScheduledUpdateGroupAction (Prelude.Maybe Prelude.Int)
putScheduledUpdateGroupAction_maxSize :: Lens' PutScheduledUpdateGroupAction (Maybe Int)
putScheduledUpdateGroupAction_maxSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScheduledUpdateGroupAction' {Maybe Int
maxSize :: Maybe Int
$sel:maxSize:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Int
maxSize} -> Maybe Int
maxSize) (\s :: PutScheduledUpdateGroupAction
s@PutScheduledUpdateGroupAction' {} Maybe Int
a -> PutScheduledUpdateGroupAction
s {$sel:maxSize:PutScheduledUpdateGroupAction' :: Maybe Int
maxSize = Maybe Int
a} :: PutScheduledUpdateGroupAction)

-- | The minimum size of the Auto Scaling group.
putScheduledUpdateGroupAction_minSize :: Lens.Lens' PutScheduledUpdateGroupAction (Prelude.Maybe Prelude.Int)
putScheduledUpdateGroupAction_minSize :: Lens' PutScheduledUpdateGroupAction (Maybe Int)
putScheduledUpdateGroupAction_minSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScheduledUpdateGroupAction' {Maybe Int
minSize :: Maybe Int
$sel:minSize:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Int
minSize} -> Maybe Int
minSize) (\s :: PutScheduledUpdateGroupAction
s@PutScheduledUpdateGroupAction' {} Maybe Int
a -> PutScheduledUpdateGroupAction
s {$sel:minSize:PutScheduledUpdateGroupAction' :: Maybe Int
minSize = Maybe Int
a} :: PutScheduledUpdateGroupAction)

-- | The recurring schedule for this action. This format consists of five
-- fields separated by white spaces: [Minute] [Hour] [Day_of_Month]
-- [Month_of_Year] [Day_of_Week]. The value must be in quotes (for example,
-- @\"30 0 1 1,6,12 *\"@). For more information about this format, see
-- <http://crontab.org Crontab>.
--
-- When @StartTime@ and @EndTime@ are specified with @Recurrence@, they
-- form the boundaries of when the recurring action starts and stops.
--
-- Cron expressions use Universal Coordinated Time (UTC) by default.
putScheduledUpdateGroupAction_recurrence :: Lens.Lens' PutScheduledUpdateGroupAction (Prelude.Maybe Prelude.Text)
putScheduledUpdateGroupAction_recurrence :: Lens' PutScheduledUpdateGroupAction (Maybe Text)
putScheduledUpdateGroupAction_recurrence = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScheduledUpdateGroupAction' {Maybe Text
recurrence :: Maybe Text
$sel:recurrence:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Text
recurrence} -> Maybe Text
recurrence) (\s :: PutScheduledUpdateGroupAction
s@PutScheduledUpdateGroupAction' {} Maybe Text
a -> PutScheduledUpdateGroupAction
s {$sel:recurrence:PutScheduledUpdateGroupAction' :: Maybe Text
recurrence = Maybe Text
a} :: PutScheduledUpdateGroupAction)

-- | The date and time for this action to start, in YYYY-MM-DDThh:mm:ssZ
-- format in UTC\/GMT only and in quotes (for example,
-- @\"2021-06-01T00:00:00Z\"@).
--
-- If you specify @Recurrence@ and @StartTime@, Amazon EC2 Auto Scaling
-- performs the action at this time, and then performs the action based on
-- the specified recurrence.
putScheduledUpdateGroupAction_startTime :: Lens.Lens' PutScheduledUpdateGroupAction (Prelude.Maybe Prelude.UTCTime)
putScheduledUpdateGroupAction_startTime :: Lens' PutScheduledUpdateGroupAction (Maybe UTCTime)
putScheduledUpdateGroupAction_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScheduledUpdateGroupAction' {Maybe ISO8601
startTime :: Maybe ISO8601
$sel:startTime:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe ISO8601
startTime} -> Maybe ISO8601
startTime) (\s :: PutScheduledUpdateGroupAction
s@PutScheduledUpdateGroupAction' {} Maybe ISO8601
a -> PutScheduledUpdateGroupAction
s {$sel:startTime:PutScheduledUpdateGroupAction' :: Maybe ISO8601
startTime = Maybe ISO8601
a} :: PutScheduledUpdateGroupAction) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | This property is no longer used.
putScheduledUpdateGroupAction_time :: Lens.Lens' PutScheduledUpdateGroupAction (Prelude.Maybe Prelude.UTCTime)
putScheduledUpdateGroupAction_time :: Lens' PutScheduledUpdateGroupAction (Maybe UTCTime)
putScheduledUpdateGroupAction_time = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScheduledUpdateGroupAction' {Maybe ISO8601
time :: Maybe ISO8601
$sel:time:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe ISO8601
time} -> Maybe ISO8601
time) (\s :: PutScheduledUpdateGroupAction
s@PutScheduledUpdateGroupAction' {} Maybe ISO8601
a -> PutScheduledUpdateGroupAction
s {$sel:time:PutScheduledUpdateGroupAction' :: Maybe ISO8601
time = Maybe ISO8601
a} :: PutScheduledUpdateGroupAction) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Specifies the time zone for a cron expression. If a time zone is not
-- provided, UTC is used by default.
--
-- Valid values are the canonical names of the IANA time zones, derived
-- from the IANA Time Zone Database (such as @Etc\/GMT+9@ or
-- @Pacific\/Tahiti@). For more information, see
-- <https://en.wikipedia.org/wiki/List_of_tz_database_time_zones>.
putScheduledUpdateGroupAction_timeZone :: Lens.Lens' PutScheduledUpdateGroupAction (Prelude.Maybe Prelude.Text)
putScheduledUpdateGroupAction_timeZone :: Lens' PutScheduledUpdateGroupAction (Maybe Text)
putScheduledUpdateGroupAction_timeZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScheduledUpdateGroupAction' {Maybe Text
timeZone :: Maybe Text
$sel:timeZone:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Text
timeZone} -> Maybe Text
timeZone) (\s :: PutScheduledUpdateGroupAction
s@PutScheduledUpdateGroupAction' {} Maybe Text
a -> PutScheduledUpdateGroupAction
s {$sel:timeZone:PutScheduledUpdateGroupAction' :: Maybe Text
timeZone = Maybe Text
a} :: PutScheduledUpdateGroupAction)

-- | The name of the Auto Scaling group.
putScheduledUpdateGroupAction_autoScalingGroupName :: Lens.Lens' PutScheduledUpdateGroupAction Prelude.Text
putScheduledUpdateGroupAction_autoScalingGroupName :: Lens' PutScheduledUpdateGroupAction Text
putScheduledUpdateGroupAction_autoScalingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScheduledUpdateGroupAction' {Text
autoScalingGroupName :: Text
$sel:autoScalingGroupName:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Text
autoScalingGroupName} -> Text
autoScalingGroupName) (\s :: PutScheduledUpdateGroupAction
s@PutScheduledUpdateGroupAction' {} Text
a -> PutScheduledUpdateGroupAction
s {$sel:autoScalingGroupName:PutScheduledUpdateGroupAction' :: Text
autoScalingGroupName = Text
a} :: PutScheduledUpdateGroupAction)

-- | The name of this scaling action.
putScheduledUpdateGroupAction_scheduledActionName :: Lens.Lens' PutScheduledUpdateGroupAction Prelude.Text
putScheduledUpdateGroupAction_scheduledActionName :: Lens' PutScheduledUpdateGroupAction Text
putScheduledUpdateGroupAction_scheduledActionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScheduledUpdateGroupAction' {Text
scheduledActionName :: Text
$sel:scheduledActionName:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Text
scheduledActionName} -> Text
scheduledActionName) (\s :: PutScheduledUpdateGroupAction
s@PutScheduledUpdateGroupAction' {} Text
a -> PutScheduledUpdateGroupAction
s {$sel:scheduledActionName:PutScheduledUpdateGroupAction' :: Text
scheduledActionName = Text
a} :: PutScheduledUpdateGroupAction)

instance
  Core.AWSRequest
    PutScheduledUpdateGroupAction
  where
  type
    AWSResponse PutScheduledUpdateGroupAction =
      PutScheduledUpdateGroupActionResponse
  request :: (Service -> Service)
-> PutScheduledUpdateGroupAction
-> Request PutScheduledUpdateGroupAction
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutScheduledUpdateGroupAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutScheduledUpdateGroupAction)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      PutScheduledUpdateGroupActionResponse
PutScheduledUpdateGroupActionResponse'

instance
  Prelude.Hashable
    PutScheduledUpdateGroupAction
  where
  hashWithSalt :: Int -> PutScheduledUpdateGroupAction -> Int
hashWithSalt Int
_salt PutScheduledUpdateGroupAction' {Maybe Int
Maybe Text
Maybe ISO8601
Text
scheduledActionName :: Text
autoScalingGroupName :: Text
timeZone :: Maybe Text
time :: Maybe ISO8601
startTime :: Maybe ISO8601
recurrence :: Maybe Text
minSize :: Maybe Int
maxSize :: Maybe Int
endTime :: Maybe ISO8601
desiredCapacity :: Maybe Int
$sel:scheduledActionName:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Text
$sel:autoScalingGroupName:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Text
$sel:timeZone:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Text
$sel:time:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe ISO8601
$sel:startTime:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe ISO8601
$sel:recurrence:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Text
$sel:minSize:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Int
$sel:maxSize:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Int
$sel:endTime:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe ISO8601
$sel:desiredCapacity:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
desiredCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
minSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
recurrence
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
time
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
timeZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
autoScalingGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
scheduledActionName

instance Prelude.NFData PutScheduledUpdateGroupAction where
  rnf :: PutScheduledUpdateGroupAction -> ()
rnf PutScheduledUpdateGroupAction' {Maybe Int
Maybe Text
Maybe ISO8601
Text
scheduledActionName :: Text
autoScalingGroupName :: Text
timeZone :: Maybe Text
time :: Maybe ISO8601
startTime :: Maybe ISO8601
recurrence :: Maybe Text
minSize :: Maybe Int
maxSize :: Maybe Int
endTime :: Maybe ISO8601
desiredCapacity :: Maybe Int
$sel:scheduledActionName:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Text
$sel:autoScalingGroupName:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Text
$sel:timeZone:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Text
$sel:time:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe ISO8601
$sel:startTime:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe ISO8601
$sel:recurrence:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Text
$sel:minSize:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Int
$sel:maxSize:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Int
$sel:endTime:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe ISO8601
$sel:desiredCapacity:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
desiredCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
minSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
recurrence
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
time
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
timeZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
autoScalingGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
scheduledActionName

instance Data.ToHeaders PutScheduledUpdateGroupAction where
  toHeaders :: PutScheduledUpdateGroupAction -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery PutScheduledUpdateGroupAction where
  toQuery :: PutScheduledUpdateGroupAction -> QueryString
toQuery PutScheduledUpdateGroupAction' {Maybe Int
Maybe Text
Maybe ISO8601
Text
scheduledActionName :: Text
autoScalingGroupName :: Text
timeZone :: Maybe Text
time :: Maybe ISO8601
startTime :: Maybe ISO8601
recurrence :: Maybe Text
minSize :: Maybe Int
maxSize :: Maybe Int
endTime :: Maybe ISO8601
desiredCapacity :: Maybe Int
$sel:scheduledActionName:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Text
$sel:autoScalingGroupName:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Text
$sel:timeZone:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Text
$sel:time:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe ISO8601
$sel:startTime:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe ISO8601
$sel:recurrence:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Text
$sel:minSize:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Int
$sel:maxSize:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Int
$sel:endTime:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe ISO8601
$sel:desiredCapacity:PutScheduledUpdateGroupAction' :: PutScheduledUpdateGroupAction -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"PutScheduledUpdateGroupAction" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2011-01-01" :: Prelude.ByteString),
        ByteString
"DesiredCapacity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
desiredCapacity,
        ByteString
"EndTime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
endTime,
        ByteString
"MaxSize" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxSize,
        ByteString
"MinSize" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
minSize,
        ByteString
"Recurrence" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
recurrence,
        ByteString
"StartTime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
startTime,
        ByteString
"Time" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
time,
        ByteString
"TimeZone" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
timeZone,
        ByteString
"AutoScalingGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
autoScalingGroupName,
        ByteString
"ScheduledActionName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
scheduledActionName
      ]

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

-- |
-- Create a value of 'PutScheduledUpdateGroupActionResponse' 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.
newPutScheduledUpdateGroupActionResponse ::
  PutScheduledUpdateGroupActionResponse
newPutScheduledUpdateGroupActionResponse :: PutScheduledUpdateGroupActionResponse
newPutScheduledUpdateGroupActionResponse =
  PutScheduledUpdateGroupActionResponse
PutScheduledUpdateGroupActionResponse'

instance
  Prelude.NFData
    PutScheduledUpdateGroupActionResponse
  where
  rnf :: PutScheduledUpdateGroupActionResponse -> ()
rnf PutScheduledUpdateGroupActionResponse
_ = ()