{-# 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.Redshift.AcceptReservedNodeExchange
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Exchanges a DC1 Reserved Node for a DC2 Reserved Node with no changes to
-- the configuration (term, payment type, or number of nodes) and no
-- additional costs.
module Amazonka.Redshift.AcceptReservedNodeExchange
  ( -- * Creating a Request
    AcceptReservedNodeExchange (..),
    newAcceptReservedNodeExchange,

    -- * Request Lenses
    acceptReservedNodeExchange_reservedNodeId,
    acceptReservedNodeExchange_targetReservedNodeOfferingId,

    -- * Destructuring the Response
    AcceptReservedNodeExchangeResponse (..),
    newAcceptReservedNodeExchangeResponse,

    -- * Response Lenses
    acceptReservedNodeExchangeResponse_exchangedReservedNode,
    acceptReservedNodeExchangeResponse_httpStatus,
  )
where

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

-- | /See:/ 'newAcceptReservedNodeExchange' smart constructor.
data AcceptReservedNodeExchange = AcceptReservedNodeExchange'
  { -- | A string representing the node identifier of the DC1 Reserved Node to be
    -- exchanged.
    AcceptReservedNodeExchange -> Text
reservedNodeId :: Prelude.Text,
    -- | The unique identifier of the DC2 Reserved Node offering to be used for
    -- the exchange. You can obtain the value for the parameter by calling
    -- GetReservedNodeExchangeOfferings
    AcceptReservedNodeExchange -> Text
targetReservedNodeOfferingId :: Prelude.Text
  }
  deriving (AcceptReservedNodeExchange -> AcceptReservedNodeExchange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptReservedNodeExchange -> AcceptReservedNodeExchange -> Bool
$c/= :: AcceptReservedNodeExchange -> AcceptReservedNodeExchange -> Bool
== :: AcceptReservedNodeExchange -> AcceptReservedNodeExchange -> Bool
$c== :: AcceptReservedNodeExchange -> AcceptReservedNodeExchange -> Bool
Prelude.Eq, ReadPrec [AcceptReservedNodeExchange]
ReadPrec AcceptReservedNodeExchange
Int -> ReadS AcceptReservedNodeExchange
ReadS [AcceptReservedNodeExchange]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AcceptReservedNodeExchange]
$creadListPrec :: ReadPrec [AcceptReservedNodeExchange]
readPrec :: ReadPrec AcceptReservedNodeExchange
$creadPrec :: ReadPrec AcceptReservedNodeExchange
readList :: ReadS [AcceptReservedNodeExchange]
$creadList :: ReadS [AcceptReservedNodeExchange]
readsPrec :: Int -> ReadS AcceptReservedNodeExchange
$creadsPrec :: Int -> ReadS AcceptReservedNodeExchange
Prelude.Read, Int -> AcceptReservedNodeExchange -> ShowS
[AcceptReservedNodeExchange] -> ShowS
AcceptReservedNodeExchange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptReservedNodeExchange] -> ShowS
$cshowList :: [AcceptReservedNodeExchange] -> ShowS
show :: AcceptReservedNodeExchange -> String
$cshow :: AcceptReservedNodeExchange -> String
showsPrec :: Int -> AcceptReservedNodeExchange -> ShowS
$cshowsPrec :: Int -> AcceptReservedNodeExchange -> ShowS
Prelude.Show, forall x.
Rep AcceptReservedNodeExchange x -> AcceptReservedNodeExchange
forall x.
AcceptReservedNodeExchange -> Rep AcceptReservedNodeExchange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AcceptReservedNodeExchange x -> AcceptReservedNodeExchange
$cfrom :: forall x.
AcceptReservedNodeExchange -> Rep AcceptReservedNodeExchange x
Prelude.Generic)

