{-# 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.EC2.ModifyInstanceEventStartTime
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the start time for a scheduled Amazon EC2 instance event.
module Amazonka.EC2.ModifyInstanceEventStartTime
  ( -- * Creating a Request
    ModifyInstanceEventStartTime (..),
    newModifyInstanceEventStartTime,

    -- * Request Lenses
    modifyInstanceEventStartTime_dryRun,
    modifyInstanceEventStartTime_instanceId,
    modifyInstanceEventStartTime_instanceEventId,
    modifyInstanceEventStartTime_notBefore,

    -- * Destructuring the Response
    ModifyInstanceEventStartTimeResponse (..),
    newModifyInstanceEventStartTimeResponse,

    -- * Response Lenses
    modifyInstanceEventStartTimeResponse_event,
    modifyInstanceEventStartTimeResponse_httpStatus,
  )
where

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

-- | /See:/ 'newModifyInstanceEventStartTime' smart constructor.
data ModifyInstanceEventStartTime = ModifyInstanceEventStartTime'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    ModifyInstanceEventStartTime -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the instance with the scheduled event.
    ModifyInstanceEventStartTime -> Text
instanceId :: Prelude.Text,
    -- | The ID of the event whose date and time you are modifying.
    ModifyInstanceEventStartTime -> Text
instanceEventId :: Prelude.Text,
    -- | The new date and time when the event will take place.
    ModifyInstanceEventStartTime -> ISO8601
notBefore :: Data.ISO8601
  }
  deriving (ModifyInstanceEventStartTime
-> ModifyInstanceEventStartTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyInstanceEventStartTime
-> ModifyInstanceEventStartTime -> Bool
$c/= :: ModifyInstanceEventStartTime
-> ModifyInstanceEventStartTime -> Bool
== :: ModifyInstanceEventStartTime
-> ModifyInstanceEventStartTime -> Bool
$c== :: ModifyInstanceEventStartTime
-> ModifyInstanceEventStartTime -> Bool
Prelude.Eq, ReadPrec [ModifyInstanceEventStartTime]
ReadPrec ModifyInstanceEventStartTime
Int -> ReadS ModifyInstanceEventStartTime
ReadS [ModifyInstanceEventStartTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyInstanceEventStartTime]
$creadListPrec :: ReadPrec [ModifyInstanceEventStartTime]
readPrec :: ReadPrec ModifyInstanceEventStartTime
$creadPrec :: ReadPrec ModifyInstanceEventStartTime
readList :: ReadS [ModifyInstanceEventStartTime]
$creadList :: ReadS [ModifyInstanceEventStartTime]
readsPrec :: Int -> ReadS ModifyInstanceEventStartTime
$creadsPrec :: Int -> ReadS ModifyInstanceEventStartTime
Prelude.Read, Int -> ModifyInstanceEventStartTime -> ShowS
[ModifyInstanceEventStartTime] -> ShowS
ModifyInstanceEventStartTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyInstanceEventStartTime] -> ShowS
$cshowList :: [ModifyInstanceEventStartTime] -> ShowS
show :: ModifyInstanceEventStartTime -> String
$cshow :: ModifyInstanceEventStartTime -> String
showsPrec :: Int -> ModifyInstanceEventStartTime -> ShowS
$cshowsPrec :: Int -> ModifyInstanceEventStartTime -> ShowS
Prelude.Show, forall x.
Rep ModifyInstanceEventStartTime x -> ModifyInstanceEventStartTime
forall x.
ModifyInstanceEventStartTime -> Rep ModifyInstanceEventStartTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyInstanceEventStartTime x -> ModifyInstanceEventStartTime
$cfrom :: forall x.
ModifyInstanceEventStartTime -> Rep ModifyInstanceEventStartTime x
Prelude.Generic)

