{-# 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.AssociateInstanceEventWindow
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates one or more targets with an event window. Only one type of
-- target (instance IDs, Dedicated Host IDs, or tags) can be specified with
-- an event window.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/event-windows.html Define event windows for scheduled events>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2.AssociateInstanceEventWindow
  ( -- * Creating a Request
    AssociateInstanceEventWindow (..),
    newAssociateInstanceEventWindow,

    -- * Request Lenses
    associateInstanceEventWindow_dryRun,
    associateInstanceEventWindow_instanceEventWindowId,
    associateInstanceEventWindow_associationTarget,

    -- * Destructuring the Response
    AssociateInstanceEventWindowResponse (..),
    newAssociateInstanceEventWindowResponse,

    -- * Response Lenses
    associateInstanceEventWindowResponse_instanceEventWindow,
    associateInstanceEventWindowResponse_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:/ 'newAssociateInstanceEventWindow' smart constructor.
data AssociateInstanceEventWindow = AssociateInstanceEventWindow'
  { -- | 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@.
    AssociateInstanceEventWindow -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the event window.
    AssociateInstanceEventWindow -> Text
instanceEventWindowId :: Prelude.Text,
    -- | One or more targets associated with the specified event window.
    AssociateInstanceEventWindow
-> InstanceEventWindowAssociationRequest
associationTarget :: InstanceEventWindowAssociationRequest
  }
  deriving (AssociateInstanceEventWindow
-> AssociateInstanceEventWindow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateInstanceEventWindow
-> AssociateInstanceEventWindow -> Bool
$c/= :: AssociateInstanceEventWindow
-> AssociateInstanceEventWindow -> Bool
== :: AssociateInstanceEventWindow
-> AssociateInstanceEventWindow -> Bool
$c== :: AssociateInstanceEventWindow
-> AssociateInstanceEventWindow -> Bool
Prelude.Eq, ReadPrec [AssociateInstanceEventWindow]
ReadPrec AssociateInstanceEventWindow
Int -> ReadS AssociateInstanceEventWindow
ReadS [AssociateInstanceEventWindow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateInstanceEventWindow]
$creadListPrec :: ReadPrec [AssociateInstanceEventWindow]
readPrec :: ReadPrec AssociateInstanceEventWindow
$creadPrec :: ReadPrec AssociateInstanceEventWindow
readList :: ReadS [AssociateInstanceEventWindow]
$creadList :: ReadS [AssociateInstanceEventWindow]
readsPrec :: Int -> ReadS AssociateInstanceEventWindow
$creadsPrec :: Int -> ReadS AssociateInstanceEventWindow
Prelude.Read, Int -> AssociateInstanceEventWindow -> ShowS
[AssociateInstanceEventWindow] -> ShowS
AssociateInstanceEventWindow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateInstanceEventWindow] -> ShowS
$cshowList :: [AssociateInstanceEventWindow] -> ShowS
show :: AssociateInstanceEventWindow -> String
$cshow :: AssociateInstanceEventWindow -> String
showsPrec :: Int -> AssociateInstanceEventWindow -> ShowS
$cshowsPrec :: Int -> AssociateInstanceEventWindow -> ShowS
Prelude.Show, forall x.
Rep AssociateInstanceEventWindow x -> AssociateInstanceEventWindow
forall x.
AssociateInstanceEventWindow -> Rep AssociateInstanceEventWindow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateInstanceEventWindow x -> AssociateInstanceEventWindow
$cfrom :: forall x.
AssociateInstanceEventWindow -> Rep AssociateInstanceEventWindow x
Prelude.Generic)

-- |
-- Create a value of 'AssociateInstanceEventWindow' 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', 'associateInstanceEventWindow_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@.
--
-- 'instanceEventWindowId', 'associateInstanceEventWindow_instanceEventWindowId' - The ID of the event window.
--
-- 'associationTarget', 'associateInstanceEventWindow_associationTarget' - One or more targets associated with the specified event window.
newAssociateInstanceEventWindow ::
  -- | 'instanceEventWindowId'
  Prelude.Text ->
  -- | 'associationTarget'
  InstanceEventWindowAssociationRequest ->
  AssociateInstanceEventWindow
newAssociateInstanceEventWindow :: Text
-> InstanceEventWindowAssociationRequest
-> AssociateInstanceEventWindow
newAssociateInstanceEventWindow
  Text
pInstanceEventWindowId_
  InstanceEventWindowAssociationRequest
pAssociationTarget_ =
    AssociateInstanceEventWindow'
      { $sel:dryRun:AssociateInstanceEventWindow' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:instanceEventWindowId:AssociateInstanceEventWindow' :: Text
instanceEventWindowId =
          Text
pInstanceEventWindowId_,
        $sel:associationTarget:AssociateInstanceEventWindow' :: InstanceEventWindowAssociationRequest
associationTarget = InstanceEventWindowAssociationRequest
pAssociationTarget_
      }

-- | 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@.
associateInstanceEventWindow_dryRun :: Lens.Lens' AssociateInstanceEventWindow (Prelude.Maybe Prelude.Bool)
associateInstanceEventWindow_dryRun :: Lens' AssociateInstanceEventWindow (Maybe Bool)
associateInstanceEventWindow_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateInstanceEventWindow' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:AssociateInstanceEventWindow' :: AssociateInstanceEventWindow -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: AssociateInstanceEventWindow
s@AssociateInstanceEventWindow' {} Maybe Bool
a -> AssociateInstanceEventWindow
s {$sel:dryRun:AssociateInstanceEventWindow' :: Maybe Bool
dryRun = Maybe Bool
a} :: AssociateInstanceEventWindow)

-- | The ID of the event window.
associateInstanceEventWindow_instanceEventWindowId :: Lens.Lens' AssociateInstanceEventWindow Prelude.Text
associateInstanceEventWindow_instanceEventWindowId :: Lens' AssociateInstanceEventWindow Text
associateInstanceEventWindow_instanceEventWindowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateInstanceEventWindow' {Text
instanceEventWindowId :: Text
$sel:instanceEventWindowId:AssociateInstanceEventWindow' :: AssociateInstanceEventWindow -> Text
instanceEventWindowId} -> Text
instanceEventWindowId) (\s :: AssociateInstanceEventWindow
s@AssociateInstanceEventWindow' {} Text
a -> AssociateInstanceEventWindow
s {$sel:instanceEventWindowId:AssociateInstanceEventWindow' :: Text
instanceEventWindowId = Text
a} :: AssociateInstanceEventWindow)

-- | One or more targets associated with the specified event window.
associateInstanceEventWindow_associationTarget :: Lens.Lens' AssociateInstanceEventWindow InstanceEventWindowAssociationRequest
associateInstanceEventWindow_associationTarget :: Lens'
  AssociateInstanceEventWindow InstanceEventWindowAssociationRequest
associateInstanceEventWindow_associationTarget = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateInstanceEventWindow' {InstanceEventWindowAssociationRequest
associationTarget :: InstanceEventWindowAssociationRequest
$sel:associationTarget:AssociateInstanceEventWindow' :: AssociateInstanceEventWindow
-> InstanceEventWindowAssociationRequest
associationTarget} -> InstanceEventWindowAssociationRequest
associationTarget) (\s :: AssociateInstanceEventWindow
s@AssociateInstanceEventWindow' {} InstanceEventWindowAssociationRequest
a -> AssociateInstanceEventWindow
s {$sel:associationTarget:AssociateInstanceEventWindow' :: InstanceEventWindowAssociationRequest
associationTarget = InstanceEventWindowAssociationRequest
a} :: AssociateInstanceEventWindow)

instance Core.AWSRequest AssociateInstanceEventWindow where
  type
    AWSResponse AssociateInstanceEventWindow =
      AssociateInstanceEventWindowResponse
  request :: (Service -> Service)
-> AssociateInstanceEventWindow
-> Request AssociateInstanceEventWindow
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 AssociateInstanceEventWindow
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AssociateInstanceEventWindow)))
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 InstanceEventWindow
-> Int -> AssociateInstanceEventWindowResponse
AssociateInstanceEventWindowResponse'
            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
"instanceEventWindow")
            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
    AssociateInstanceEventWindow
  where
  hashWithSalt :: Int -> AssociateInstanceEventWindow -> Int
hashWithSalt Int
_salt AssociateInstanceEventWindow' {Maybe Bool
Text
InstanceEventWindowAssociationRequest
associationTarget :: InstanceEventWindowAssociationRequest
instanceEventWindowId :: Text
dryRun :: Maybe Bool
$sel:associationTarget:AssociateInstanceEventWindow' :: AssociateInstanceEventWindow
-> InstanceEventWindowAssociationRequest
$sel:instanceEventWindowId:AssociateInstanceEventWindow' :: AssociateInstanceEventWindow -> Text
$sel:dryRun:AssociateInstanceEventWindow' :: AssociateInstanceEventWindow -> 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
instanceEventWindowId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` InstanceEventWindowAssociationRequest
associationTarget

instance Prelude.NFData AssociateInstanceEventWindow where
  rnf :: AssociateInstanceEventWindow -> ()
rnf AssociateInstanceEventWindow' {Maybe Bool
Text
InstanceEventWindowAssociationRequest
associationTarget :: InstanceEventWindowAssociationRequest
instanceEventWindowId :: Text
dryRun :: Maybe Bool
$sel:associationTarget:AssociateInstanceEventWindow' :: AssociateInstanceEventWindow
-> InstanceEventWindowAssociationRequest
$sel:instanceEventWindowId:AssociateInstanceEventWindow' :: AssociateInstanceEventWindow -> Text
$sel:dryRun:AssociateInstanceEventWindow' :: AssociateInstanceEventWindow -> 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
instanceEventWindowId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf InstanceEventWindowAssociationRequest
associationTarget

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

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

instance Data.ToQuery AssociateInstanceEventWindow where
  toQuery :: AssociateInstanceEventWindow -> QueryString
toQuery AssociateInstanceEventWindow' {Maybe Bool
Text
InstanceEventWindowAssociationRequest
associationTarget :: InstanceEventWindowAssociationRequest
instanceEventWindowId :: Text
dryRun :: Maybe Bool
$sel:associationTarget:AssociateInstanceEventWindow' :: AssociateInstanceEventWindow
-> InstanceEventWindowAssociationRequest
$sel:instanceEventWindowId:AssociateInstanceEventWindow' :: AssociateInstanceEventWindow -> Text
$sel:dryRun:AssociateInstanceEventWindow' :: AssociateInstanceEventWindow -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"AssociateInstanceEventWindow" ::
                      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
"InstanceEventWindowId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
instanceEventWindowId,
        ByteString
"AssociationTarget" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: InstanceEventWindowAssociationRequest
associationTarget
      ]

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

-- |
-- Create a value of 'AssociateInstanceEventWindowResponse' 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:
--
-- 'instanceEventWindow', 'associateInstanceEventWindowResponse_instanceEventWindow' - Information about the event window.
--
-- 'httpStatus', 'associateInstanceEventWindowResponse_httpStatus' - The response's http status code.
newAssociateInstanceEventWindowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateInstanceEventWindowResponse
newAssociateInstanceEventWindowResponse :: Int -> AssociateInstanceEventWindowResponse
newAssociateInstanceEventWindowResponse Int
pHttpStatus_ =
  AssociateInstanceEventWindowResponse'
    { $sel:instanceEventWindow:AssociateInstanceEventWindowResponse' :: Maybe InstanceEventWindow
instanceEventWindow =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AssociateInstanceEventWindowResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the event window.
associateInstanceEventWindowResponse_instanceEventWindow :: Lens.Lens' AssociateInstanceEventWindowResponse (Prelude.Maybe InstanceEventWindow)
associateInstanceEventWindowResponse_instanceEventWindow :: Lens'
  AssociateInstanceEventWindowResponse (Maybe InstanceEventWindow)
associateInstanceEventWindowResponse_instanceEventWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateInstanceEventWindowResponse' {Maybe InstanceEventWindow
instanceEventWindow :: Maybe InstanceEventWindow
$sel:instanceEventWindow:AssociateInstanceEventWindowResponse' :: AssociateInstanceEventWindowResponse -> Maybe InstanceEventWindow
instanceEventWindow} -> Maybe InstanceEventWindow
instanceEventWindow) (\s :: AssociateInstanceEventWindowResponse
s@AssociateInstanceEventWindowResponse' {} Maybe InstanceEventWindow
a -> AssociateInstanceEventWindowResponse
s {$sel:instanceEventWindow:AssociateInstanceEventWindowResponse' :: Maybe InstanceEventWindow
instanceEventWindow = Maybe InstanceEventWindow
a} :: AssociateInstanceEventWindowResponse)

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

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