-- |
-- Create a value of 'AcceptReservedNodeExchange' 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:
--
-- 'reservedNodeId', 'acceptReservedNodeExchange_reservedNodeId' - A string representing the node identifier of the DC1 Reserved Node to be
-- exchanged.
--
-- 'targetReservedNodeOfferingId', 'acceptReservedNodeExchange_targetReservedNodeOfferingId' - The unique identifier of the DC2 Reserved Node offering to be used for
-- the exchange. You can obtain the value for the parameter by calling
-- GetReservedNodeExchangeOfferings
newAcceptReservedNodeExchange ::
  -- | 'reservedNodeId'
  Prelude.Text ->
  -- | 'targetReservedNodeOfferingId'
  Prelude.Text ->
  AcceptReservedNodeExchange
newAcceptReservedNodeExchange :: Text -> Text -> AcceptReservedNodeExchange
newAcceptReservedNodeExchange
  Text
pReservedNodeId_
  Text
pTargetReservedNodeOfferingId_ =
    AcceptReservedNodeExchange'
      { $sel:reservedNodeId:AcceptReservedNodeExchange' :: Text
reservedNodeId =
          Text
pReservedNodeId_,
        $sel:targetReservedNodeOfferingId:AcceptReservedNodeExchange' :: Text
targetReservedNodeOfferingId =
          Text
pTargetReservedNodeOfferingId_
      }

-- | A string representing the node identifier of the DC1 Reserved Node to be
-- exchanged.
acceptReservedNodeExchange_reservedNodeId :: Lens.Lens' AcceptReservedNodeExchange Prelude.Text
acceptReservedNodeExchange_reservedNodeId :: Lens' AcceptReservedNodeExchange Text
acceptReservedNodeExchange_reservedNodeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptReservedNodeExchange' {Text
reservedNodeId :: Text
$sel:reservedNodeId:AcceptReservedNodeExchange' :: AcceptReservedNodeExchange -> Text
reservedNodeId} -> Text
reservedNodeId) (\s :: AcceptReservedNodeExchange
s@AcceptReservedNodeExchange' {} Text
a -> AcceptReservedNodeExchange
s {$sel:reservedNodeId:AcceptReservedNodeExchange' :: Text
reservedNodeId = Text
a} :: AcceptReservedNodeExchange)

-- | The unique identifier of the DC2 Reserved Node offering to be used for
-- the exchange. You can obtain the value for the parameter by calling
-- GetReservedNodeExchangeOfferings
acceptReservedNodeExchange_targetReservedNodeOfferingId :: Lens.Lens' AcceptReservedNodeExchange Prelude.Text
acceptReservedNodeExchange_targetReservedNodeOfferingId :: Lens' AcceptReservedNodeExchange Text
acceptReservedNodeExchange_targetReservedNodeOfferingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptReservedNodeExchange' {Text
targetReservedNodeOfferingId :: Text
$sel:targetReservedNodeOfferingId:AcceptReservedNodeExchange' :: AcceptReservedNodeExchange -> Text
targetReservedNodeOfferingId} -> Text
targetReservedNodeOfferingId) (\s :: AcceptReservedNodeExchange
s@AcceptReservedNodeExchange' {} Text
a -> AcceptReservedNodeExchange
s {$sel:targetReservedNodeOfferingId:AcceptReservedNodeExchange' :: Text
targetReservedNodeOfferingId = Text
a} :: AcceptReservedNodeExchange)

instance Core.AWSRequest AcceptReservedNodeExchange where
  type
    AWSResponse AcceptReservedNodeExchange =
      AcceptReservedNodeExchangeResponse
  request :: (Service -> Service)
-> AcceptReservedNodeExchange -> Request AcceptReservedNodeExchange
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 AcceptReservedNodeExchange
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AcceptReservedNodeExchange)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"AcceptReservedNodeExchangeResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe ReservedNode -> Int -> AcceptReservedNodeExchangeResponse
AcceptReservedNodeExchangeResponse'
            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
"ExchangedReservedNode")
            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 AcceptReservedNodeExchange where
  hashWithSalt :: Int -> AcceptReservedNodeExchange -> Int
hashWithSalt Int
_salt AcceptReservedNodeExchange' {Text
targetReservedNodeOfferingId :: Text
reservedNodeId :: Text
$sel:targetReservedNodeOfferingId:AcceptReservedNodeExchange' :: AcceptReservedNodeExchange -> Text
$sel:reservedNodeId:AcceptReservedNodeExchange' :: AcceptReservedNodeExchange -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
reservedNodeId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetReservedNodeOfferingId

instance Prelude.NFData AcceptReservedNodeExchange where
  rnf :: AcceptReservedNodeExchange -> ()
rnf AcceptReservedNodeExchange' {Text
targetReservedNodeOfferingId :: Text
reservedNodeId :: Text
$sel:targetReservedNodeOfferingId:AcceptReservedNodeExchange' :: AcceptReservedNodeExchange -> Text
$sel:reservedNodeId:AcceptReservedNodeExchange' :: AcceptReservedNodeExchange -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
reservedNodeId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetReservedNodeOfferingId

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

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

instance Data.ToQuery AcceptReservedNodeExchange where
  toQuery :: AcceptReservedNodeExchange -> QueryString
toQuery AcceptReservedNodeExchange' {Text
targetReservedNodeOfferingId :: Text
reservedNodeId :: Text
$sel:targetReservedNodeOfferingId:AcceptReservedNodeExchange' :: AcceptReservedNodeExchange -> Text
$sel:reservedNodeId:AcceptReservedNodeExchange' :: AcceptReservedNodeExchange -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"AcceptReservedNodeExchange" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"ReservedNodeId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
reservedNodeId,
        ByteString
"TargetReservedNodeOfferingId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
targetReservedNodeOfferingId
      ]

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

-- |
-- Create a value of 'AcceptReservedNodeExchangeResponse' 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:
--
-- 'exchangedReservedNode', 'acceptReservedNodeExchangeResponse_exchangedReservedNode' -
--
-- 'httpStatus', 'acceptReservedNodeExchangeResponse_httpStatus' - The response's http status code.
newAcceptReservedNodeExchangeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AcceptReservedNodeExchangeResponse
newAcceptReservedNodeExchangeResponse :: Int -> AcceptReservedNodeExchangeResponse
newAcceptReservedNodeExchangeResponse Int
pHttpStatus_ =
  AcceptReservedNodeExchangeResponse'
    { $sel:exchangedReservedNode:AcceptReservedNodeExchangeResponse' :: Maybe ReservedNode
exchangedReservedNode =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AcceptReservedNodeExchangeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

acceptReservedNodeExchangeResponse_exchangedReservedNode :: Lens.Lens' AcceptReservedNodeExchangeResponse (Prelude.Maybe ReservedNode)
acceptReservedNodeExchangeResponse_exchangedReservedNode :: Lens' AcceptReservedNodeExchangeResponse (Maybe ReservedNode)
acceptReservedNodeExchangeResponse_exchangedReservedNode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptReservedNodeExchangeResponse' {Maybe ReservedNode
exchangedReservedNode :: Maybe ReservedNode
$sel:exchangedReservedNode:AcceptReservedNodeExchangeResponse' :: AcceptReservedNodeExchangeResponse -> Maybe ReservedNode
exchangedReservedNode} -> Maybe ReservedNode
exchangedReservedNode) (\s :: AcceptReservedNodeExchangeResponse
s@AcceptReservedNodeExchangeResponse' {} Maybe ReservedNode
a -> AcceptReservedNodeExchangeResponse
s {$sel:exchangedReservedNode:AcceptReservedNodeExchangeResponse' :: Maybe ReservedNode
exchangedReservedNode = Maybe ReservedNode
a} :: AcceptReservedNodeExchangeResponse)

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

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