{-# 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.SSM.GetCalendarState
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the state of a Amazon Web Services Systems Manager change calendar
-- at the current time or a specified time. If you specify a time,
-- @GetCalendarState@ returns the state of the calendar at that specific
-- time, and returns the next time that the change calendar state will
-- transition. If you don\'t specify a time, @GetCalendarState@ uses the
-- current time. Change Calendar entries have two possible states: @OPEN@
-- or @CLOSED@.
--
-- If you specify more than one calendar in a request, the command returns
-- the status of @OPEN@ only if all calendars in the request are open. If
-- one or more calendars in the request are closed, the status returned is
-- @CLOSED@.
--
-- For more information about Change Calendar, a capability of Amazon Web
-- Services Systems Manager, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/systems-manager-change-calendar.html Amazon Web Services Systems Manager Change Calendar>
-- in the /Amazon Web Services Systems Manager User Guide/.
module Amazonka.SSM.GetCalendarState
  ( -- * Creating a Request
    GetCalendarState (..),
    newGetCalendarState,

    -- * Request Lenses
    getCalendarState_atTime,
    getCalendarState_calendarNames,

    -- * Destructuring the Response
    GetCalendarStateResponse (..),
    newGetCalendarStateResponse,

    -- * Response Lenses
    getCalendarStateResponse_atTime,
    getCalendarStateResponse_nextTransitionTime,
    getCalendarStateResponse_state,
    getCalendarStateResponse_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.SSM.Types

-- | /See:/ 'newGetCalendarState' smart constructor.
data GetCalendarState = GetCalendarState'
  { -- | (Optional) The specific time for which you want to get calendar state
    -- information, in <https://en.wikipedia.org/wiki/ISO_8601 ISO 8601>
    -- format. If you don\'t specify a value or @AtTime@, the current time is
    -- used.
    GetCalendarState -> Maybe Text
atTime :: Prelude.Maybe Prelude.Text,
    -- | The names or Amazon Resource Names (ARNs) of the Systems Manager
    -- documents (SSM documents) that represent the calendar entries for which
    -- you want to get the state.
    GetCalendarState -> [Text]
calendarNames :: [Prelude.Text]
  }
  deriving (GetCalendarState -> GetCalendarState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCalendarState -> GetCalendarState -> Bool
$c/= :: GetCalendarState -> GetCalendarState -> Bool
== :: GetCalendarState -> GetCalendarState -> Bool
$c== :: GetCalendarState -> GetCalendarState -> Bool
Prelude.Eq, ReadPrec [GetCalendarState]
ReadPrec GetCalendarState
Int -> ReadS GetCalendarState
ReadS [GetCalendarState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCalendarState]
$creadListPrec :: ReadPrec [GetCalendarState]
readPrec :: ReadPrec GetCalendarState
$creadPrec :: ReadPrec GetCalendarState
readList :: ReadS [GetCalendarState]
$creadList :: ReadS [GetCalendarState]
readsPrec :: Int -> ReadS GetCalendarState
$creadsPrec :: Int -> ReadS GetCalendarState
Prelude.Read, Int -> GetCalendarState -> ShowS
[GetCalendarState] -> ShowS
GetCalendarState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCalendarState] -> ShowS
$cshowList :: [GetCalendarState] -> ShowS
show :: GetCalendarState -> String
$cshow :: GetCalendarState -> String
showsPrec :: Int -> GetCalendarState -> ShowS
$cshowsPrec :: Int -> GetCalendarState -> ShowS
Prelude.Show, forall x. Rep GetCalendarState x -> GetCalendarState
forall x. GetCalendarState -> Rep GetCalendarState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCalendarState x -> GetCalendarState
$cfrom :: forall x. GetCalendarState -> Rep GetCalendarState x
Prelude.Generic)

-- |
-- Create a value of 'GetCalendarState' 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:
--
-- 'atTime', 'getCalendarState_atTime' - (Optional) The specific time for which you want to get calendar state
-- information, in <https://en.wikipedia.org/wiki/ISO_8601 ISO 8601>
-- format. If you don\'t specify a value or @AtTime@, the current time is
-- used.
--
-- 'calendarNames', 'getCalendarState_calendarNames' - The names or Amazon Resource Names (ARNs) of the Systems Manager
-- documents (SSM documents) that represent the calendar entries for which
-- you want to get the state.
newGetCalendarState ::
  GetCalendarState
newGetCalendarState :: GetCalendarState
newGetCalendarState =
  GetCalendarState'
    { $sel:atTime:GetCalendarState' :: Maybe Text
atTime = forall a. Maybe a
Prelude.Nothing,
      $sel:calendarNames:GetCalendarState' :: [Text]
calendarNames = forall a. Monoid a => a
Prelude.mempty
    }

-- | (Optional) The specific time for which you want to get calendar state
-- information, in <https://en.wikipedia.org/wiki/ISO_8601 ISO 8601>
-- format. If you don\'t specify a value or @AtTime@, the current time is
-- used.
getCalendarState_atTime :: Lens.Lens' GetCalendarState (Prelude.Maybe Prelude.Text)
getCalendarState_atTime :: Lens' GetCalendarState (Maybe Text)
getCalendarState_atTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalendarState' {Maybe Text
atTime :: Maybe Text
$sel:atTime:GetCalendarState' :: GetCalendarState -> Maybe Text
atTime} -> Maybe Text
atTime) (\s :: GetCalendarState
s@GetCalendarState' {} Maybe Text
a -> GetCalendarState
s {$sel:atTime:GetCalendarState' :: Maybe Text
atTime = Maybe Text
a} :: GetCalendarState)

-- | The names or Amazon Resource Names (ARNs) of the Systems Manager
-- documents (SSM documents) that represent the calendar entries for which
-- you want to get the state.
getCalendarState_calendarNames :: Lens.Lens' GetCalendarState [Prelude.Text]
getCalendarState_calendarNames :: Lens' GetCalendarState [Text]
getCalendarState_calendarNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalendarState' {[Text]
calendarNames :: [Text]
$sel:calendarNames:GetCalendarState' :: GetCalendarState -> [Text]
calendarNames} -> [Text]
calendarNames) (\s :: GetCalendarState
s@GetCalendarState' {} [Text]
a -> GetCalendarState
s {$sel:calendarNames:GetCalendarState' :: [Text]
calendarNames = [Text]
a} :: GetCalendarState) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest GetCalendarState where
  type
    AWSResponse GetCalendarState =
      GetCalendarStateResponse
  request :: (Service -> Service)
-> GetCalendarState -> Request GetCalendarState
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetCalendarState
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetCalendarState)))
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 Text
-> Maybe CalendarState
-> Int
-> GetCalendarStateResponse
GetCalendarStateResponse'
            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
"AtTime")
            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
"NextTransitionTime")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetCalendarState where
  hashWithSalt :: Int -> GetCalendarState -> Int
hashWithSalt Int
_salt GetCalendarState' {[Text]
Maybe Text
calendarNames :: [Text]
atTime :: Maybe Text
$sel:calendarNames:GetCalendarState' :: GetCalendarState -> [Text]
$sel:atTime:GetCalendarState' :: GetCalendarState -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
atTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
calendarNames

instance Prelude.NFData GetCalendarState where
  rnf :: GetCalendarState -> ()
rnf GetCalendarState' {[Text]
Maybe Text
calendarNames :: [Text]
atTime :: Maybe Text
$sel:calendarNames:GetCalendarState' :: GetCalendarState -> [Text]
$sel:atTime:GetCalendarState' :: GetCalendarState -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
atTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
calendarNames

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

instance Data.ToJSON GetCalendarState where
  toJSON :: GetCalendarState -> Value
toJSON GetCalendarState' {[Text]
Maybe Text
calendarNames :: [Text]
atTime :: Maybe Text
$sel:calendarNames:GetCalendarState' :: GetCalendarState -> [Text]
$sel:atTime:GetCalendarState' :: GetCalendarState -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AtTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
atTime,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"CalendarNames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
calendarNames)
          ]
      )

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

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

-- | /See:/ 'newGetCalendarStateResponse' smart constructor.
data GetCalendarStateResponse = GetCalendarStateResponse'
  { -- | The time, as an <https://en.wikipedia.org/wiki/ISO_8601 ISO 8601>
    -- string, that you specified in your command. If you don\'t specify a
    -- time, @GetCalendarState@ uses the current time.
    GetCalendarStateResponse -> Maybe Text
atTime :: Prelude.Maybe Prelude.Text,
    -- | The time, as an <https://en.wikipedia.org/wiki/ISO_8601 ISO 8601>
    -- string, that the calendar state will change. If the current calendar
    -- state is @OPEN@, @NextTransitionTime@ indicates when the calendar state
    -- changes to @CLOSED@, and vice-versa.
    GetCalendarStateResponse -> Maybe Text
nextTransitionTime :: Prelude.Maybe Prelude.Text,
    -- | The state of the calendar. An @OPEN@ calendar indicates that actions are
    -- allowed to proceed, and a @CLOSED@ calendar indicates that actions
    -- aren\'t allowed to proceed.
    GetCalendarStateResponse -> Maybe CalendarState
state :: Prelude.Maybe CalendarState,
    -- | The response's http status code.
    GetCalendarStateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCalendarStateResponse -> GetCalendarStateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCalendarStateResponse -> GetCalendarStateResponse -> Bool
$c/= :: GetCalendarStateResponse -> GetCalendarStateResponse -> Bool
== :: GetCalendarStateResponse -> GetCalendarStateResponse -> Bool
$c== :: GetCalendarStateResponse -> GetCalendarStateResponse -> Bool
Prelude.Eq, ReadPrec [GetCalendarStateResponse]
ReadPrec GetCalendarStateResponse
Int -> ReadS GetCalendarStateResponse
ReadS [GetCalendarStateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCalendarStateResponse]
$creadListPrec :: ReadPrec [GetCalendarStateResponse]
readPrec :: ReadPrec GetCalendarStateResponse
$creadPrec :: ReadPrec GetCalendarStateResponse
readList :: ReadS [GetCalendarStateResponse]
$creadList :: ReadS [GetCalendarStateResponse]
readsPrec :: Int -> ReadS GetCalendarStateResponse
$creadsPrec :: Int -> ReadS GetCalendarStateResponse
Prelude.Read, Int -> GetCalendarStateResponse -> ShowS
[GetCalendarStateResponse] -> ShowS
GetCalendarStateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCalendarStateResponse] -> ShowS
$cshowList :: [GetCalendarStateResponse] -> ShowS
show :: GetCalendarStateResponse -> String
$cshow :: GetCalendarStateResponse -> String
showsPrec :: Int -> GetCalendarStateResponse -> ShowS
$cshowsPrec :: Int -> GetCalendarStateResponse -> ShowS
Prelude.Show, forall x.
Rep GetCalendarStateResponse x -> GetCalendarStateResponse
forall x.
GetCalendarStateResponse -> Rep GetCalendarStateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCalendarStateResponse x -> GetCalendarStateResponse
$cfrom :: forall x.
GetCalendarStateResponse -> Rep GetCalendarStateResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCalendarStateResponse' 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:
--
-- 'atTime', 'getCalendarStateResponse_atTime' - The time, as an <https://en.wikipedia.org/wiki/ISO_8601 ISO 8601>
-- string, that you specified in your command. If you don\'t specify a
-- time, @GetCalendarState@ uses the current time.
--
-- 'nextTransitionTime', 'getCalendarStateResponse_nextTransitionTime' - The time, as an <https://en.wikipedia.org/wiki/ISO_8601 ISO 8601>
-- string, that the calendar state will change. If the current calendar
-- state is @OPEN@, @NextTransitionTime@ indicates when the calendar state
-- changes to @CLOSED@, and vice-versa.
--
-- 'state', 'getCalendarStateResponse_state' - The state of the calendar. An @OPEN@ calendar indicates that actions are
-- allowed to proceed, and a @CLOSED@ calendar indicates that actions
-- aren\'t allowed to proceed.
--
-- 'httpStatus', 'getCalendarStateResponse_httpStatus' - The response's http status code.
newGetCalendarStateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCalendarStateResponse
newGetCalendarStateResponse :: Int -> GetCalendarStateResponse
newGetCalendarStateResponse Int
pHttpStatus_ =
  GetCalendarStateResponse'
    { $sel:atTime:GetCalendarStateResponse' :: Maybe Text
atTime = forall a. Maybe a
Prelude.Nothing,
      $sel:nextTransitionTime:GetCalendarStateResponse' :: Maybe Text
nextTransitionTime = forall a. Maybe a
Prelude.Nothing,
      $sel:state:GetCalendarStateResponse' :: Maybe CalendarState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCalendarStateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The time, as an <https://en.wikipedia.org/wiki/ISO_8601 ISO 8601>
-- string, that you specified in your command. If you don\'t specify a
-- time, @GetCalendarState@ uses the current time.
getCalendarStateResponse_atTime :: Lens.Lens' GetCalendarStateResponse (Prelude.Maybe Prelude.Text)
getCalendarStateResponse_atTime :: Lens' GetCalendarStateResponse (Maybe Text)
getCalendarStateResponse_atTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalendarStateResponse' {Maybe Text
atTime :: Maybe Text
$sel:atTime:GetCalendarStateResponse' :: GetCalendarStateResponse -> Maybe Text
atTime} -> Maybe Text
atTime) (\s :: GetCalendarStateResponse
s@GetCalendarStateResponse' {} Maybe Text
a -> GetCalendarStateResponse
s {$sel:atTime:GetCalendarStateResponse' :: Maybe Text
atTime = Maybe Text
a} :: GetCalendarStateResponse)

-- | The time, as an <https://en.wikipedia.org/wiki/ISO_8601 ISO 8601>
-- string, that the calendar state will change. If the current calendar
-- state is @OPEN@, @NextTransitionTime@ indicates when the calendar state
-- changes to @CLOSED@, and vice-versa.
getCalendarStateResponse_nextTransitionTime :: Lens.Lens' GetCalendarStateResponse (Prelude.Maybe Prelude.Text)
getCalendarStateResponse_nextTransitionTime :: Lens' GetCalendarStateResponse (Maybe Text)
getCalendarStateResponse_nextTransitionTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalendarStateResponse' {Maybe Text
nextTransitionTime :: Maybe Text
$sel:nextTransitionTime:GetCalendarStateResponse' :: GetCalendarStateResponse -> Maybe Text
nextTransitionTime} -> Maybe Text
nextTransitionTime) (\s :: GetCalendarStateResponse
s@GetCalendarStateResponse' {} Maybe Text
a -> GetCalendarStateResponse
s {$sel:nextTransitionTime:GetCalendarStateResponse' :: Maybe Text
nextTransitionTime = Maybe Text
a} :: GetCalendarStateResponse)

-- | The state of the calendar. An @OPEN@ calendar indicates that actions are
-- allowed to proceed, and a @CLOSED@ calendar indicates that actions
-- aren\'t allowed to proceed.
getCalendarStateResponse_state :: Lens.Lens' GetCalendarStateResponse (Prelude.Maybe CalendarState)
getCalendarStateResponse_state :: Lens' GetCalendarStateResponse (Maybe CalendarState)
getCalendarStateResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalendarStateResponse' {Maybe CalendarState
state :: Maybe CalendarState
$sel:state:GetCalendarStateResponse' :: GetCalendarStateResponse -> Maybe CalendarState
state} -> Maybe CalendarState
state) (\s :: GetCalendarStateResponse
s@GetCalendarStateResponse' {} Maybe CalendarState
a -> GetCalendarStateResponse
s {$sel:state:GetCalendarStateResponse' :: Maybe CalendarState
state = Maybe CalendarState
a} :: GetCalendarStateResponse)

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

instance Prelude.NFData GetCalendarStateResponse where
  rnf :: GetCalendarStateResponse -> ()
rnf GetCalendarStateResponse' {Int
Maybe Text
Maybe CalendarState
httpStatus :: Int
state :: Maybe CalendarState
nextTransitionTime :: Maybe Text
atTime :: Maybe Text
$sel:httpStatus:GetCalendarStateResponse' :: GetCalendarStateResponse -> Int
$sel:state:GetCalendarStateResponse' :: GetCalendarStateResponse -> Maybe CalendarState
$sel:nextTransitionTime:GetCalendarStateResponse' :: GetCalendarStateResponse -> Maybe Text
$sel:atTime:GetCalendarStateResponse' :: GetCalendarStateResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
atTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextTransitionTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CalendarState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus