{-# 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.Scheduler.GetSchedule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the specified schedule.
module Amazonka.Scheduler.GetSchedule
  ( -- * Creating a Request
    GetSchedule (..),
    newGetSchedule,

    -- * Request Lenses
    getSchedule_groupName,
    getSchedule_name,

    -- * Destructuring the Response
    GetScheduleResponse (..),
    newGetScheduleResponse,

    -- * Response Lenses
    getScheduleResponse_arn,
    getScheduleResponse_creationDate,
    getScheduleResponse_description,
    getScheduleResponse_endDate,
    getScheduleResponse_flexibleTimeWindow,
    getScheduleResponse_groupName,
    getScheduleResponse_kmsKeyArn,
    getScheduleResponse_lastModificationDate,
    getScheduleResponse_name,
    getScheduleResponse_scheduleExpression,
    getScheduleResponse_scheduleExpressionTimezone,
    getScheduleResponse_startDate,
    getScheduleResponse_state,
    getScheduleResponse_target,
    getScheduleResponse_httpStatus,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Scheduler.Types

-- | /See:/ 'newGetSchedule' smart constructor.
data GetSchedule = GetSchedule'
  { -- | The name of the schedule group associated with this schedule. If you
    -- omit this, EventBridge Scheduler assumes that the schedule is associated
    -- with the default group.
    GetSchedule -> Maybe Text
groupName :: Prelude.Maybe Prelude.Text,
    -- | The name of the schedule to retrieve.
    GetSchedule -> Text
name :: Prelude.Text
  }
  deriving (GetSchedule -> GetSchedule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSchedule -> GetSchedule -> Bool
$c/= :: GetSchedule -> GetSchedule -> Bool
== :: GetSchedule -> GetSchedule -> Bool
$c== :: GetSchedule -> GetSchedule -> Bool
Prelude.Eq, ReadPrec [GetSchedule]
ReadPrec GetSchedule
Int -> ReadS GetSchedule
ReadS [GetSchedule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSchedule]
$creadListPrec :: ReadPrec [GetSchedule]
readPrec :: ReadPrec GetSchedule
$creadPrec :: ReadPrec GetSchedule
readList :: ReadS [GetSchedule]
$creadList :: ReadS [GetSchedule]
readsPrec :: Int -> ReadS GetSchedule
$creadsPrec :: Int -> ReadS GetSchedule
Prelude.Read, Int -> GetSchedule -> ShowS
[GetSchedule] -> ShowS
GetSchedule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSchedule] -> ShowS
$cshowList :: [GetSchedule] -> ShowS
show :: GetSchedule -> String
$cshow :: GetSchedule -> String
showsPrec :: Int -> GetSchedule -> ShowS
$cshowsPrec :: Int -> GetSchedule -> ShowS
Prelude.Show, forall x. Rep GetSchedule x -> GetSchedule
forall x. GetSchedule -> Rep GetSchedule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSchedule x -> GetSchedule
$cfrom :: forall x. GetSchedule -> Rep GetSchedule x
Prelude.Generic)

-- |
-- Create a value of 'GetSchedule' 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:
--
-- 'groupName', 'getSchedule_groupName' - The name of the schedule group associated with this schedule. If you
-- omit this, EventBridge Scheduler assumes that the schedule is associated
-- with the default group.
--
-- 'name', 'getSchedule_name' - The name of the schedule to retrieve.
newGetSchedule ::
  -- | 'name'
  Prelude.Text ->
  GetSchedule
newGetSchedule :: Text -> GetSchedule
newGetSchedule Text
pName_ =
  GetSchedule'
    { $sel:groupName:GetSchedule' :: Maybe Text
groupName = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetSchedule' :: Text
name = Text
pName_
    }

-- | The name of the schedule group associated with this schedule. If you
-- omit this, EventBridge Scheduler assumes that the schedule is associated
-- with the default group.
getSchedule_groupName :: Lens.Lens' GetSchedule (Prelude.Maybe Prelude.Text)
getSchedule_groupName :: Lens' GetSchedule (Maybe Text)
getSchedule_groupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSchedule' {Maybe Text
groupName :: Maybe Text
$sel:groupName:GetSchedule' :: GetSchedule -> Maybe Text
groupName} -> Maybe Text
groupName) (\s :: GetSchedule
s@GetSchedule' {} Maybe Text
a -> GetSchedule
s {$sel:groupName:GetSchedule' :: Maybe Text
groupName = Maybe Text
a} :: GetSchedule)

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

instance Core.AWSRequest GetSchedule where
  type AWSResponse GetSchedule = GetScheduleResponse
  request :: (Service -> Service) -> GetSchedule -> Request GetSchedule
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetSchedule
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetSchedule)))
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
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe FlexibleTimeWindow
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe ScheduleState
-> Maybe Target
-> Int
-> GetScheduleResponse
GetScheduleResponse'
            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
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CreationDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"EndDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FlexibleTimeWindow")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"GroupName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"KmsKeyArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LastModificationDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ScheduleExpression")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ScheduleExpressionTimezone")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StartDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"State")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Target")
            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 GetSchedule where
  hashWithSalt :: Int -> GetSchedule -> Int
hashWithSalt Int
_salt GetSchedule' {Maybe Text
Text
name :: Text
groupName :: Maybe Text
$sel:name:GetSchedule' :: GetSchedule -> Text
$sel:groupName:GetSchedule' :: GetSchedule -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
groupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

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

instance Data.ToHeaders GetSchedule where
  toHeaders :: GetSchedule -> 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.ToPath GetSchedule where
  toPath :: GetSchedule -> ByteString
toPath GetSchedule' {Maybe Text
Text
name :: Text
groupName :: Maybe Text
$sel:name:GetSchedule' :: GetSchedule -> Text
$sel:groupName:GetSchedule' :: GetSchedule -> 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 GetSchedule where
  toQuery :: GetSchedule -> QueryString
toQuery GetSchedule' {Maybe Text
Text
name :: Text
groupName :: Maybe Text
$sel:name:GetSchedule' :: GetSchedule -> Text
$sel:groupName:GetSchedule' :: GetSchedule -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"groupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
groupName]

-- | /See:/ 'newGetScheduleResponse' smart constructor.
data GetScheduleResponse = GetScheduleResponse'
  { -- | The Amazon Resource Name (ARN) of the schedule.
    GetScheduleResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The time at which the schedule was created.
    GetScheduleResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | The description of the schedule.
    GetScheduleResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The date, in UTC, before which the schedule can invoke its target.
    -- Depending on the schedule\'s recurrence expression, invocations might
    -- stop on, or before, the @EndDate@ you specify. EventBridge Scheduler
    -- ignores @EndDate@ for one-time schedules.
    GetScheduleResponse -> Maybe POSIX
endDate :: Prelude.Maybe Data.POSIX,
    -- | Allows you to configure a time window during which EventBridge Scheduler
    -- invokes the schedule.
    GetScheduleResponse -> Maybe FlexibleTimeWindow
flexibleTimeWindow :: Prelude.Maybe FlexibleTimeWindow,
    -- | The name of the schedule group associated with this schedule.
    GetScheduleResponse -> Maybe Text
groupName :: Prelude.Maybe Prelude.Text,
    -- | The ARN for a customer managed KMS Key that is be used to encrypt and
    -- decrypt your data.
    GetScheduleResponse -> Maybe Text
kmsKeyArn :: Prelude.Maybe Prelude.Text,
    -- | The time at which the schedule was last modified.
    GetScheduleResponse -> Maybe POSIX
lastModificationDate :: Prelude.Maybe Data.POSIX,
    -- | The name of the schedule.
    GetScheduleResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The expression that defines when the schedule runs. The following
    -- formats are supported.
    --
    -- -   @at@ expression - @at(yyyy-mm-ddThh:mm:ss)@
    --
    -- -   @rate@ expression - @rate(unit value)@
    --
    -- -   @cron@ expression - @cron(fields)@
    --
    -- You can use @at@ expressions to create one-time schedules that invoke a
    -- target once, at the time and in the time zone, that you specify. You can
    -- use @rate@ and @cron@ expressions to create recurring schedules.
    -- Rate-based schedules are useful when you want to invoke a target at
    -- regular intervals, such as every 15 minutes or every five days.
    -- Cron-based schedules are useful when you want to invoke a target
    -- periodically at a specific time, such as at 8:00 am (UTC+0) every 1st
    -- day of the month.
    --
    -- A @cron@ expression consists of six fields separated by white spaces:
    -- @(minutes hours day_of_month month day_of_week year)@.
    --
    -- A @rate@ expression consists of a /value/ as a positive integer, and a
    -- /unit/ with the following options: @minute@ | @minutes@ | @hour@ |
    -- @hours@ | @day@ | @days@
    --
    -- For more information and examples, see
    -- <https://docs.aws.amazon.com/scheduler/latest/UserGuide/schedule-types.html Schedule types on EventBridge Scheduler>
    -- in the /EventBridge Scheduler User Guide/.
    GetScheduleResponse -> Maybe Text
scheduleExpression :: Prelude.Maybe Prelude.Text,
    -- | The timezone in which the scheduling expression is evaluated.
    GetScheduleResponse -> Maybe Text
scheduleExpressionTimezone :: Prelude.Maybe Prelude.Text,
    -- | The date, in UTC, after which the schedule can begin invoking its
    -- target. Depending on the schedule\'s recurrence expression, invocations
    -- might occur on, or after, the @StartDate@ you specify. EventBridge
    -- Scheduler ignores @StartDate@ for one-time schedules.
    GetScheduleResponse -> Maybe POSIX
startDate :: Prelude.Maybe Data.POSIX,
    -- | Specifies whether the schedule is enabled or disabled.
    GetScheduleResponse -> Maybe ScheduleState
state :: Prelude.Maybe ScheduleState,
    -- | The schedule target.
    GetScheduleResponse -> Maybe Target
target :: Prelude.Maybe Target,
    -- | The response's http status code.
    GetScheduleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetScheduleResponse -> GetScheduleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetScheduleResponse -> GetScheduleResponse -> Bool
$c/= :: GetScheduleResponse -> GetScheduleResponse -> Bool
== :: GetScheduleResponse -> GetScheduleResponse -> Bool
$c== :: GetScheduleResponse -> GetScheduleResponse -> Bool
Prelude.Eq, ReadPrec [GetScheduleResponse]
ReadPrec GetScheduleResponse
Int -> ReadS GetScheduleResponse
ReadS [GetScheduleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetScheduleResponse]
$creadListPrec :: ReadPrec [GetScheduleResponse]
readPrec :: ReadPrec GetScheduleResponse
$creadPrec :: ReadPrec GetScheduleResponse
readList :: ReadS [GetScheduleResponse]
$creadList :: ReadS [GetScheduleResponse]
readsPrec :: Int -> ReadS GetScheduleResponse
$creadsPrec :: Int -> ReadS GetScheduleResponse
Prelude.Read, Int -> GetScheduleResponse -> ShowS
[GetScheduleResponse] -> ShowS
GetScheduleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetScheduleResponse] -> ShowS
$cshowList :: [GetScheduleResponse] -> ShowS
show :: GetScheduleResponse -> String
$cshow :: GetScheduleResponse -> String
showsPrec :: Int -> GetScheduleResponse -> ShowS
$cshowsPrec :: Int -> GetScheduleResponse -> ShowS
Prelude.Show, forall x. Rep GetScheduleResponse x -> GetScheduleResponse
forall x. GetScheduleResponse -> Rep GetScheduleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetScheduleResponse x -> GetScheduleResponse
$cfrom :: forall x. GetScheduleResponse -> Rep GetScheduleResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetScheduleResponse' 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:
--
-- 'arn', 'getScheduleResponse_arn' - The Amazon Resource Name (ARN) of the schedule.
--
-- 'creationDate', 'getScheduleResponse_creationDate' - The time at which the schedule was created.
--
-- 'description', 'getScheduleResponse_description' - The description of the schedule.
--
-- 'endDate', 'getScheduleResponse_endDate' - The date, in UTC, before which the schedule can invoke its target.
-- Depending on the schedule\'s recurrence expression, invocations might
-- stop on, or before, the @EndDate@ you specify. EventBridge Scheduler
-- ignores @EndDate@ for one-time schedules.
--
-- 'flexibleTimeWindow', 'getScheduleResponse_flexibleTimeWindow' - Allows you to configure a time window during which EventBridge Scheduler
-- invokes the schedule.
--
-- 'groupName', 'getScheduleResponse_groupName' - The name of the schedule group associated with this schedule.
--
-- 'kmsKeyArn', 'getScheduleResponse_kmsKeyArn' - The ARN for a customer managed KMS Key that is be used to encrypt and
-- decrypt your data.
--
-- 'lastModificationDate', 'getScheduleResponse_lastModificationDate' - The time at which the schedule was last modified.
--
-- 'name', 'getScheduleResponse_name' - The name of the schedule.
--
-- 'scheduleExpression', 'getScheduleResponse_scheduleExpression' - The expression that defines when the schedule runs. The following
-- formats are supported.
--
-- -   @at@ expression - @at(yyyy-mm-ddThh:mm:ss)@
--
-- -   @rate@ expression - @rate(unit value)@
--
-- -   @cron@ expression - @cron(fields)@
--
-- You can use @at@ expressions to create one-time schedules that invoke a
-- target once, at the time and in the time zone, that you specify. You can
-- use @rate@ and @cron@ expressions to create recurring schedules.
-- Rate-based schedules are useful when you want to invoke a target at
-- regular intervals, such as every 15 minutes or every five days.
-- Cron-based schedules are useful when you want to invoke a target
-- periodically at a specific time, such as at 8:00 am (UTC+0) every 1st
-- day of the month.
--
-- A @cron@ expression consists of six fields separated by white spaces:
-- @(minutes hours day_of_month month day_of_week year)@.
--
-- A @rate@ expression consists of a /value/ as a positive integer, and a
-- /unit/ with the following options: @minute@ | @minutes@ | @hour@ |
-- @hours@ | @day@ | @days@
--
-- For more information and examples, see
-- <https://docs.aws.amazon.com/scheduler/latest/UserGuide/schedule-types.html Schedule types on EventBridge Scheduler>
-- in the /EventBridge Scheduler User Guide/.
--
-- 'scheduleExpressionTimezone', 'getScheduleResponse_scheduleExpressionTimezone' - The timezone in which the scheduling expression is evaluated.
--
-- 'startDate', 'getScheduleResponse_startDate' - The date, in UTC, after which the schedule can begin invoking its
-- target. Depending on the schedule\'s recurrence expression, invocations
-- might occur on, or after, the @StartDate@ you specify. EventBridge
-- Scheduler ignores @StartDate@ for one-time schedules.
--
-- 'state', 'getScheduleResponse_state' - Specifies whether the schedule is enabled or disabled.
--
-- 'target', 'getScheduleResponse_target' - The schedule target.
--
-- 'httpStatus', 'getScheduleResponse_httpStatus' - The response's http status code.
newGetScheduleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetScheduleResponse
newGetScheduleResponse :: Int -> GetScheduleResponse
newGetScheduleResponse Int
pHttpStatus_ =
  GetScheduleResponse'
    { $sel:arn:GetScheduleResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:GetScheduleResponse' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:description:GetScheduleResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:endDate:GetScheduleResponse' :: Maybe POSIX
endDate = forall a. Maybe a
Prelude.Nothing,
      $sel:flexibleTimeWindow:GetScheduleResponse' :: Maybe FlexibleTimeWindow
flexibleTimeWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:groupName:GetScheduleResponse' :: Maybe Text
groupName = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyArn:GetScheduleResponse' :: Maybe Text
kmsKeyArn = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModificationDate:GetScheduleResponse' :: Maybe POSIX
lastModificationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetScheduleResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:scheduleExpression:GetScheduleResponse' :: Maybe Text
scheduleExpression = forall a. Maybe a
Prelude.Nothing,
      $sel:scheduleExpressionTimezone:GetScheduleResponse' :: Maybe Text
scheduleExpressionTimezone = forall a. Maybe a
Prelude.Nothing,
      $sel:startDate:GetScheduleResponse' :: Maybe POSIX
startDate = forall a. Maybe a
Prelude.Nothing,
      $sel:state:GetScheduleResponse' :: Maybe ScheduleState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:target:GetScheduleResponse' :: Maybe Target
target = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetScheduleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the schedule.
getScheduleResponse_arn :: Lens.Lens' GetScheduleResponse (Prelude.Maybe Prelude.Text)
getScheduleResponse_arn :: Lens' GetScheduleResponse (Maybe Text)
getScheduleResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe Text
a -> GetScheduleResponse
s {$sel:arn:GetScheduleResponse' :: Maybe Text
arn = Maybe Text
a} :: GetScheduleResponse)

-- | The time at which the schedule was created.
getScheduleResponse_creationDate :: Lens.Lens' GetScheduleResponse (Prelude.Maybe Prelude.UTCTime)
getScheduleResponse_creationDate :: Lens' GetScheduleResponse (Maybe UTCTime)
getScheduleResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:GetScheduleResponse' :: GetScheduleResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe POSIX
a -> GetScheduleResponse
s {$sel:creationDate:GetScheduleResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: GetScheduleResponse) 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 schedule.
getScheduleResponse_description :: Lens.Lens' GetScheduleResponse (Prelude.Maybe Prelude.Text)
getScheduleResponse_description :: Lens' GetScheduleResponse (Maybe Text)
getScheduleResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe Text
description :: Maybe Text
$sel:description:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe Text
a -> GetScheduleResponse
s {$sel:description:GetScheduleResponse' :: Maybe Text
description = Maybe Text
a} :: GetScheduleResponse)

-- | The date, in UTC, before which the schedule can invoke its target.
-- Depending on the schedule\'s recurrence expression, invocations might
-- stop on, or before, the @EndDate@ you specify. EventBridge Scheduler
-- ignores @EndDate@ for one-time schedules.
getScheduleResponse_endDate :: Lens.Lens' GetScheduleResponse (Prelude.Maybe Prelude.UTCTime)
getScheduleResponse_endDate :: Lens' GetScheduleResponse (Maybe UTCTime)
getScheduleResponse_endDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe POSIX
endDate :: Maybe POSIX
$sel:endDate:GetScheduleResponse' :: GetScheduleResponse -> Maybe POSIX
endDate} -> Maybe POSIX
endDate) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe POSIX
a -> GetScheduleResponse
s {$sel:endDate:GetScheduleResponse' :: Maybe POSIX
endDate = Maybe POSIX
a} :: GetScheduleResponse) 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

-- | Allows you to configure a time window during which EventBridge Scheduler
-- invokes the schedule.
getScheduleResponse_flexibleTimeWindow :: Lens.Lens' GetScheduleResponse (Prelude.Maybe FlexibleTimeWindow)
getScheduleResponse_flexibleTimeWindow :: Lens' GetScheduleResponse (Maybe FlexibleTimeWindow)
getScheduleResponse_flexibleTimeWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe FlexibleTimeWindow
flexibleTimeWindow :: Maybe FlexibleTimeWindow
$sel:flexibleTimeWindow:GetScheduleResponse' :: GetScheduleResponse -> Maybe FlexibleTimeWindow
flexibleTimeWindow} -> Maybe FlexibleTimeWindow
flexibleTimeWindow) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe FlexibleTimeWindow
a -> GetScheduleResponse
s {$sel:flexibleTimeWindow:GetScheduleResponse' :: Maybe FlexibleTimeWindow
flexibleTimeWindow = Maybe FlexibleTimeWindow
a} :: GetScheduleResponse)

-- | The name of the schedule group associated with this schedule.
getScheduleResponse_groupName :: Lens.Lens' GetScheduleResponse (Prelude.Maybe Prelude.Text)
getScheduleResponse_groupName :: Lens' GetScheduleResponse (Maybe Text)
getScheduleResponse_groupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe Text
groupName :: Maybe Text
$sel:groupName:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
groupName} -> Maybe Text
groupName) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe Text
a -> GetScheduleResponse
s {$sel:groupName:GetScheduleResponse' :: Maybe Text
groupName = Maybe Text
a} :: GetScheduleResponse)

-- | The ARN for a customer managed KMS Key that is be used to encrypt and
-- decrypt your data.
getScheduleResponse_kmsKeyArn :: Lens.Lens' GetScheduleResponse (Prelude.Maybe Prelude.Text)
getScheduleResponse_kmsKeyArn :: Lens' GetScheduleResponse (Maybe Text)
getScheduleResponse_kmsKeyArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe Text
kmsKeyArn :: Maybe Text
$sel:kmsKeyArn:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
kmsKeyArn} -> Maybe Text
kmsKeyArn) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe Text
a -> GetScheduleResponse
s {$sel:kmsKeyArn:GetScheduleResponse' :: Maybe Text
kmsKeyArn = Maybe Text
a} :: GetScheduleResponse)

-- | The time at which the schedule was last modified.
getScheduleResponse_lastModificationDate :: Lens.Lens' GetScheduleResponse (Prelude.Maybe Prelude.UTCTime)
getScheduleResponse_lastModificationDate :: Lens' GetScheduleResponse (Maybe UTCTime)
getScheduleResponse_lastModificationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe POSIX
lastModificationDate :: Maybe POSIX
$sel:lastModificationDate:GetScheduleResponse' :: GetScheduleResponse -> Maybe POSIX
lastModificationDate} -> Maybe POSIX
lastModificationDate) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe POSIX
a -> GetScheduleResponse
s {$sel:lastModificationDate:GetScheduleResponse' :: Maybe POSIX
lastModificationDate = Maybe POSIX
a} :: GetScheduleResponse) 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 schedule.
getScheduleResponse_name :: Lens.Lens' GetScheduleResponse (Prelude.Maybe Prelude.Text)
getScheduleResponse_name :: Lens' GetScheduleResponse (Maybe Text)
getScheduleResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe Text
name :: Maybe Text
$sel:name:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe Text
a -> GetScheduleResponse
s {$sel:name:GetScheduleResponse' :: Maybe Text
name = Maybe Text
a} :: GetScheduleResponse)

-- | The expression that defines when the schedule runs. The following
-- formats are supported.
--
-- -   @at@ expression - @at(yyyy-mm-ddThh:mm:ss)@
--
-- -   @rate@ expression - @rate(unit value)@
--
-- -   @cron@ expression - @cron(fields)@
--
-- You can use @at@ expressions to create one-time schedules that invoke a
-- target once, at the time and in the time zone, that you specify. You can
-- use @rate@ and @cron@ expressions to create recurring schedules.
-- Rate-based schedules are useful when you want to invoke a target at
-- regular intervals, such as every 15 minutes or every five days.
-- Cron-based schedules are useful when you want to invoke a target
-- periodically at a specific time, such as at 8:00 am (UTC+0) every 1st
-- day of the month.
--
-- A @cron@ expression consists of six fields separated by white spaces:
-- @(minutes hours day_of_month month day_of_week year)@.
--
-- A @rate@ expression consists of a /value/ as a positive integer, and a
-- /unit/ with the following options: @minute@ | @minutes@ | @hour@ |
-- @hours@ | @day@ | @days@
--
-- For more information and examples, see
-- <https://docs.aws.amazon.com/scheduler/latest/UserGuide/schedule-types.html Schedule types on EventBridge Scheduler>
-- in the /EventBridge Scheduler User Guide/.
getScheduleResponse_scheduleExpression :: Lens.Lens' GetScheduleResponse (Prelude.Maybe Prelude.Text)
getScheduleResponse_scheduleExpression :: Lens' GetScheduleResponse (Maybe Text)
getScheduleResponse_scheduleExpression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe Text
scheduleExpression :: Maybe Text
$sel:scheduleExpression:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
scheduleExpression} -> Maybe Text
scheduleExpression) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe Text
a -> GetScheduleResponse
s {$sel:scheduleExpression:GetScheduleResponse' :: Maybe Text
scheduleExpression = Maybe Text
a} :: GetScheduleResponse)

-- | The timezone in which the scheduling expression is evaluated.
getScheduleResponse_scheduleExpressionTimezone :: Lens.Lens' GetScheduleResponse (Prelude.Maybe Prelude.Text)
getScheduleResponse_scheduleExpressionTimezone :: Lens' GetScheduleResponse (Maybe Text)
getScheduleResponse_scheduleExpressionTimezone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe Text
scheduleExpressionTimezone :: Maybe Text
$sel:scheduleExpressionTimezone:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
scheduleExpressionTimezone} -> Maybe Text
scheduleExpressionTimezone) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe Text
a -> GetScheduleResponse
s {$sel:scheduleExpressionTimezone:GetScheduleResponse' :: Maybe Text
scheduleExpressionTimezone = Maybe Text
a} :: GetScheduleResponse)

-- | The date, in UTC, after which the schedule can begin invoking its
-- target. Depending on the schedule\'s recurrence expression, invocations
-- might occur on, or after, the @StartDate@ you specify. EventBridge
-- Scheduler ignores @StartDate@ for one-time schedules.
getScheduleResponse_startDate :: Lens.Lens' GetScheduleResponse (Prelude.Maybe Prelude.UTCTime)
getScheduleResponse_startDate :: Lens' GetScheduleResponse (Maybe UTCTime)
getScheduleResponse_startDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe POSIX
startDate :: Maybe POSIX
$sel:startDate:GetScheduleResponse' :: GetScheduleResponse -> Maybe POSIX
startDate} -> Maybe POSIX
startDate) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe POSIX
a -> GetScheduleResponse
s {$sel:startDate:GetScheduleResponse' :: Maybe POSIX
startDate = Maybe POSIX
a} :: GetScheduleResponse) 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 whether the schedule is enabled or disabled.
getScheduleResponse_state :: Lens.Lens' GetScheduleResponse (Prelude.Maybe ScheduleState)
getScheduleResponse_state :: Lens' GetScheduleResponse (Maybe ScheduleState)
getScheduleResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe ScheduleState
state :: Maybe ScheduleState
$sel:state:GetScheduleResponse' :: GetScheduleResponse -> Maybe ScheduleState
state} -> Maybe ScheduleState
state) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe ScheduleState
a -> GetScheduleResponse
s {$sel:state:GetScheduleResponse' :: Maybe ScheduleState
state = Maybe ScheduleState
a} :: GetScheduleResponse)

-- | The schedule target.
getScheduleResponse_target :: Lens.Lens' GetScheduleResponse (Prelude.Maybe Target)
getScheduleResponse_target :: Lens' GetScheduleResponse (Maybe Target)
getScheduleResponse_target = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScheduleResponse' {Maybe Target
target :: Maybe Target
$sel:target:GetScheduleResponse' :: GetScheduleResponse -> Maybe Target
target} -> Maybe Target
target) (\s :: GetScheduleResponse
s@GetScheduleResponse' {} Maybe Target
a -> GetScheduleResponse
s {$sel:target:GetScheduleResponse' :: Maybe Target
target = Maybe Target
a} :: GetScheduleResponse)

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

instance Prelude.NFData GetScheduleResponse where
  rnf :: GetScheduleResponse -> ()
rnf GetScheduleResponse' {Int
Maybe Text
Maybe POSIX
Maybe FlexibleTimeWindow
Maybe ScheduleState
Maybe Target
httpStatus :: Int
target :: Maybe Target
state :: Maybe ScheduleState
startDate :: Maybe POSIX
scheduleExpressionTimezone :: Maybe Text
scheduleExpression :: Maybe Text
name :: Maybe Text
lastModificationDate :: Maybe POSIX
kmsKeyArn :: Maybe Text
groupName :: Maybe Text
flexibleTimeWindow :: Maybe FlexibleTimeWindow
endDate :: Maybe POSIX
description :: Maybe Text
creationDate :: Maybe POSIX
arn :: Maybe Text
$sel:httpStatus:GetScheduleResponse' :: GetScheduleResponse -> Int
$sel:target:GetScheduleResponse' :: GetScheduleResponse -> Maybe Target
$sel:state:GetScheduleResponse' :: GetScheduleResponse -> Maybe ScheduleState
$sel:startDate:GetScheduleResponse' :: GetScheduleResponse -> Maybe POSIX
$sel:scheduleExpressionTimezone:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
$sel:scheduleExpression:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
$sel:name:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
$sel:lastModificationDate:GetScheduleResponse' :: GetScheduleResponse -> Maybe POSIX
$sel:kmsKeyArn:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
$sel:groupName:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
$sel:flexibleTimeWindow:GetScheduleResponse' :: GetScheduleResponse -> Maybe FlexibleTimeWindow
$sel:endDate:GetScheduleResponse' :: GetScheduleResponse -> Maybe POSIX
$sel:description:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
$sel:creationDate:GetScheduleResponse' :: GetScheduleResponse -> Maybe POSIX
$sel:arn:GetScheduleResponse' :: GetScheduleResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
endDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FlexibleTimeWindow
flexibleTimeWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
groupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModificationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
scheduleExpression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
scheduleExpressionTimezone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ScheduleState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Target
target
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus