{-# 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.Redshift.CreateScheduledAction
-- 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 a scheduled action. A scheduled action contains a schedule and
-- an Amazon Redshift API action. For example, you can create a schedule of
-- when to run the @ResizeCluster@ API operation.
module Amazonka.Redshift.CreateScheduledAction
  ( -- * Creating a Request
    CreateScheduledAction (..),
    newCreateScheduledAction,

    -- * Request Lenses
    createScheduledAction_enable,
    createScheduledAction_endTime,
    createScheduledAction_scheduledActionDescription,
    createScheduledAction_startTime,
    createScheduledAction_scheduledActionName,
    createScheduledAction_targetAction,
    createScheduledAction_schedule,
    createScheduledAction_iamRole,

    -- * Destructuring the Response
    ScheduledAction (..),
    newScheduledAction,

    -- * Response Lenses
    scheduledAction_endTime,
    scheduledAction_iamRole,
    scheduledAction_nextInvocations,
    scheduledAction_schedule,
    scheduledAction_scheduledActionDescription,
    scheduledAction_scheduledActionName,
    scheduledAction_startTime,
    scheduledAction_state,
    scheduledAction_targetAction,
  )
where

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 Amazonka.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateScheduledAction' smart constructor.
data CreateScheduledAction = CreateScheduledAction'
  { -- | If true, the schedule is enabled. If false, the scheduled action does
    -- not trigger. For more information about @state@ of the scheduled action,
    -- see ScheduledAction.
    CreateScheduledAction -> Maybe Bool
enable :: Prelude.Maybe Prelude.Bool,
    -- | The end time in UTC of the scheduled action. After this time, the
    -- scheduled action does not trigger. For more information about this
    -- parameter, see ScheduledAction.
    CreateScheduledAction -> Maybe ISO8601
endTime :: Prelude.Maybe Data.ISO8601,
    -- | The description of the scheduled action.
    CreateScheduledAction -> Maybe Text
scheduledActionDescription :: Prelude.Maybe Prelude.Text,
    -- | The start time in UTC of the scheduled action. Before this time, the
    -- scheduled action does not trigger. For more information about this
    -- parameter, see ScheduledAction.
    CreateScheduledAction -> Maybe ISO8601
startTime :: Prelude.Maybe Data.ISO8601,
    -- | The name of the scheduled action. The name must be unique within an
    -- account. For more information about this parameter, see ScheduledAction.
    CreateScheduledAction -> Text
scheduledActionName :: Prelude.Text,
    -- | A JSON format string of the Amazon Redshift API operation with input
    -- parameters. For more information about this parameter, see
    -- ScheduledAction.
    CreateScheduledAction -> ScheduledActionType
targetAction :: ScheduledActionType,
    -- | The schedule in @at( )@ or @cron( )@ format. For more information about
    -- this parameter, see ScheduledAction.
    CreateScheduledAction -> Text
schedule :: Prelude.Text,
    -- | The IAM role to assume to run the target action. For more information
    -- about this parameter, see ScheduledAction.
    CreateScheduledAction -> Text
iamRole :: Prelude.Text
  }
  deriving (CreateScheduledAction -> CreateScheduledAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateScheduledAction -> CreateScheduledAction -> Bool
$c/= :: CreateScheduledAction -> CreateScheduledAction -> Bool
== :: CreateScheduledAction -> CreateScheduledAction -> Bool
$c== :: CreateScheduledAction -> CreateScheduledAction -> Bool
Prelude.Eq, ReadPrec [CreateScheduledAction]
ReadPrec CreateScheduledAction
Int -> ReadS CreateScheduledAction
ReadS [CreateScheduledAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateScheduledAction]
$creadListPrec :: ReadPrec [CreateScheduledAction]
readPrec :: ReadPrec CreateScheduledAction
$creadPrec :: ReadPrec CreateScheduledAction
readList :: ReadS [CreateScheduledAction]
$creadList :: ReadS [CreateScheduledAction]
readsPrec :: Int -> ReadS CreateScheduledAction
$creadsPrec :: Int -> ReadS CreateScheduledAction
Prelude.Read, Int -> CreateScheduledAction -> ShowS
[CreateScheduledAction] -> ShowS
CreateScheduledAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateScheduledAction] -> ShowS
$cshowList :: [CreateScheduledAction] -> ShowS
show :: CreateScheduledAction -> String
$cshow :: CreateScheduledAction -> String
showsPrec :: Int -> CreateScheduledAction -> ShowS
$cshowsPrec :: Int -> CreateScheduledAction -> ShowS
Prelude.Show, forall x. Rep CreateScheduledAction x -> CreateScheduledAction
forall x. CreateScheduledAction -> Rep CreateScheduledAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateScheduledAction x -> CreateScheduledAction
$cfrom :: forall x. CreateScheduledAction -> Rep CreateScheduledAction x
Prelude.Generic)

-- |
-- Create a value of 'CreateScheduledAction' 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:
--
-- 'enable', 'createScheduledAction_enable' - If true, the schedule is enabled. If false, the scheduled action does
-- not trigger. For more information about @state@ of the scheduled action,
-- see ScheduledAction.
--
-- 'endTime', 'createScheduledAction_endTime' - The end time in UTC of the scheduled action. After this time, the
-- scheduled action does not trigger. For more information about this
-- parameter, see ScheduledAction.
--
-- 'scheduledActionDescription', 'createScheduledAction_scheduledActionDescription' - The description of the scheduled action.
--
-- 'startTime', 'createScheduledAction_startTime' - The start time in UTC of the scheduled action. Before this time, the
-- scheduled action does not trigger. For more information about this
-- parameter, see ScheduledAction.
--
-- 'scheduledActionName', 'createScheduledAction_scheduledActionName' - The name of the scheduled action. The name must be unique within an
-- account. For more information about this parameter, see ScheduledAction.
--
-- 'targetAction', 'createScheduledAction_targetAction' - A JSON format string of the Amazon Redshift API operation with input
-- parameters. For more information about this parameter, see
-- ScheduledAction.
--
-- 'schedule', 'createScheduledAction_schedule' - The schedule in @at( )@ or @cron( )@ format. For more information about
-- this parameter, see ScheduledAction.
--
-- 'iamRole', 'createScheduledAction_iamRole' - The IAM role to assume to run the target action. For more information
-- about this parameter, see ScheduledAction.
newCreateScheduledAction ::
  -- | 'scheduledActionName'
  Prelude.Text ->
  -- | 'targetAction'
  ScheduledActionType ->
  -- | 'schedule'
  Prelude.Text ->
  -- | 'iamRole'
  Prelude.Text ->
  CreateScheduledAction
newCreateScheduledAction :: Text
-> ScheduledActionType -> Text -> Text -> CreateScheduledAction
newCreateScheduledAction
  Text
pScheduledActionName_
  ScheduledActionType
pTargetAction_
  Text
pSchedule_
  Text
pIamRole_ =
    CreateScheduledAction'
      { $sel:enable:CreateScheduledAction' :: Maybe Bool
enable = forall a. Maybe a
Prelude.Nothing,
        $sel:endTime:CreateScheduledAction' :: Maybe ISO8601
endTime = forall a. Maybe a
Prelude.Nothing,
        $sel:scheduledActionDescription:CreateScheduledAction' :: Maybe Text
scheduledActionDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:startTime:CreateScheduledAction' :: Maybe ISO8601
startTime = forall a. Maybe a
Prelude.Nothing,
        $sel:scheduledActionName:CreateScheduledAction' :: Text
scheduledActionName = Text
pScheduledActionName_,
        $sel:targetAction:CreateScheduledAction' :: ScheduledActionType
targetAction = ScheduledActionType
pTargetAction_,
        $sel:schedule:CreateScheduledAction' :: Text
schedule = Text
pSchedule_,
        $sel:iamRole:CreateScheduledAction' :: Text
iamRole = Text
pIamRole_
      }

-- | If true, the schedule is enabled. If false, the scheduled action does
-- not trigger. For more information about @state@ of the scheduled action,
-- see ScheduledAction.
createScheduledAction_enable :: Lens.Lens' CreateScheduledAction (Prelude.Maybe Prelude.Bool)
createScheduledAction_enable :: Lens' CreateScheduledAction (Maybe Bool)
createScheduledAction_enable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScheduledAction' {Maybe Bool
enable :: Maybe Bool
$sel:enable:CreateScheduledAction' :: CreateScheduledAction -> Maybe Bool
enable} -> Maybe Bool
enable) (\s :: CreateScheduledAction
s@CreateScheduledAction' {} Maybe Bool
a -> CreateScheduledAction
s {$sel:enable:CreateScheduledAction' :: Maybe Bool
enable = Maybe Bool
a} :: CreateScheduledAction)

-- | The end time in UTC of the scheduled action. After this time, the
-- scheduled action does not trigger. For more information about this
-- parameter, see ScheduledAction.
createScheduledAction_endTime :: Lens.Lens' CreateScheduledAction (Prelude.Maybe Prelude.UTCTime)
createScheduledAction_endTime :: Lens' CreateScheduledAction (Maybe UTCTime)
createScheduledAction_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScheduledAction' {Maybe ISO8601
endTime :: Maybe ISO8601
$sel:endTime:CreateScheduledAction' :: CreateScheduledAction -> Maybe ISO8601
endTime} -> Maybe ISO8601
endTime) (\s :: CreateScheduledAction
s@CreateScheduledAction' {} Maybe ISO8601
a -> CreateScheduledAction
s {$sel:endTime:CreateScheduledAction' :: Maybe ISO8601
endTime = Maybe ISO8601
a} :: CreateScheduledAction) 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 description of the scheduled action.
createScheduledAction_scheduledActionDescription :: Lens.Lens' CreateScheduledAction (Prelude.Maybe Prelude.Text)
createScheduledAction_scheduledActionDescription :: Lens' CreateScheduledAction (Maybe Text)
createScheduledAction_scheduledActionDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScheduledAction' {Maybe Text
scheduledActionDescription :: Maybe Text
$sel:scheduledActionDescription:CreateScheduledAction' :: CreateScheduledAction -> Maybe Text
scheduledActionDescription} -> Maybe Text
scheduledActionDescription) (\s :: CreateScheduledAction
s@CreateScheduledAction' {} Maybe Text
a -> CreateScheduledAction
s {$sel:scheduledActionDescription:CreateScheduledAction' :: Maybe Text
scheduledActionDescription = Maybe Text
a} :: CreateScheduledAction)

-- | The start time in UTC of the scheduled action. Before this time, the
-- scheduled action does not trigger. For more information about this
-- parameter, see ScheduledAction.
createScheduledAction_startTime :: Lens.Lens' CreateScheduledAction (Prelude.Maybe Prelude.UTCTime)
createScheduledAction_startTime :: Lens' CreateScheduledAction (Maybe UTCTime)
createScheduledAction_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScheduledAction' {Maybe ISO8601
startTime :: Maybe ISO8601
$sel:startTime:CreateScheduledAction' :: CreateScheduledAction -> Maybe ISO8601
startTime} -> Maybe ISO8601
startTime) (\s :: CreateScheduledAction
s@CreateScheduledAction' {} Maybe ISO8601
a -> CreateScheduledAction
s {$sel:startTime:CreateScheduledAction' :: Maybe ISO8601
startTime = Maybe ISO8601
a} :: CreateScheduledAction) 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 name of the scheduled action. The name must be unique within an
-- account. For more information about this parameter, see ScheduledAction.
createScheduledAction_scheduledActionName :: Lens.Lens' CreateScheduledAction Prelude.Text
createScheduledAction_scheduledActionName :: Lens' CreateScheduledAction Text
createScheduledAction_scheduledActionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScheduledAction' {Text
scheduledActionName :: Text
$sel:scheduledActionName:CreateScheduledAction' :: CreateScheduledAction -> Text
scheduledActionName} -> Text
scheduledActionName) (\s :: CreateScheduledAction
s@CreateScheduledAction' {} Text
a -> CreateScheduledAction
s {$sel:scheduledActionName:CreateScheduledAction' :: Text
scheduledActionName = Text
a} :: CreateScheduledAction)

-- | A JSON format string of the Amazon Redshift API operation with input
-- parameters. For more information about this parameter, see
-- ScheduledAction.
createScheduledAction_targetAction :: Lens.Lens' CreateScheduledAction ScheduledActionType
createScheduledAction_targetAction :: Lens' CreateScheduledAction ScheduledActionType
createScheduledAction_targetAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScheduledAction' {ScheduledActionType
targetAction :: ScheduledActionType
$sel:targetAction:CreateScheduledAction' :: CreateScheduledAction -> ScheduledActionType
targetAction} -> ScheduledActionType
targetAction) (\s :: CreateScheduledAction
s@CreateScheduledAction' {} ScheduledActionType
a -> CreateScheduledAction
s {$sel:targetAction:CreateScheduledAction' :: ScheduledActionType
targetAction = ScheduledActionType
a} :: CreateScheduledAction)

-- | The schedule in @at( )@ or @cron( )@ format. For more information about
-- this parameter, see ScheduledAction.
createScheduledAction_schedule :: Lens.Lens' CreateScheduledAction Prelude.Text
createScheduledAction_schedule :: Lens' CreateScheduledAction Text
createScheduledAction_schedule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScheduledAction' {Text
schedule :: Text
$sel:schedule:CreateScheduledAction' :: CreateScheduledAction -> Text
schedule} -> Text
schedule) (\s :: CreateScheduledAction
s@CreateScheduledAction' {} Text
a -> CreateScheduledAction
s {$sel:schedule:CreateScheduledAction' :: Text
schedule = Text
a} :: CreateScheduledAction)

-- | The IAM role to assume to run the target action. For more information
-- about this parameter, see ScheduledAction.
createScheduledAction_iamRole :: Lens.Lens' CreateScheduledAction Prelude.Text
createScheduledAction_iamRole :: Lens' CreateScheduledAction Text
createScheduledAction_iamRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScheduledAction' {Text
iamRole :: Text
$sel:iamRole:CreateScheduledAction' :: CreateScheduledAction -> Text
iamRole} -> Text
iamRole) (\s :: CreateScheduledAction
s@CreateScheduledAction' {} Text
a -> CreateScheduledAction
s {$sel:iamRole:CreateScheduledAction' :: Text
iamRole = Text
a} :: CreateScheduledAction)

instance Core.AWSRequest CreateScheduledAction where
  type
    AWSResponse CreateScheduledAction =
      ScheduledAction
  request :: (Service -> Service)
-> CreateScheduledAction -> Request CreateScheduledAction
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 CreateScheduledAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateScheduledAction)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"CreateScheduledActionResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable CreateScheduledAction where
  hashWithSalt :: Int -> CreateScheduledAction -> Int
hashWithSalt Int
_salt CreateScheduledAction' {Maybe Bool
Maybe Text
Maybe ISO8601
Text
ScheduledActionType
iamRole :: Text
schedule :: Text
targetAction :: ScheduledActionType
scheduledActionName :: Text
startTime :: Maybe ISO8601
scheduledActionDescription :: Maybe Text
endTime :: Maybe ISO8601
enable :: Maybe Bool
$sel:iamRole:CreateScheduledAction' :: CreateScheduledAction -> Text
$sel:schedule:CreateScheduledAction' :: CreateScheduledAction -> Text
$sel:targetAction:CreateScheduledAction' :: CreateScheduledAction -> ScheduledActionType
$sel:scheduledActionName:CreateScheduledAction' :: CreateScheduledAction -> Text
$sel:startTime:CreateScheduledAction' :: CreateScheduledAction -> Maybe ISO8601
$sel:scheduledActionDescription:CreateScheduledAction' :: CreateScheduledAction -> Maybe Text
$sel:endTime:CreateScheduledAction' :: CreateScheduledAction -> Maybe ISO8601
$sel:enable:CreateScheduledAction' :: CreateScheduledAction -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enable
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
scheduledActionDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
scheduledActionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ScheduledActionType
targetAction
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
schedule
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
iamRole

instance Prelude.NFData CreateScheduledAction where
  rnf :: CreateScheduledAction -> ()
rnf CreateScheduledAction' {Maybe Bool
Maybe Text
Maybe ISO8601
Text
ScheduledActionType
iamRole :: Text
schedule :: Text
targetAction :: ScheduledActionType
scheduledActionName :: Text
startTime :: Maybe ISO8601
scheduledActionDescription :: Maybe Text
endTime :: Maybe ISO8601
enable :: Maybe Bool
$sel:iamRole:CreateScheduledAction' :: CreateScheduledAction -> Text
$sel:schedule:CreateScheduledAction' :: CreateScheduledAction -> Text
$sel:targetAction:CreateScheduledAction' :: CreateScheduledAction -> ScheduledActionType
$sel:scheduledActionName:CreateScheduledAction' :: CreateScheduledAction -> Text
$sel:startTime:CreateScheduledAction' :: CreateScheduledAction -> Maybe ISO8601
$sel:scheduledActionDescription:CreateScheduledAction' :: CreateScheduledAction -> Maybe Text
$sel:endTime:CreateScheduledAction' :: CreateScheduledAction -> Maybe ISO8601
$sel:enable:CreateScheduledAction' :: CreateScheduledAction -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enable
      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 Text
scheduledActionDescription
      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 Text
scheduledActionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ScheduledActionType
targetAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
schedule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
iamRole

instance Data.ToHeaders CreateScheduledAction where
  toHeaders :: CreateScheduledAction -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery CreateScheduledAction where
  toQuery :: CreateScheduledAction -> QueryString
toQuery CreateScheduledAction' {Maybe Bool
Maybe Text
Maybe ISO8601
Text
ScheduledActionType
iamRole :: Text
schedule :: Text
targetAction :: ScheduledActionType
scheduledActionName :: Text
startTime :: Maybe ISO8601
scheduledActionDescription :: Maybe Text
endTime :: Maybe ISO8601
enable :: Maybe Bool
$sel:iamRole:CreateScheduledAction' :: CreateScheduledAction -> Text
$sel:schedule:CreateScheduledAction' :: CreateScheduledAction -> Text
$sel:targetAction:CreateScheduledAction' :: CreateScheduledAction -> ScheduledActionType
$sel:scheduledActionName:CreateScheduledAction' :: CreateScheduledAction -> Text
$sel:startTime:CreateScheduledAction' :: CreateScheduledAction -> Maybe ISO8601
$sel:scheduledActionDescription:CreateScheduledAction' :: CreateScheduledAction -> Maybe Text
$sel:endTime:CreateScheduledAction' :: CreateScheduledAction -> Maybe ISO8601
$sel:enable:CreateScheduledAction' :: CreateScheduledAction -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateScheduledAction" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"Enable" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
enable,
        ByteString
"EndTime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
endTime,
        ByteString
"ScheduledActionDescription"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
scheduledActionDescription,
        ByteString
"StartTime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
startTime,
        ByteString
"ScheduledActionName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
scheduledActionName,
        ByteString
"TargetAction" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ScheduledActionType
targetAction,
        ByteString
"Schedule" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
schedule,
        ByteString
"IamRole" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
iamRole
      ]