-- |
-- Create a value of 'ModifyInstanceEventStartTime' 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:
--
-- 'dryRun', 'modifyInstanceEventStartTime_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'instanceId', 'modifyInstanceEventStartTime_instanceId' - The ID of the instance with the scheduled event.
--
-- 'instanceEventId', 'modifyInstanceEventStartTime_instanceEventId' - The ID of the event whose date and time you are modifying.
--
-- 'notBefore', 'modifyInstanceEventStartTime_notBefore' - The new date and time when the event will take place.
newModifyInstanceEventStartTime ::
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'instanceEventId'
  Prelude.Text ->
  -- | 'notBefore'
  Prelude.UTCTime ->
  ModifyInstanceEventStartTime
newModifyInstanceEventStartTime :: Text -> Text -> UTCTime -> ModifyInstanceEventStartTime
newModifyInstanceEventStartTime
  Text
pInstanceId_
  Text
pInstanceEventId_
  UTCTime
pNotBefore_ =
    ModifyInstanceEventStartTime'
      { $sel:dryRun:ModifyInstanceEventStartTime' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:instanceId:ModifyInstanceEventStartTime' :: Text
instanceId = Text
pInstanceId_,
        $sel:instanceEventId:ModifyInstanceEventStartTime' :: Text
instanceEventId = Text
pInstanceEventId_,
        $sel:notBefore:ModifyInstanceEventStartTime' :: ISO8601
notBefore = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pNotBefore_
      }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
modifyInstanceEventStartTime_dryRun :: Lens.Lens' ModifyInstanceEventStartTime (Prelude.Maybe Prelude.Bool)
modifyInstanceEventStartTime_dryRun :: Lens' ModifyInstanceEventStartTime (Maybe Bool)
modifyInstanceEventStartTime_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceEventStartTime' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ModifyInstanceEventStartTime
s@ModifyInstanceEventStartTime' {} Maybe Bool
a -> ModifyInstanceEventStartTime
s {$sel:dryRun:ModifyInstanceEventStartTime' :: Maybe Bool
dryRun = Maybe Bool
a} :: ModifyInstanceEventStartTime)

-- | The ID of the instance with the scheduled event.
modifyInstanceEventStartTime_instanceId :: Lens.Lens' ModifyInstanceEventStartTime Prelude.Text
modifyInstanceEventStartTime_instanceId :: Lens' ModifyInstanceEventStartTime Text
modifyInstanceEventStartTime_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceEventStartTime' {Text
instanceId :: Text
$sel:instanceId:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> Text
instanceId} -> Text
instanceId) (\s :: ModifyInstanceEventStartTime
s@ModifyInstanceEventStartTime' {} Text
a -> ModifyInstanceEventStartTime
s {$sel:instanceId:ModifyInstanceEventStartTime' :: Text
instanceId = Text
a} :: ModifyInstanceEventStartTime)

-- | The ID of the event whose date and time you are modifying.
modifyInstanceEventStartTime_instanceEventId :: Lens.Lens' ModifyInstanceEventStartTime Prelude.Text
modifyInstanceEventStartTime_instanceEventId :: Lens' ModifyInstanceEventStartTime Text
modifyInstanceEventStartTime_instanceEventId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceEventStartTime' {Text
instanceEventId :: Text
$sel:instanceEventId:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> Text
instanceEventId} -> Text
instanceEventId) (\s :: ModifyInstanceEventStartTime
s@ModifyInstanceEventStartTime' {} Text
a -> ModifyInstanceEventStartTime
s {$sel:instanceEventId:ModifyInstanceEventStartTime' :: Text
instanceEventId = Text
a} :: ModifyInstanceEventStartTime)

-- | The new date and time when the event will take place.
modifyInstanceEventStartTime_notBefore :: Lens.Lens' ModifyInstanceEventStartTime Prelude.UTCTime
modifyInstanceEventStartTime_notBefore :: Lens' ModifyInstanceEventStartTime UTCTime
modifyInstanceEventStartTime_notBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceEventStartTime' {ISO8601
notBefore :: ISO8601
$sel:notBefore:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> ISO8601
notBefore} -> ISO8601
notBefore) (\s :: ModifyInstanceEventStartTime
s@ModifyInstanceEventStartTime' {} ISO8601
a -> ModifyInstanceEventStartTime
s {$sel:notBefore:ModifyInstanceEventStartTime' :: ISO8601
notBefore = ISO8601
a} :: ModifyInstanceEventStartTime) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Core.AWSRequest ModifyInstanceEventStartTime where
  type
    AWSResponse ModifyInstanceEventStartTime =
      ModifyInstanceEventStartTimeResponse
  request :: (Service -> Service)
-> ModifyInstanceEventStartTime
-> Request ModifyInstanceEventStartTime
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 ModifyInstanceEventStartTime
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyInstanceEventStartTime)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe InstanceStatusEvent
-> Int -> ModifyInstanceEventStartTimeResponse
ModifyInstanceEventStartTimeResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"event")
            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
    ModifyInstanceEventStartTime
  where
  hashWithSalt :: Int -> ModifyInstanceEventStartTime -> Int
hashWithSalt Int
_salt ModifyInstanceEventStartTime' {Maybe Bool
Text
ISO8601
notBefore :: ISO8601
instanceEventId :: Text
instanceId :: Text
dryRun :: Maybe Bool
$sel:notBefore:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> ISO8601
$sel:instanceEventId:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> Text
$sel:instanceId:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> Text
$sel:dryRun:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceEventId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
notBefore

instance Prelude.NFData ModifyInstanceEventStartTime where
  rnf :: ModifyInstanceEventStartTime -> ()
rnf ModifyInstanceEventStartTime' {Maybe Bool
Text
ISO8601
notBefore :: ISO8601
instanceEventId :: Text
instanceId :: Text
dryRun :: Maybe Bool
$sel:notBefore:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> ISO8601
$sel:instanceEventId:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> Text
$sel:instanceId:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> Text
$sel:dryRun:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceEventId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
notBefore

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

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

instance Data.ToQuery ModifyInstanceEventStartTime where
  toQuery :: ModifyInstanceEventStartTime -> QueryString
toQuery ModifyInstanceEventStartTime' {Maybe Bool
Text
ISO8601
notBefore :: ISO8601
instanceEventId :: Text
instanceId :: Text
dryRun :: Maybe Bool
$sel:notBefore:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> ISO8601
$sel:instanceEventId:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> Text
$sel:instanceId:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> Text
$sel:dryRun:ModifyInstanceEventStartTime' :: ModifyInstanceEventStartTime -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ModifyInstanceEventStartTime" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"InstanceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
instanceId,
        ByteString
"InstanceEventId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
instanceEventId,
        ByteString
"NotBefore" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ISO8601
notBefore
      ]

