{-# 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.Lightsail.AllocateStaticIp
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Allocates a static IP address.
module Amazonka.Lightsail.AllocateStaticIp
  ( -- * Creating a Request
    AllocateStaticIp (..),
    newAllocateStaticIp,

    -- * Request Lenses
    allocateStaticIp_staticIpName,

    -- * Destructuring the Response
    AllocateStaticIpResponse (..),
    newAllocateStaticIpResponse,

    -- * Response Lenses
    allocateStaticIpResponse_operations,
    allocateStaticIpResponse_httpStatus,
  )
where

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

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

-- |
-- Create a value of 'AllocateStaticIp' 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:
--
-- 'staticIpName', 'allocateStaticIp_staticIpName' - The name of the static IP address.
newAllocateStaticIp ::
  -- | 'staticIpName'
  Prelude.Text ->
  AllocateStaticIp
newAllocateStaticIp :: Text -> AllocateStaticIp
newAllocateStaticIp Text
pStaticIpName_ =
  AllocateStaticIp' {$sel:staticIpName:AllocateStaticIp' :: Text
staticIpName = Text
pStaticIpName_}

-- | The name of the static IP address.
allocateStaticIp_staticIpName :: Lens.Lens' AllocateStaticIp Prelude.Text
allocateStaticIp_staticIpName :: Lens' AllocateStaticIp Text
allocateStaticIp_staticIpName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateStaticIp' {Text
staticIpName :: Text
$sel:staticIpName:AllocateStaticIp' :: AllocateStaticIp -> Text
staticIpName} -> Text
staticIpName) (\s :: AllocateStaticIp
s@AllocateStaticIp' {} Text
a -> AllocateStaticIp
s {$sel:staticIpName:AllocateStaticIp' :: Text
staticIpName = Text
a} :: AllocateStaticIp)

instance Core.AWSRequest AllocateStaticIp where
  type
    AWSResponse AllocateStaticIp =
      AllocateStaticIpResponse
  request :: (Service -> Service)
-> AllocateStaticIp -> Request AllocateStaticIp
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 AllocateStaticIp
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AllocateStaticIp)))
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 [Operation] -> Int -> AllocateStaticIpResponse
AllocateStaticIpResponse'
            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
"operations" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 AllocateStaticIp where
  hashWithSalt :: Int -> AllocateStaticIp -> Int
hashWithSalt Int
_salt AllocateStaticIp' {Text
staticIpName :: Text
$sel:staticIpName:AllocateStaticIp' :: AllocateStaticIp -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
staticIpName

instance Prelude.NFData AllocateStaticIp where
  rnf :: AllocateStaticIp -> ()
rnf AllocateStaticIp' {Text
staticIpName :: Text
$sel:staticIpName:AllocateStaticIp' :: AllocateStaticIp -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
staticIpName

instance Data.ToHeaders AllocateStaticIp where
  toHeaders :: AllocateStaticIp -> 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
"Lightsail_20161128.AllocateStaticIp" ::
                          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 AllocateStaticIp where
  toJSON :: AllocateStaticIp -> Value
toJSON AllocateStaticIp' {Text
staticIpName :: Text
$sel:staticIpName:AllocateStaticIp' :: AllocateStaticIp -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"staticIpName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
staticIpName)]
      )

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

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

-- | /See:/ 'newAllocateStaticIpResponse' smart constructor.
data AllocateStaticIpResponse = AllocateStaticIpResponse'
  { -- | An array of objects that describe the result of the action, such as the
    -- status of the request, the timestamp of the request, and the resources
    -- affected by the request.
    AllocateStaticIpResponse -> Maybe [Operation]
operations :: Prelude.Maybe [Operation],
    -- | The response's http status code.
    AllocateStaticIpResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AllocateStaticIpResponse -> AllocateStaticIpResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllocateStaticIpResponse -> AllocateStaticIpResponse -> Bool
$c/= :: AllocateStaticIpResponse -> AllocateStaticIpResponse -> Bool
== :: AllocateStaticIpResponse -> AllocateStaticIpResponse -> Bool
$c== :: AllocateStaticIpResponse -> AllocateStaticIpResponse -> Bool
Prelude.Eq, ReadPrec [AllocateStaticIpResponse]
ReadPrec AllocateStaticIpResponse
Int -> ReadS AllocateStaticIpResponse
ReadS [AllocateStaticIpResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AllocateStaticIpResponse]
$creadListPrec :: ReadPrec [AllocateStaticIpResponse]
readPrec :: ReadPrec AllocateStaticIpResponse
$creadPrec :: ReadPrec AllocateStaticIpResponse
readList :: ReadS [AllocateStaticIpResponse]
$creadList :: ReadS [AllocateStaticIpResponse]
readsPrec :: Int -> ReadS AllocateStaticIpResponse
$creadsPrec :: Int -> ReadS AllocateStaticIpResponse
Prelude.Read, Int -> AllocateStaticIpResponse -> ShowS
[AllocateStaticIpResponse] -> ShowS
AllocateStaticIpResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllocateStaticIpResponse] -> ShowS
$cshowList :: [AllocateStaticIpResponse] -> ShowS
show :: AllocateStaticIpResponse -> String
$cshow :: AllocateStaticIpResponse -> String
showsPrec :: Int -> AllocateStaticIpResponse -> ShowS
$cshowsPrec :: Int -> AllocateStaticIpResponse -> ShowS
Prelude.Show, forall x.
Rep AllocateStaticIpResponse x -> AllocateStaticIpResponse
forall x.
AllocateStaticIpResponse -> Rep AllocateStaticIpResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AllocateStaticIpResponse x -> AllocateStaticIpResponse
$cfrom :: forall x.
AllocateStaticIpResponse -> Rep AllocateStaticIpResponse x
Prelude.Generic)

-- |
-- Create a value of 'AllocateStaticIpResponse' 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:
--
-- 'operations', 'allocateStaticIpResponse_operations' - An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
--
-- 'httpStatus', 'allocateStaticIpResponse_httpStatus' - The response's http status code.
newAllocateStaticIpResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AllocateStaticIpResponse
newAllocateStaticIpResponse :: Int -> AllocateStaticIpResponse
newAllocateStaticIpResponse Int
pHttpStatus_ =
  AllocateStaticIpResponse'
    { $sel:operations:AllocateStaticIpResponse' :: Maybe [Operation]
operations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AllocateStaticIpResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
allocateStaticIpResponse_operations :: Lens.Lens' AllocateStaticIpResponse (Prelude.Maybe [Operation])
allocateStaticIpResponse_operations :: Lens' AllocateStaticIpResponse (Maybe [Operation])
allocateStaticIpResponse_operations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateStaticIpResponse' {Maybe [Operation]
operations :: Maybe [Operation]
$sel:operations:AllocateStaticIpResponse' :: AllocateStaticIpResponse -> Maybe [Operation]
operations} -> Maybe [Operation]
operations) (\s :: AllocateStaticIpResponse
s@AllocateStaticIpResponse' {} Maybe [Operation]
a -> AllocateStaticIpResponse
s {$sel:operations:AllocateStaticIpResponse' :: Maybe [Operation]
operations = Maybe [Operation]
a} :: AllocateStaticIpResponse) 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.
allocateStaticIpResponse_httpStatus :: Lens.Lens' AllocateStaticIpResponse Prelude.Int
allocateStaticIpResponse_httpStatus :: Lens' AllocateStaticIpResponse Int
allocateStaticIpResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateStaticIpResponse' {Int
httpStatus :: Int
$sel:httpStatus:AllocateStaticIpResponse' :: AllocateStaticIpResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: AllocateStaticIpResponse
s@AllocateStaticIpResponse' {} Int
a -> AllocateStaticIpResponse
s {$sel:httpStatus:AllocateStaticIpResponse' :: Int
httpStatus = Int
a} :: AllocateStaticIpResponse)

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