{-# 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.SetIpAddressType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the IP address type for an Amazon Lightsail resource.
--
-- Use this action to enable dual-stack for a resource, which enables IPv4
-- and IPv6 for the specified resource. Alternately, you can use this
-- action to disable dual-stack, and enable IPv4 only.
module Amazonka.Lightsail.SetIpAddressType
  ( -- * Creating a Request
    SetIpAddressType (..),
    newSetIpAddressType,

    -- * Request Lenses
    setIpAddressType_resourceType,
    setIpAddressType_resourceName,
    setIpAddressType_ipAddressType,

    -- * Destructuring the Response
    SetIpAddressTypeResponse (..),
    newSetIpAddressTypeResponse,

    -- * Response Lenses
    setIpAddressTypeResponse_operations,
    setIpAddressTypeResponse_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:/ 'newSetIpAddressType' smart constructor.
data SetIpAddressType = SetIpAddressType'
  { -- | The resource type.
    --
    -- The possible values are @Distribution@, @Instance@, and @LoadBalancer@.
    --
    -- Distribution-related APIs are available only in the N. Virginia
    -- (@us-east-1@) Amazon Web Services Region. Set your Amazon Web Services
    -- Region configuration to @us-east-1@ to create, view, or edit
    -- distributions.
    SetIpAddressType -> ResourceType
resourceType :: ResourceType,
    -- | The name of the resource for which to set the IP address type.
    SetIpAddressType -> Text
resourceName :: Prelude.Text,
    -- | The IP address type to set for the specified resource.
    --
    -- The possible values are @ipv4@ for IPv4 only, and @dualstack@ for IPv4
    -- and IPv6.
    SetIpAddressType -> IpAddressType
ipAddressType :: IpAddressType
  }
  deriving (SetIpAddressType -> SetIpAddressType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetIpAddressType -> SetIpAddressType -> Bool
$c/= :: SetIpAddressType -> SetIpAddressType -> Bool
== :: SetIpAddressType -> SetIpAddressType -> Bool
$c== :: SetIpAddressType -> SetIpAddressType -> Bool
Prelude.Eq, ReadPrec [SetIpAddressType]
ReadPrec SetIpAddressType
Int -> ReadS SetIpAddressType
ReadS [SetIpAddressType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetIpAddressType]
$creadListPrec :: ReadPrec [SetIpAddressType]
readPrec :: ReadPrec SetIpAddressType
$creadPrec :: ReadPrec SetIpAddressType
readList :: ReadS [SetIpAddressType]
$creadList :: ReadS [SetIpAddressType]
readsPrec :: Int -> ReadS SetIpAddressType
$creadsPrec :: Int -> ReadS SetIpAddressType
Prelude.Read, Int -> SetIpAddressType -> ShowS
[SetIpAddressType] -> ShowS
SetIpAddressType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetIpAddressType] -> ShowS
$cshowList :: [SetIpAddressType] -> ShowS
show :: SetIpAddressType -> String
$cshow :: SetIpAddressType -> String
showsPrec :: Int -> SetIpAddressType -> ShowS
$cshowsPrec :: Int -> SetIpAddressType -> ShowS
Prelude.Show, forall x. Rep SetIpAddressType x -> SetIpAddressType
forall x. SetIpAddressType -> Rep SetIpAddressType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetIpAddressType x -> SetIpAddressType
$cfrom :: forall x. SetIpAddressType -> Rep SetIpAddressType x
Prelude.Generic)

-- |
-- Create a value of 'SetIpAddressType' 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:
--
-- 'resourceType', 'setIpAddressType_resourceType' - The resource type.
--
-- The possible values are @Distribution@, @Instance@, and @LoadBalancer@.
--
-- Distribution-related APIs are available only in the N. Virginia
-- (@us-east-1@) Amazon Web Services Region. Set your Amazon Web Services
-- Region configuration to @us-east-1@ to create, view, or edit
-- distributions.
--
-- 'resourceName', 'setIpAddressType_resourceName' - The name of the resource for which to set the IP address type.
--
-- 'ipAddressType', 'setIpAddressType_ipAddressType' - The IP address type to set for the specified resource.
--
-- The possible values are @ipv4@ for IPv4 only, and @dualstack@ for IPv4
-- and IPv6.
newSetIpAddressType ::
  -- | 'resourceType'
  ResourceType ->
  -- | 'resourceName'
  Prelude.Text ->
  -- | 'ipAddressType'
  IpAddressType ->
  SetIpAddressType
newSetIpAddressType :: ResourceType -> Text -> IpAddressType -> SetIpAddressType
newSetIpAddressType
  ResourceType
pResourceType_
  Text
pResourceName_
  IpAddressType
pIpAddressType_ =
    SetIpAddressType'
      { $sel:resourceType:SetIpAddressType' :: ResourceType
resourceType = ResourceType
pResourceType_,
        $sel:resourceName:SetIpAddressType' :: Text
resourceName = Text
pResourceName_,
        $sel:ipAddressType:SetIpAddressType' :: IpAddressType
ipAddressType = IpAddressType
pIpAddressType_
      }

-- | The resource type.
--
-- The possible values are @Distribution@, @Instance@, and @LoadBalancer@.
--
-- Distribution-related APIs are available only in the N. Virginia
-- (@us-east-1@) Amazon Web Services Region. Set your Amazon Web Services
-- Region configuration to @us-east-1@ to create, view, or edit
-- distributions.
setIpAddressType_resourceType :: Lens.Lens' SetIpAddressType ResourceType
setIpAddressType_resourceType :: Lens' SetIpAddressType ResourceType
setIpAddressType_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIpAddressType' {ResourceType
resourceType :: ResourceType
$sel:resourceType:SetIpAddressType' :: SetIpAddressType -> ResourceType
resourceType} -> ResourceType
resourceType) (\s :: SetIpAddressType
s@SetIpAddressType' {} ResourceType
a -> SetIpAddressType
s {$sel:resourceType:SetIpAddressType' :: ResourceType
resourceType = ResourceType
a} :: SetIpAddressType)

-- | The name of the resource for which to set the IP address type.
setIpAddressType_resourceName :: Lens.Lens' SetIpAddressType Prelude.Text
setIpAddressType_resourceName :: Lens' SetIpAddressType Text
setIpAddressType_resourceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIpAddressType' {Text
resourceName :: Text
$sel:resourceName:SetIpAddressType' :: SetIpAddressType -> Text
resourceName} -> Text
resourceName) (\s :: SetIpAddressType
s@SetIpAddressType' {} Text
a -> SetIpAddressType
s {$sel:resourceName:SetIpAddressType' :: Text
resourceName = Text
a} :: SetIpAddressType)

-- | The IP address type to set for the specified resource.
--
-- The possible values are @ipv4@ for IPv4 only, and @dualstack@ for IPv4
-- and IPv6.
setIpAddressType_ipAddressType :: Lens.Lens' SetIpAddressType IpAddressType
setIpAddressType_ipAddressType :: Lens' SetIpAddressType IpAddressType
setIpAddressType_ipAddressType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIpAddressType' {IpAddressType
ipAddressType :: IpAddressType
$sel:ipAddressType:SetIpAddressType' :: SetIpAddressType -> IpAddressType
ipAddressType} -> IpAddressType
ipAddressType) (\s :: SetIpAddressType
s@SetIpAddressType' {} IpAddressType
a -> SetIpAddressType
s {$sel:ipAddressType:SetIpAddressType' :: IpAddressType
ipAddressType = IpAddressType
a} :: SetIpAddressType)

instance Core.AWSRequest SetIpAddressType where
  type
    AWSResponse SetIpAddressType =
      SetIpAddressTypeResponse
  request :: (Service -> Service)
-> SetIpAddressType -> Request SetIpAddressType
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 SetIpAddressType
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SetIpAddressType)))
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 -> SetIpAddressTypeResponse
SetIpAddressTypeResponse'
            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 SetIpAddressType where
  hashWithSalt :: Int -> SetIpAddressType -> Int
hashWithSalt Int
_salt SetIpAddressType' {Text
IpAddressType
ResourceType
ipAddressType :: IpAddressType
resourceName :: Text
resourceType :: ResourceType
$sel:ipAddressType:SetIpAddressType' :: SetIpAddressType -> IpAddressType
$sel:resourceName:SetIpAddressType' :: SetIpAddressType -> Text
$sel:resourceType:SetIpAddressType' :: SetIpAddressType -> ResourceType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceType
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` IpAddressType
ipAddressType

instance Prelude.NFData SetIpAddressType where
  rnf :: SetIpAddressType -> ()
rnf SetIpAddressType' {Text
IpAddressType
ResourceType
ipAddressType :: IpAddressType
resourceName :: Text
resourceType :: ResourceType
$sel:ipAddressType:SetIpAddressType' :: SetIpAddressType -> IpAddressType
$sel:resourceName:SetIpAddressType' :: SetIpAddressType -> Text
$sel:resourceType:SetIpAddressType' :: SetIpAddressType -> ResourceType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf ResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf IpAddressType
ipAddressType

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

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

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

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

-- |
-- Create a value of 'SetIpAddressTypeResponse' 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', 'setIpAddressTypeResponse_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', 'setIpAddressTypeResponse_httpStatus' - The response's http status code.
newSetIpAddressTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SetIpAddressTypeResponse
newSetIpAddressTypeResponse :: Int -> SetIpAddressTypeResponse
newSetIpAddressTypeResponse Int
pHttpStatus_ =
  SetIpAddressTypeResponse'
    { $sel:operations:SetIpAddressTypeResponse' :: Maybe [Operation]
operations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SetIpAddressTypeResponse' :: 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.
setIpAddressTypeResponse_operations :: Lens.Lens' SetIpAddressTypeResponse (Prelude.Maybe [Operation])
setIpAddressTypeResponse_operations :: Lens' SetIpAddressTypeResponse (Maybe [Operation])
setIpAddressTypeResponse_operations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIpAddressTypeResponse' {Maybe [Operation]
operations :: Maybe [Operation]
$sel:operations:SetIpAddressTypeResponse' :: SetIpAddressTypeResponse -> Maybe [Operation]
operations} -> Maybe [Operation]
operations) (\s :: SetIpAddressTypeResponse
s@SetIpAddressTypeResponse' {} Maybe [Operation]
a -> SetIpAddressTypeResponse
s {$sel:operations:SetIpAddressTypeResponse' :: Maybe [Operation]
operations = Maybe [Operation]
a} :: SetIpAddressTypeResponse) 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.
setIpAddressTypeResponse_httpStatus :: Lens.Lens' SetIpAddressTypeResponse Prelude.Int
setIpAddressTypeResponse_httpStatus :: Lens' SetIpAddressTypeResponse Int
setIpAddressTypeResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIpAddressTypeResponse' {Int
httpStatus :: Int
$sel:httpStatus:SetIpAddressTypeResponse' :: SetIpAddressTypeResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: SetIpAddressTypeResponse
s@SetIpAddressTypeResponse' {} Int
a -> SetIpAddressTypeResponse
s {$sel:httpStatus:SetIpAddressTypeResponse' :: Int
httpStatus = Int
a} :: SetIpAddressTypeResponse)

instance Prelude.NFData SetIpAddressTypeResponse where
  rnf :: SetIpAddressTypeResponse -> ()
rnf SetIpAddressTypeResponse' {Int
Maybe [Operation]
httpStatus :: Int
operations :: Maybe [Operation]
$sel:httpStatus:SetIpAddressTypeResponse' :: SetIpAddressTypeResponse -> Int
$sel:operations:SetIpAddressTypeResponse' :: SetIpAddressTypeResponse -> 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