-- | /See:/ 'newModifyInstanceEventStartTimeResponse' smart constructor.
data ModifyInstanceEventStartTimeResponse = ModifyInstanceEventStartTimeResponse'
  { -- | Information about the event.
    ModifyInstanceEventStartTimeResponse -> Maybe InstanceStatusEvent
event :: Prelude.Maybe InstanceStatusEvent,
    -- | The response's http status code.
    ModifyInstanceEventStartTimeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifyInstanceEventStartTimeResponse
-> ModifyInstanceEventStartTimeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyInstanceEventStartTimeResponse
-> ModifyInstanceEventStartTimeResponse -> Bool
$c/= :: ModifyInstanceEventStartTimeResponse
-> ModifyInstanceEventStartTimeResponse -> Bool
== :: ModifyInstanceEventStartTimeResponse
-> ModifyInstanceEventStartTimeResponse -> Bool
$c== :: ModifyInstanceEventStartTimeResponse
-> ModifyInstanceEventStartTimeResponse -> Bool
Prelude.Eq, ReadPrec [ModifyInstanceEventStartTimeResponse]
ReadPrec ModifyInstanceEventStartTimeResponse
Int -> ReadS ModifyInstanceEventStartTimeResponse
ReadS [ModifyInstanceEventStartTimeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyInstanceEventStartTimeResponse]
$creadListPrec :: ReadPrec [ModifyInstanceEventStartTimeResponse]
readPrec :: ReadPrec ModifyInstanceEventStartTimeResponse
$creadPrec :: ReadPrec ModifyInstanceEventStartTimeResponse
readList :: ReadS [ModifyInstanceEventStartTimeResponse]
$creadList :: ReadS [ModifyInstanceEventStartTimeResponse]
readsPrec :: Int -> ReadS ModifyInstanceEventStartTimeResponse
$creadsPrec :: Int -> ReadS ModifyInstanceEventStartTimeResponse
Prelude.Read, Int -> ModifyInstanceEventStartTimeResponse -> ShowS
[ModifyInstanceEventStartTimeResponse] -> ShowS
ModifyInstanceEventStartTimeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyInstanceEventStartTimeResponse] -> ShowS
$cshowList :: [ModifyInstanceEventStartTimeResponse] -> ShowS
show :: ModifyInstanceEventStartTimeResponse -> String
$cshow :: ModifyInstanceEventStartTimeResponse -> String
showsPrec :: Int -> ModifyInstanceEventStartTimeResponse -> ShowS
$cshowsPrec :: Int -> ModifyInstanceEventStartTimeResponse -> ShowS
Prelude.Show, forall x.
Rep ModifyInstanceEventStartTimeResponse x
-> ModifyInstanceEventStartTimeResponse
forall x.
ModifyInstanceEventStartTimeResponse
-> Rep ModifyInstanceEventStartTimeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyInstanceEventStartTimeResponse x
-> ModifyInstanceEventStartTimeResponse
$cfrom :: forall x.
ModifyInstanceEventStartTimeResponse
-> Rep ModifyInstanceEventStartTimeResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyInstanceEventStartTimeResponse' 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:
--
-- 'event', 'modifyInstanceEventStartTimeResponse_event' - Information about the event.
--
-- 'httpStatus', 'modifyInstanceEventStartTimeResponse_httpStatus' - The response's http status code.
newModifyInstanceEventStartTimeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyInstanceEventStartTimeResponse
newModifyInstanceEventStartTimeResponse :: Int -> ModifyInstanceEventStartTimeResponse
newModifyInstanceEventStartTimeResponse Int
pHttpStatus_ =
  ModifyInstanceEventStartTimeResponse'
    { $sel:event:ModifyInstanceEventStartTimeResponse' :: Maybe InstanceStatusEvent
event =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyInstanceEventStartTimeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the event.
modifyInstanceEventStartTimeResponse_event :: Lens.Lens' ModifyInstanceEventStartTimeResponse (Prelude.Maybe InstanceStatusEvent)
modifyInstanceEventStartTimeResponse_event :: Lens'
  ModifyInstanceEventStartTimeResponse (Maybe InstanceStatusEvent)
modifyInstanceEventStartTimeResponse_event = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceEventStartTimeResponse' {Maybe InstanceStatusEvent
event :: Maybe InstanceStatusEvent
$sel:event:ModifyInstanceEventStartTimeResponse' :: ModifyInstanceEventStartTimeResponse -> Maybe InstanceStatusEvent
event} -> Maybe InstanceStatusEvent
event) (\s :: ModifyInstanceEventStartTimeResponse
s@ModifyInstanceEventStartTimeResponse' {} Maybe InstanceStatusEvent
a -> ModifyInstanceEventStartTimeResponse
s {$sel:event:ModifyInstanceEventStartTimeResponse' :: Maybe InstanceStatusEvent
event = Maybe InstanceStatusEvent
a} :: ModifyInstanceEventStartTimeResponse)

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

instance
  Prelude.NFData
    ModifyInstanceEventStartTimeResponse
  where
  rnf :: ModifyInstanceEventStartTimeResponse -> ()
rnf ModifyInstanceEventStartTimeResponse' {Int
Maybe InstanceStatusEvent
httpStatus :: Int
event :: Maybe InstanceStatusEvent
$sel:httpStatus:ModifyInstanceEventStartTimeResponse' :: ModifyInstanceEventStartTimeResponse -> Int
$sel:event:ModifyInstanceEventStartTimeResponse' :: ModifyInstanceEventStartTimeResponse -> Maybe InstanceStatusEvent
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceStatusEvent
event
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus