{-# 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.StopInstances
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops an Amazon EBS-backed instance. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Stop_Start.html Stop and start your instance>
-- in the /Amazon EC2 User Guide/.
--
-- You can use the Stop action to hibernate an instance if the instance is
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Hibernate.html#enabling-hibernation enabled for hibernation>
-- and it meets the
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Hibernate.html#hibernating-prerequisites hibernation prerequisites>.
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Hibernate.html Hibernate your instance>
-- in the /Amazon EC2 User Guide/.
--
-- We don\'t charge usage for a stopped instance, or data transfer fees;
-- however, your root partition Amazon EBS volume remains and continues to
-- persist your data, and you are charged for Amazon EBS volume usage.
-- Every time you start your instance, Amazon EC2 charges a one-minute
-- minimum for instance usage, and thereafter charges per second for
-- instance usage.
--
-- You can\'t stop or hibernate instance store-backed instances. You can\'t
-- use the Stop action to hibernate Spot Instances, but you can specify
-- that Amazon EC2 should hibernate Spot Instances when they are
-- interrupted. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/spot-interruptions.html#hibernate-spot-instances Hibernating interrupted Spot Instances>
-- in the /Amazon EC2 User Guide/.
--
-- When you stop or hibernate an instance, we shut it down. You can restart
-- your instance at any time. Before stopping or hibernating an instance,
-- make sure it is in a state from which it can be restarted. Stopping an
-- instance does not preserve data stored in RAM, but hibernating an
-- instance does preserve data stored in RAM. If an instance cannot
-- hibernate successfully, a normal shutdown occurs.
--
-- Stopping and hibernating an instance is different to rebooting or
-- terminating it. For example, when you stop or hibernate an instance, the
-- root device and any other devices attached to the instance persist. When
-- you terminate an instance, the root device and any other devices
-- attached during the instance launch are automatically deleted. For more
-- information about the differences between rebooting, stopping,
-- hibernating, and terminating instances, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-instance-lifecycle.html Instance lifecycle>
-- in the /Amazon EC2 User Guide/.
--
-- When you stop an instance, we attempt to shut it down forcibly after a
-- short while. If your instance appears stuck in the stopping state after
-- a period of time, there may be an issue with the underlying host
-- computer. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/TroubleshootingInstancesStopping.html Troubleshoot stopping your instance>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2.StopInstances
  ( -- * Creating a Request
    StopInstances (..),
    newStopInstances,

    -- * Request Lenses
    stopInstances_dryRun,
    stopInstances_force,
    stopInstances_hibernate,
    stopInstances_instanceIds,

    -- * Destructuring the Response
    StopInstancesResponse (..),
    newStopInstancesResponse,

    -- * Response Lenses
    stopInstancesResponse_stoppingInstances,
    stopInstancesResponse_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:/ 'newStopInstances' smart constructor.
data StopInstances = StopInstances'
  { -- | 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@.
    StopInstances -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Forces the instances to stop. The instances do not have an opportunity
    -- to flush file system caches or file system metadata. If you use this
    -- option, you must perform file system check and repair procedures. This
    -- option is not recommended for Windows instances.
    --
    -- Default: @false@
    StopInstances -> Maybe Bool
force :: Prelude.Maybe Prelude.Bool,
    -- | Hibernates the instance if the instance was enabled for hibernation at
    -- launch. If the instance cannot hibernate successfully, a normal shutdown
    -- occurs. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Hibernate.html Hibernate your instance>
    -- in the /Amazon EC2 User Guide/.
    --
    -- Default: @false@
    StopInstances -> Maybe Bool
hibernate :: Prelude.Maybe Prelude.Bool,
    -- | The IDs of the instances.
    StopInstances -> [Text]
instanceIds :: [Prelude.Text]
  }
  deriving (StopInstances -> StopInstances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopInstances -> StopInstances -> Bool
$c/= :: StopInstances -> StopInstances -> Bool
== :: StopInstances -> StopInstances -> Bool
$c== :: StopInstances -> StopInstances -> Bool
Prelude.Eq, ReadPrec [StopInstances]
ReadPrec StopInstances
Int -> ReadS StopInstances
ReadS [StopInstances]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopInstances]
$creadListPrec :: ReadPrec [StopInstances]
readPrec :: ReadPrec StopInstances
$creadPrec :: ReadPrec StopInstances
readList :: ReadS [StopInstances]
$creadList :: ReadS [StopInstances]
readsPrec :: Int -> ReadS StopInstances
$creadsPrec :: Int -> ReadS StopInstances
Prelude.Read, Int -> StopInstances -> ShowS
[StopInstances] -> ShowS
StopInstances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopInstances] -> ShowS
$cshowList :: [StopInstances] -> ShowS
show :: StopInstances -> String
$cshow :: StopInstances -> String
showsPrec :: Int -> StopInstances -> ShowS
$cshowsPrec :: Int -> StopInstances -> ShowS
Prelude.Show, forall x. Rep StopInstances x -> StopInstances
forall x. StopInstances -> Rep StopInstances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopInstances x -> StopInstances
$cfrom :: forall x. StopInstances -> Rep StopInstances x
Prelude.Generic)

-- |
-- Create a value of 'StopInstances' 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', 'stopInstances_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@.
--
-- 'force', 'stopInstances_force' - Forces the instances to stop. The instances do not have an opportunity
-- to flush file system caches or file system metadata. If you use this
-- option, you must perform file system check and repair procedures. This
-- option is not recommended for Windows instances.
--
-- Default: @false@
--
-- 'hibernate', 'stopInstances_hibernate' - Hibernates the instance if the instance was enabled for hibernation at
-- launch. If the instance cannot hibernate successfully, a normal shutdown
-- occurs. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Hibernate.html Hibernate your instance>
-- in the /Amazon EC2 User Guide/.
--
-- Default: @false@
--
-- 'instanceIds', 'stopInstances_instanceIds' - The IDs of the instances.
newStopInstances ::
  StopInstances
newStopInstances :: StopInstances
newStopInstances =
  StopInstances'
    { $sel:dryRun:StopInstances' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:force:StopInstances' :: Maybe Bool
force = forall a. Maybe a
Prelude.Nothing,
      $sel:hibernate:StopInstances' :: Maybe Bool
hibernate = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceIds:StopInstances' :: [Text]
instanceIds = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | Forces the instances to stop. The instances do not have an opportunity
-- to flush file system caches or file system metadata. If you use this
-- option, you must perform file system check and repair procedures. This
-- option is not recommended for Windows instances.
--
-- Default: @false@
stopInstances_force :: Lens.Lens' StopInstances (Prelude.Maybe Prelude.Bool)
stopInstances_force :: Lens' StopInstances (Maybe Bool)
stopInstances_force = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopInstances' {Maybe Bool
force :: Maybe Bool
$sel:force:StopInstances' :: StopInstances -> Maybe Bool
force} -> Maybe Bool
force) (\s :: StopInstances
s@StopInstances' {} Maybe Bool
a -> StopInstances
s {$sel:force:StopInstances' :: Maybe Bool
force = Maybe Bool
a} :: StopInstances)

-- | Hibernates the instance if the instance was enabled for hibernation at
-- launch. If the instance cannot hibernate successfully, a normal shutdown
-- occurs. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Hibernate.html Hibernate your instance>
-- in the /Amazon EC2 User Guide/.
--
-- Default: @false@
stopInstances_hibernate :: Lens.Lens' StopInstances (Prelude.Maybe Prelude.Bool)
stopInstances_hibernate :: Lens' StopInstances (Maybe Bool)
stopInstances_hibernate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopInstances' {Maybe Bool
hibernate :: Maybe Bool
$sel:hibernate:StopInstances' :: StopInstances -> Maybe Bool
hibernate} -> Maybe Bool
hibernate) (\s :: StopInstances
s@StopInstances' {} Maybe Bool
a -> StopInstances
s {$sel:hibernate:StopInstances' :: Maybe Bool
hibernate = Maybe Bool
a} :: StopInstances)

-- | The IDs of the instances.
stopInstances_instanceIds :: Lens.Lens' StopInstances [Prelude.Text]
stopInstances_instanceIds :: Lens' StopInstances [Text]
stopInstances_instanceIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopInstances' {[Text]
instanceIds :: [Text]
$sel:instanceIds:StopInstances' :: StopInstances -> [Text]
instanceIds} -> [Text]
instanceIds) (\s :: StopInstances
s@StopInstances' {} [Text]
a -> StopInstances
s {$sel:instanceIds:StopInstances' :: [Text]
instanceIds = [Text]
a} :: StopInstances) 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 StopInstances where
  type
    AWSResponse StopInstances =
      StopInstancesResponse
  request :: (Service -> Service) -> StopInstances -> Request StopInstances
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 StopInstances
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StopInstances)))
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 [InstanceStateChange] -> Int -> StopInstancesResponse
StopInstancesResponse'
            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
"instancesSet"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            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 StopInstances where
  hashWithSalt :: Int -> StopInstances -> Int
hashWithSalt Int
_salt StopInstances' {[Text]
Maybe Bool
instanceIds :: [Text]
hibernate :: Maybe Bool
force :: Maybe Bool
dryRun :: Maybe Bool
$sel:instanceIds:StopInstances' :: StopInstances -> [Text]
$sel:hibernate:StopInstances' :: StopInstances -> Maybe Bool
$sel:force:StopInstances' :: StopInstances -> Maybe Bool
$sel:dryRun:StopInstances' :: StopInstances -> 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` Maybe Bool
force
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
hibernate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
instanceIds

instance Prelude.NFData StopInstances where
  rnf :: StopInstances -> ()
rnf StopInstances' {[Text]
Maybe Bool
instanceIds :: [Text]
hibernate :: Maybe Bool
force :: Maybe Bool
dryRun :: Maybe Bool
$sel:instanceIds:StopInstances' :: StopInstances -> [Text]
$sel:hibernate:StopInstances' :: StopInstances -> Maybe Bool
$sel:force:StopInstances' :: StopInstances -> Maybe Bool
$sel:dryRun:StopInstances' :: StopInstances -> 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 Maybe Bool
force
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
hibernate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
instanceIds

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

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

instance Data.ToQuery StopInstances where
  toQuery :: StopInstances -> QueryString
toQuery StopInstances' {[Text]
Maybe Bool
instanceIds :: [Text]
hibernate :: Maybe Bool
force :: Maybe Bool
dryRun :: Maybe Bool
$sel:instanceIds:StopInstances' :: StopInstances -> [Text]
$sel:hibernate:StopInstances' :: StopInstances -> Maybe Bool
$sel:force:StopInstances' :: StopInstances -> Maybe Bool
$sel:dryRun:StopInstances' :: StopInstances -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"StopInstances" :: 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
"Force" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
force,
        ByteString
"Hibernate" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
hibernate,
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"InstanceId" [Text]
instanceIds
      ]

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

-- |
-- Create a value of 'StopInstancesResponse' 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:
--
-- 'stoppingInstances', 'stopInstancesResponse_stoppingInstances' - Information about the stopped instances.
--
-- 'httpStatus', 'stopInstancesResponse_httpStatus' - The response's http status code.
newStopInstancesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StopInstancesResponse
newStopInstancesResponse :: Int -> StopInstancesResponse
newStopInstancesResponse Int
pHttpStatus_ =
  StopInstancesResponse'
    { $sel:stoppingInstances:StopInstancesResponse' :: Maybe [InstanceStateChange]
stoppingInstances =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StopInstancesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the stopped instances.
stopInstancesResponse_stoppingInstances :: Lens.Lens' StopInstancesResponse (Prelude.Maybe [InstanceStateChange])
stopInstancesResponse_stoppingInstances :: Lens' StopInstancesResponse (Maybe [InstanceStateChange])
stopInstancesResponse_stoppingInstances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopInstancesResponse' {Maybe [InstanceStateChange]
stoppingInstances :: Maybe [InstanceStateChange]
$sel:stoppingInstances:StopInstancesResponse' :: StopInstancesResponse -> Maybe [InstanceStateChange]
stoppingInstances} -> Maybe [InstanceStateChange]
stoppingInstances) (\s :: StopInstancesResponse
s@StopInstancesResponse' {} Maybe [InstanceStateChange]
a -> StopInstancesResponse
s {$sel:stoppingInstances:StopInstancesResponse' :: Maybe [InstanceStateChange]
stoppingInstances = Maybe [InstanceStateChange]
a} :: StopInstancesResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData StopInstancesResponse where
  rnf :: StopInstancesResponse -> ()
rnf StopInstancesResponse' {Int
Maybe [InstanceStateChange]
httpStatus :: Int
stoppingInstances :: Maybe [InstanceStateChange]
$sel:httpStatus:StopInstancesResponse' :: StopInstancesResponse -> Int
$sel:stoppingInstances:StopInstancesResponse' :: StopInstancesResponse -> Maybe [InstanceStateChange]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [InstanceStateChange]
stoppingInstances
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus