{-# 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.OpsWorks.RegisterElasticIp
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Registers an Elastic IP address with a specified stack. An address can
-- be registered with only one stack at a time. If the address is already
-- registered, you must first deregister it by calling DeregisterElasticIp.
-- For more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/resources.html Resource Management>.
--
-- __Required Permissions__: To use this action, an IAM user must have a
-- Manage permissions level for the stack, or an attached policy that
-- explicitly grants permissions. For more information on user permissions,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
module Amazonka.OpsWorks.RegisterElasticIp
  ( -- * Creating a Request
    RegisterElasticIp (..),
    newRegisterElasticIp,

    -- * Request Lenses
    registerElasticIp_elasticIp,
    registerElasticIp_stackId,

    -- * Destructuring the Response
    RegisterElasticIpResponse (..),
    newRegisterElasticIpResponse,

    -- * Response Lenses
    registerElasticIpResponse_elasticIp,
    registerElasticIpResponse_httpStatus,
  )
where

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

-- | /See:/ 'newRegisterElasticIp' smart constructor.
data RegisterElasticIp = RegisterElasticIp'
  { -- | The Elastic IP address.
    RegisterElasticIp -> Text
elasticIp :: Prelude.Text,
    -- | The stack ID.
    RegisterElasticIp -> Text
stackId :: Prelude.Text
  }
  deriving (RegisterElasticIp -> RegisterElasticIp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterElasticIp -> RegisterElasticIp -> Bool
$c/= :: RegisterElasticIp -> RegisterElasticIp -> Bool
== :: RegisterElasticIp -> RegisterElasticIp -> Bool
$c== :: RegisterElasticIp -> RegisterElasticIp -> Bool
Prelude.Eq, ReadPrec [RegisterElasticIp]
ReadPrec RegisterElasticIp
Int -> ReadS RegisterElasticIp
ReadS [RegisterElasticIp]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterElasticIp]
$creadListPrec :: ReadPrec [RegisterElasticIp]
readPrec :: ReadPrec RegisterElasticIp
$creadPrec :: ReadPrec RegisterElasticIp
readList :: ReadS [RegisterElasticIp]
$creadList :: ReadS [RegisterElasticIp]
readsPrec :: Int -> ReadS RegisterElasticIp
$creadsPrec :: Int -> ReadS RegisterElasticIp
Prelude.Read, Int -> RegisterElasticIp -> ShowS
[RegisterElasticIp] -> ShowS
RegisterElasticIp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterElasticIp] -> ShowS
$cshowList :: [RegisterElasticIp] -> ShowS
show :: RegisterElasticIp -> String
$cshow :: RegisterElasticIp -> String
showsPrec :: Int -> RegisterElasticIp -> ShowS
$cshowsPrec :: Int -> RegisterElasticIp -> ShowS
Prelude.Show, forall x. Rep RegisterElasticIp x -> RegisterElasticIp
forall x. RegisterElasticIp -> Rep RegisterElasticIp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterElasticIp x -> RegisterElasticIp
$cfrom :: forall x. RegisterElasticIp -> Rep RegisterElasticIp x
Prelude.Generic)

-- |
-- Create a value of 'RegisterElasticIp' 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:
--
-- 'elasticIp', 'registerElasticIp_elasticIp' - The Elastic IP address.
--
-- 'stackId', 'registerElasticIp_stackId' - The stack ID.
newRegisterElasticIp ::
  -- | 'elasticIp'
  Prelude.Text ->
  -- | 'stackId'
  Prelude.Text ->
  RegisterElasticIp
newRegisterElasticIp :: Text -> Text -> RegisterElasticIp
newRegisterElasticIp Text
pElasticIp_ Text
pStackId_ =
  RegisterElasticIp'
    { $sel:elasticIp:RegisterElasticIp' :: Text
elasticIp = Text
pElasticIp_,
      $sel:stackId:RegisterElasticIp' :: Text
stackId = Text
pStackId_
    }

-- | The Elastic IP address.
registerElasticIp_elasticIp :: Lens.Lens' RegisterElasticIp Prelude.Text
registerElasticIp_elasticIp :: Lens' RegisterElasticIp Text
registerElasticIp_elasticIp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterElasticIp' {Text
elasticIp :: Text
$sel:elasticIp:RegisterElasticIp' :: RegisterElasticIp -> Text
elasticIp} -> Text
elasticIp) (\s :: RegisterElasticIp
s@RegisterElasticIp' {} Text
a -> RegisterElasticIp
s {$sel:elasticIp:RegisterElasticIp' :: Text
elasticIp = Text
a} :: RegisterElasticIp)

-- | The stack ID.
registerElasticIp_stackId :: Lens.Lens' RegisterElasticIp Prelude.Text
registerElasticIp_stackId :: Lens' RegisterElasticIp Text
registerElasticIp_stackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterElasticIp' {Text
stackId :: Text
$sel:stackId:RegisterElasticIp' :: RegisterElasticIp -> Text
stackId} -> Text
stackId) (\s :: RegisterElasticIp
s@RegisterElasticIp' {} Text
a -> RegisterElasticIp
s {$sel:stackId:RegisterElasticIp' :: Text
stackId = Text
a} :: RegisterElasticIp)

instance Core.AWSRequest RegisterElasticIp where
  type
    AWSResponse RegisterElasticIp =
      RegisterElasticIpResponse
  request :: (Service -> Service)
-> RegisterElasticIp -> Request RegisterElasticIp
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy RegisterElasticIp
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RegisterElasticIp)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> RegisterElasticIpResponse
RegisterElasticIpResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ElasticIp")
            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 RegisterElasticIp where
  hashWithSalt :: Int -> RegisterElasticIp -> Int
hashWithSalt Int
_salt RegisterElasticIp' {Text
stackId :: Text
elasticIp :: Text
$sel:stackId:RegisterElasticIp' :: RegisterElasticIp -> Text
$sel:elasticIp:RegisterElasticIp' :: RegisterElasticIp -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
elasticIp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackId

instance Prelude.NFData RegisterElasticIp where
  rnf :: RegisterElasticIp -> ()
rnf RegisterElasticIp' {Text
stackId :: Text
elasticIp :: Text
$sel:stackId:RegisterElasticIp' :: RegisterElasticIp -> Text
$sel:elasticIp:RegisterElasticIp' :: RegisterElasticIp -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
elasticIp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackId

instance Data.ToHeaders RegisterElasticIp where
  toHeaders :: RegisterElasticIp -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"OpsWorks_20130218.RegisterElasticIp" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON RegisterElasticIp where
  toJSON :: RegisterElasticIp -> Value
toJSON RegisterElasticIp' {Text
stackId :: Text
elasticIp :: Text
$sel:stackId:RegisterElasticIp' :: RegisterElasticIp -> Text
$sel:elasticIp:RegisterElasticIp' :: RegisterElasticIp -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ElasticIp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
elasticIp),
            forall a. a -> Maybe a
Prelude.Just (Key
"StackId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stackId)
          ]
      )

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

instance Data.ToQuery RegisterElasticIp where
  toQuery :: RegisterElasticIp -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | Contains the response to a @RegisterElasticIp@ request.
--
-- /See:/ 'newRegisterElasticIpResponse' smart constructor.
data RegisterElasticIpResponse = RegisterElasticIpResponse'
  { -- | The Elastic IP address.
    RegisterElasticIpResponse -> Maybe Text
elasticIp :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RegisterElasticIpResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RegisterElasticIpResponse -> RegisterElasticIpResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterElasticIpResponse -> RegisterElasticIpResponse -> Bool
$c/= :: RegisterElasticIpResponse -> RegisterElasticIpResponse -> Bool
== :: RegisterElasticIpResponse -> RegisterElasticIpResponse -> Bool
$c== :: RegisterElasticIpResponse -> RegisterElasticIpResponse -> Bool
Prelude.Eq, ReadPrec [RegisterElasticIpResponse]
ReadPrec RegisterElasticIpResponse
Int -> ReadS RegisterElasticIpResponse
ReadS [RegisterElasticIpResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterElasticIpResponse]
$creadListPrec :: ReadPrec [RegisterElasticIpResponse]
readPrec :: ReadPrec RegisterElasticIpResponse
$creadPrec :: ReadPrec RegisterElasticIpResponse
readList :: ReadS [RegisterElasticIpResponse]
$creadList :: ReadS [RegisterElasticIpResponse]
readsPrec :: Int -> ReadS RegisterElasticIpResponse
$creadsPrec :: Int -> ReadS RegisterElasticIpResponse
Prelude.Read, Int -> RegisterElasticIpResponse -> ShowS
[RegisterElasticIpResponse] -> ShowS
RegisterElasticIpResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterElasticIpResponse] -> ShowS
$cshowList :: [RegisterElasticIpResponse] -> ShowS
show :: RegisterElasticIpResponse -> String
$cshow :: RegisterElasticIpResponse -> String
showsPrec :: Int -> RegisterElasticIpResponse -> ShowS
$cshowsPrec :: Int -> RegisterElasticIpResponse -> ShowS
Prelude.Show, forall x.
Rep RegisterElasticIpResponse x -> RegisterElasticIpResponse
forall x.
RegisterElasticIpResponse -> Rep RegisterElasticIpResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterElasticIpResponse x -> RegisterElasticIpResponse
$cfrom :: forall x.
RegisterElasticIpResponse -> Rep RegisterElasticIpResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterElasticIpResponse' 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:
--
-- 'elasticIp', 'registerElasticIpResponse_elasticIp' - The Elastic IP address.
--
-- 'httpStatus', 'registerElasticIpResponse_httpStatus' - The response's http status code.
newRegisterElasticIpResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterElasticIpResponse
newRegisterElasticIpResponse :: Int -> RegisterElasticIpResponse
newRegisterElasticIpResponse Int
pHttpStatus_ =
  RegisterElasticIpResponse'
    { $sel:elasticIp:RegisterElasticIpResponse' :: Maybe Text
elasticIp =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RegisterElasticIpResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Elastic IP address.
registerElasticIpResponse_elasticIp :: Lens.Lens' RegisterElasticIpResponse (Prelude.Maybe Prelude.Text)
registerElasticIpResponse_elasticIp :: Lens' RegisterElasticIpResponse (Maybe Text)
registerElasticIpResponse_elasticIp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterElasticIpResponse' {Maybe Text
elasticIp :: Maybe Text
$sel:elasticIp:RegisterElasticIpResponse' :: RegisterElasticIpResponse -> Maybe Text
elasticIp} -> Maybe Text
elasticIp) (\s :: RegisterElasticIpResponse
s@RegisterElasticIpResponse' {} Maybe Text
a -> RegisterElasticIpResponse
s {$sel:elasticIp:RegisterElasticIpResponse' :: Maybe Text
elasticIp = Maybe Text
a} :: RegisterElasticIpResponse)

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

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