{-# 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.ReleaseHosts
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- When you no longer want to use an On-Demand Dedicated Host it can be
-- released. On-Demand billing is stopped and the host goes into @released@
-- state. The host ID of Dedicated Hosts that have been released can no
-- longer be specified in another request, for example, to modify the host.
-- You must stop or terminate all instances on a host before it can be
-- released.
--
-- When Dedicated Hosts are released, it may take some time for them to
-- stop counting toward your limit and you may receive capacity errors when
-- trying to allocate new Dedicated Hosts. Wait a few minutes and then try
-- again.
--
-- Released hosts still appear in a DescribeHosts response.
module Amazonka.EC2.ReleaseHosts
  ( -- * Creating a Request
    ReleaseHosts (..),
    newReleaseHosts,

    -- * Request Lenses
    releaseHosts_hostIds,

    -- * Destructuring the Response
    ReleaseHostsResponse (..),
    newReleaseHostsResponse,

    -- * Response Lenses
    releaseHostsResponse_successful,
    releaseHostsResponse_unsuccessful,
    releaseHostsResponse_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:/ 'newReleaseHosts' smart constructor.
data ReleaseHosts = ReleaseHosts'
  { -- | The IDs of the Dedicated Hosts to release.
    ReleaseHosts -> [Text]
hostIds :: [Prelude.Text]
  }
  deriving (ReleaseHosts -> ReleaseHosts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReleaseHosts -> ReleaseHosts -> Bool
$c/= :: ReleaseHosts -> ReleaseHosts -> Bool
== :: ReleaseHosts -> ReleaseHosts -> Bool
$c== :: ReleaseHosts -> ReleaseHosts -> Bool
Prelude.Eq, ReadPrec [ReleaseHosts]
ReadPrec ReleaseHosts
Int -> ReadS ReleaseHosts
ReadS [ReleaseHosts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReleaseHosts]
$creadListPrec :: ReadPrec [ReleaseHosts]
readPrec :: ReadPrec ReleaseHosts
$creadPrec :: ReadPrec ReleaseHosts
readList :: ReadS [ReleaseHosts]
$creadList :: ReadS [ReleaseHosts]
readsPrec :: Int -> ReadS ReleaseHosts
$creadsPrec :: Int -> ReadS ReleaseHosts
Prelude.Read, Int -> ReleaseHosts -> ShowS
[ReleaseHosts] -> ShowS
ReleaseHosts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReleaseHosts] -> ShowS
$cshowList :: [ReleaseHosts] -> ShowS
show :: ReleaseHosts -> String
$cshow :: ReleaseHosts -> String
showsPrec :: Int -> ReleaseHosts -> ShowS
$cshowsPrec :: Int -> ReleaseHosts -> ShowS
Prelude.Show, forall x. Rep ReleaseHosts x -> ReleaseHosts
forall x. ReleaseHosts -> Rep ReleaseHosts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReleaseHosts x -> ReleaseHosts
$cfrom :: forall x. ReleaseHosts -> Rep ReleaseHosts x
Prelude.Generic)

-- |
-- Create a value of 'ReleaseHosts' 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:
--
-- 'hostIds', 'releaseHosts_hostIds' - The IDs of the Dedicated Hosts to release.
newReleaseHosts ::
  ReleaseHosts
newReleaseHosts :: ReleaseHosts
newReleaseHosts =
  ReleaseHosts' {$sel:hostIds:ReleaseHosts' :: [Text]
hostIds = forall a. Monoid a => a
Prelude.mempty}

-- | The IDs of the Dedicated Hosts to release.
releaseHosts_hostIds :: Lens.Lens' ReleaseHosts [Prelude.Text]
releaseHosts_hostIds :: Lens' ReleaseHosts [Text]
releaseHosts_hostIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReleaseHosts' {[Text]
hostIds :: [Text]
$sel:hostIds:ReleaseHosts' :: ReleaseHosts -> [Text]
hostIds} -> [Text]
hostIds) (\s :: ReleaseHosts
s@ReleaseHosts' {} [Text]
a -> ReleaseHosts
s {$sel:hostIds:ReleaseHosts' :: [Text]
hostIds = [Text]
a} :: ReleaseHosts) 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 ReleaseHosts where
  type AWSResponse ReleaseHosts = ReleaseHostsResponse
  request :: (Service -> Service) -> ReleaseHosts -> Request ReleaseHosts
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 ReleaseHosts
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ReleaseHosts)))
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 [Text]
-> Maybe [UnsuccessfulItem] -> Int -> ReleaseHostsResponse
ReleaseHostsResponse'
            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
"successful"
                            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.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"unsuccessful"
                            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 ReleaseHosts where
  hashWithSalt :: Int -> ReleaseHosts -> Int
hashWithSalt Int
_salt ReleaseHosts' {[Text]
hostIds :: [Text]
$sel:hostIds:ReleaseHosts' :: ReleaseHosts -> [Text]
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
hostIds

instance Prelude.NFData ReleaseHosts where
  rnf :: ReleaseHosts -> ()
rnf ReleaseHosts' {[Text]
hostIds :: [Text]
$sel:hostIds:ReleaseHosts' :: ReleaseHosts -> [Text]
..} = forall a. NFData a => a -> ()
Prelude.rnf [Text]
hostIds

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

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

instance Data.ToQuery ReleaseHosts where
  toQuery :: ReleaseHosts -> QueryString
toQuery ReleaseHosts' {[Text]
hostIds :: [Text]
$sel:hostIds:ReleaseHosts' :: ReleaseHosts -> [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ReleaseHosts" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"HostId" [Text]
hostIds
      ]

-- | /See:/ 'newReleaseHostsResponse' smart constructor.
data ReleaseHostsResponse = ReleaseHostsResponse'
  { -- | The IDs of the Dedicated Hosts that were successfully released.
    ReleaseHostsResponse -> Maybe [Text]
successful :: Prelude.Maybe [Prelude.Text],
    -- | The IDs of the Dedicated Hosts that could not be released, including an
    -- error message.
    ReleaseHostsResponse -> Maybe [UnsuccessfulItem]
unsuccessful :: Prelude.Maybe [UnsuccessfulItem],
    -- | The response's http status code.
    ReleaseHostsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ReleaseHostsResponse -> ReleaseHostsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReleaseHostsResponse -> ReleaseHostsResponse -> Bool
$c/= :: ReleaseHostsResponse -> ReleaseHostsResponse -> Bool
== :: ReleaseHostsResponse -> ReleaseHostsResponse -> Bool
$c== :: ReleaseHostsResponse -> ReleaseHostsResponse -> Bool
Prelude.Eq, ReadPrec [ReleaseHostsResponse]
ReadPrec ReleaseHostsResponse
Int -> ReadS ReleaseHostsResponse
ReadS [ReleaseHostsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReleaseHostsResponse]
$creadListPrec :: ReadPrec [ReleaseHostsResponse]
readPrec :: ReadPrec ReleaseHostsResponse
$creadPrec :: ReadPrec ReleaseHostsResponse
readList :: ReadS [ReleaseHostsResponse]
$creadList :: ReadS [ReleaseHostsResponse]
readsPrec :: Int -> ReadS ReleaseHostsResponse
$creadsPrec :: Int -> ReadS ReleaseHostsResponse
Prelude.Read, Int -> ReleaseHostsResponse -> ShowS
[ReleaseHostsResponse] -> ShowS
ReleaseHostsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReleaseHostsResponse] -> ShowS
$cshowList :: [ReleaseHostsResponse] -> ShowS
show :: ReleaseHostsResponse -> String
$cshow :: ReleaseHostsResponse -> String
showsPrec :: Int -> ReleaseHostsResponse -> ShowS
$cshowsPrec :: Int -> ReleaseHostsResponse -> ShowS
Prelude.Show, forall x. Rep ReleaseHostsResponse x -> ReleaseHostsResponse
forall x. ReleaseHostsResponse -> Rep ReleaseHostsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReleaseHostsResponse x -> ReleaseHostsResponse
$cfrom :: forall x. ReleaseHostsResponse -> Rep ReleaseHostsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ReleaseHostsResponse' 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:
--
-- 'successful', 'releaseHostsResponse_successful' - The IDs of the Dedicated Hosts that were successfully released.
--
-- 'unsuccessful', 'releaseHostsResponse_unsuccessful' - The IDs of the Dedicated Hosts that could not be released, including an
-- error message.
--
-- 'httpStatus', 'releaseHostsResponse_httpStatus' - The response's http status code.
newReleaseHostsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ReleaseHostsResponse
newReleaseHostsResponse :: Int -> ReleaseHostsResponse
newReleaseHostsResponse Int
pHttpStatus_ =
  ReleaseHostsResponse'
    { $sel:successful:ReleaseHostsResponse' :: Maybe [Text]
successful = forall a. Maybe a
Prelude.Nothing,
      $sel:unsuccessful:ReleaseHostsResponse' :: Maybe [UnsuccessfulItem]
unsuccessful = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ReleaseHostsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The IDs of the Dedicated Hosts that were successfully released.
releaseHostsResponse_successful :: Lens.Lens' ReleaseHostsResponse (Prelude.Maybe [Prelude.Text])
releaseHostsResponse_successful :: Lens' ReleaseHostsResponse (Maybe [Text])
releaseHostsResponse_successful = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReleaseHostsResponse' {Maybe [Text]
successful :: Maybe [Text]
$sel:successful:ReleaseHostsResponse' :: ReleaseHostsResponse -> Maybe [Text]
successful} -> Maybe [Text]
successful) (\s :: ReleaseHostsResponse
s@ReleaseHostsResponse' {} Maybe [Text]
a -> ReleaseHostsResponse
s {$sel:successful:ReleaseHostsResponse' :: Maybe [Text]
successful = Maybe [Text]
a} :: ReleaseHostsResponse) 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 IDs of the Dedicated Hosts that could not be released, including an
-- error message.
releaseHostsResponse_unsuccessful :: Lens.Lens' ReleaseHostsResponse (Prelude.Maybe [UnsuccessfulItem])
releaseHostsResponse_unsuccessful :: Lens' ReleaseHostsResponse (Maybe [UnsuccessfulItem])
releaseHostsResponse_unsuccessful = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReleaseHostsResponse' {Maybe [UnsuccessfulItem]
unsuccessful :: Maybe [UnsuccessfulItem]
$sel:unsuccessful:ReleaseHostsResponse' :: ReleaseHostsResponse -> Maybe [UnsuccessfulItem]
unsuccessful} -> Maybe [UnsuccessfulItem]
unsuccessful) (\s :: ReleaseHostsResponse
s@ReleaseHostsResponse' {} Maybe [UnsuccessfulItem]
a -> ReleaseHostsResponse
s {$sel:unsuccessful:ReleaseHostsResponse' :: Maybe [UnsuccessfulItem]
unsuccessful = Maybe [UnsuccessfulItem]
a} :: ReleaseHostsResponse) 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.
releaseHostsResponse_httpStatus :: Lens.Lens' ReleaseHostsResponse Prelude.Int
releaseHostsResponse_httpStatus :: Lens' ReleaseHostsResponse Int
releaseHostsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReleaseHostsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ReleaseHostsResponse' :: ReleaseHostsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ReleaseHostsResponse
s@ReleaseHostsResponse' {} Int
a -> ReleaseHostsResponse
s {$sel:httpStatus:ReleaseHostsResponse' :: Int
httpStatus = Int
a} :: ReleaseHostsResponse)

instance Prelude.NFData ReleaseHostsResponse where
  rnf :: ReleaseHostsResponse -> ()
rnf ReleaseHostsResponse' {Int
Maybe [Text]
Maybe [UnsuccessfulItem]
httpStatus :: Int
unsuccessful :: Maybe [UnsuccessfulItem]
successful :: Maybe [Text]
$sel:httpStatus:ReleaseHostsResponse' :: ReleaseHostsResponse -> Int
$sel:unsuccessful:ReleaseHostsResponse' :: ReleaseHostsResponse -> Maybe [UnsuccessfulItem]
$sel:successful:ReleaseHostsResponse' :: ReleaseHostsResponse -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
successful
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UnsuccessfulItem]
unsuccessful
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus