{-# 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.DisassociateInstanceEventWindow
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disassociates one or more targets from 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.DisassociateInstanceEventWindow
  ( -- * Creating a Request
    DisassociateInstanceEventWindow (..),
    newDisassociateInstanceEventWindow,

    -- * Request Lenses
    disassociateInstanceEventWindow_dryRun,
    disassociateInstanceEventWindow_instanceEventWindowId,
    disassociateInstanceEventWindow_associationTarget,

    -- * Destructuring the Response
    DisassociateInstanceEventWindowResponse (..),
    newDisassociateInstanceEventWindowResponse,

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

-- |
-- Create a value of 'DisassociateInstanceEventWindow' 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', 'disassociateInstanceEventWindow_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', 'disassociateInstanceEventWindow_instanceEventWindowId' - The ID of the event window.
--
-- 'associationTarget', 'disassociateInstanceEventWindow_associationTarget' - One or more targets to disassociate from the specified event window.
newDisassociateInstanceEventWindow ::
  -- | 'instanceEventWindowId'
  Prelude.Text ->
  -- | 'associationTarget'
  InstanceEventWindowDisassociationRequest ->
  DisassociateInstanceEventWindow
newDisassociateInstanceEventWindow :: Text
-> InstanceEventWindowDisassociationRequest
-> DisassociateInstanceEventWindow
newDisassociateInstanceEventWindow
  Text
pInstanceEventWindowId_
  InstanceEventWindowDisassociationRequest
pAssociationTarget_ =
    DisassociateInstanceEventWindow'
      { $sel:dryRun:DisassociateInstanceEventWindow' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:instanceEventWindowId:DisassociateInstanceEventWindow' :: Text
instanceEventWindowId =
          Text
pInstanceEventWindowId_,
        $sel:associationTarget:DisassociateInstanceEventWindow' :: InstanceEventWindowDisassociationRequest
associationTarget = InstanceEventWindowDisassociationRequest
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@.
disassociateInstanceEventWindow_dryRun :: Lens.Lens' DisassociateInstanceEventWindow (Prelude.Maybe Prelude.Bool)
disassociateInstanceEventWindow_dryRun :: Lens' DisassociateInstanceEventWindow (Maybe Bool)
disassociateInstanceEventWindow_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateInstanceEventWindow' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DisassociateInstanceEventWindow' :: DisassociateInstanceEventWindow -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DisassociateInstanceEventWindow
s@DisassociateInstanceEventWindow' {} Maybe Bool
a -> DisassociateInstanceEventWindow
s {$sel:dryRun:DisassociateInstanceEventWindow' :: Maybe Bool
dryRun = Maybe Bool
a} :: DisassociateInstanceEventWindow)

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

-- | One or more targets to disassociate from the specified event window.
disassociateInstanceEventWindow_associationTarget :: Lens.Lens' DisassociateInstanceEventWindow InstanceEventWindowDisassociationRequest
disassociateInstanceEventWindow_associationTarget :: Lens'
  DisassociateInstanceEventWindow
  InstanceEventWindowDisassociationRequest
disassociateInstanceEventWindow_associationTarget = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateInstanceEventWindow' {InstanceEventWindowDisassociationRequest
associationTarget :: InstanceEventWindowDisassociationRequest
$sel:associationTarget:DisassociateInstanceEventWindow' :: DisassociateInstanceEventWindow
-> InstanceEventWindowDisassociationRequest
associationTarget} -> InstanceEventWindowDisassociationRequest
associationTarget) (\s :: DisassociateInstanceEventWindow
s@DisassociateInstanceEventWindow' {} InstanceEventWindowDisassociationRequest
a -> DisassociateInstanceEventWindow
s {$sel:associationTarget:DisassociateInstanceEventWindow' :: InstanceEventWindowDisassociationRequest
associationTarget = InstanceEventWindowDisassociationRequest
a} :: DisassociateInstanceEventWindow)

instance
  Core.AWSRequest
    DisassociateInstanceEventWindow
  where
  type
    AWSResponse DisassociateInstanceEventWindow =
      DisassociateInstanceEventWindowResponse
  request :: (Service -> Service)
-> DisassociateInstanceEventWindow
-> Request DisassociateInstanceEventWindow
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 DisassociateInstanceEventWindow
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DisassociateInstanceEventWindow)))
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 -> DisassociateInstanceEventWindowResponse
DisassociateInstanceEventWindowResponse'
            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
    DisassociateInstanceEventWindow
  where
  hashWithSalt :: Int -> DisassociateInstanceEventWindow -> Int
hashWithSalt
    Int
_salt
    DisassociateInstanceEventWindow' {Maybe Bool
Text
InstanceEventWindowDisassociationRequest
associationTarget :: InstanceEventWindowDisassociationRequest
instanceEventWindowId :: Text
dryRun :: Maybe Bool
$sel:associationTarget:DisassociateInstanceEventWindow' :: DisassociateInstanceEventWindow
-> InstanceEventWindowDisassociationRequest
$sel:instanceEventWindowId:DisassociateInstanceEventWindow' :: DisassociateInstanceEventWindow -> Text
$sel:dryRun:DisassociateInstanceEventWindow' :: DisassociateInstanceEventWindow -> 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` InstanceEventWindowDisassociationRequest
associationTarget

instance
  Prelude.NFData
    DisassociateInstanceEventWindow
  where
  rnf :: DisassociateInstanceEventWindow -> ()
rnf DisassociateInstanceEventWindow' {Maybe Bool
Text
InstanceEventWindowDisassociationRequest
associationTarget :: InstanceEventWindowDisassociationRequest
instanceEventWindowId :: Text
dryRun :: Maybe Bool
$sel:associationTarget:DisassociateInstanceEventWindow' :: DisassociateInstanceEventWindow
-> InstanceEventWindowDisassociationRequest
$sel:instanceEventWindowId:DisassociateInstanceEventWindow' :: DisassociateInstanceEventWindow -> Text
$sel:dryRun:DisassociateInstanceEventWindow' :: DisassociateInstanceEventWindow -> 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 InstanceEventWindowDisassociationRequest
associationTarget

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

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

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

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

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

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

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

instance
  Prelude.NFData
    DisassociateInstanceEventWindowResponse
  where
  rnf :: DisassociateInstanceEventWindowResponse -> ()
rnf DisassociateInstanceEventWindowResponse' {Int
Maybe InstanceEventWindow
httpStatus :: Int
instanceEventWindow :: Maybe InstanceEventWindow
$sel:httpStatus:DisassociateInstanceEventWindowResponse' :: DisassociateInstanceEventWindowResponse -> Int
$sel:instanceEventWindow:DisassociateInstanceEventWindowResponse' :: DisassociateInstanceEventWindowResponse
-> 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