{-# 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.DirectoryService.AddIpRoutes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- If the DNS server for your self-managed domain uses a publicly
-- addressable IP address, you must add a CIDR address block to correctly
-- route traffic to and from your Microsoft AD on Amazon Web Services.
-- /AddIpRoutes/ adds this address block. You can also use /AddIpRoutes/ to
-- facilitate routing traffic that uses public IP ranges from your
-- Microsoft AD on Amazon Web Services to a peer VPC.
--
-- Before you call /AddIpRoutes/, ensure that all of the required
-- permissions have been explicitly granted through a policy. For details
-- about what permissions are required to run the /AddIpRoutes/ operation,
-- see
-- <http://docs.aws.amazon.com/directoryservice/latest/admin-guide/UsingWithDS_IAM_ResourcePermissions.html Directory Service API Permissions: Actions, Resources, and Conditions Reference>.
module Amazonka.DirectoryService.AddIpRoutes
  ( -- * Creating a Request
    AddIpRoutes (..),
    newAddIpRoutes,

    -- * Request Lenses
    addIpRoutes_updateSecurityGroupForDirectoryControllers,
    addIpRoutes_directoryId,
    addIpRoutes_ipRoutes,

    -- * Destructuring the Response
    AddIpRoutesResponse (..),
    newAddIpRoutesResponse,

    -- * Response Lenses
    addIpRoutesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newAddIpRoutes' smart constructor.
data AddIpRoutes = AddIpRoutes'
  { -- | If set to true, updates the inbound and outbound rules of the security
    -- group that has the description: \"Amazon Web Services created security
    -- group for /directory ID/ directory controllers.\" Following are the new
    -- rules:
    --
    -- Inbound:
    --
    -- -   Type: Custom UDP Rule, Protocol: UDP, Range: 88, Source: 0.0.0.0\/0
    --
    -- -   Type: Custom UDP Rule, Protocol: UDP, Range: 123, Source: 0.0.0.0\/0
    --
    -- -   Type: Custom UDP Rule, Protocol: UDP, Range: 138, Source: 0.0.0.0\/0
    --
    -- -   Type: Custom UDP Rule, Protocol: UDP, Range: 389, Source: 0.0.0.0\/0
    --
    -- -   Type: Custom UDP Rule, Protocol: UDP, Range: 464, Source: 0.0.0.0\/0
    --
    -- -   Type: Custom UDP Rule, Protocol: UDP, Range: 445, Source: 0.0.0.0\/0
    --
    -- -   Type: Custom TCP Rule, Protocol: TCP, Range: 88, Source: 0.0.0.0\/0
    --
    -- -   Type: Custom TCP Rule, Protocol: TCP, Range: 135, Source: 0.0.0.0\/0
    --
    -- -   Type: Custom TCP Rule, Protocol: TCP, Range: 445, Source: 0.0.0.0\/0
    --
    -- -   Type: Custom TCP Rule, Protocol: TCP, Range: 464, Source: 0.0.0.0\/0
    --
    -- -   Type: Custom TCP Rule, Protocol: TCP, Range: 636, Source: 0.0.0.0\/0
    --
    -- -   Type: Custom TCP Rule, Protocol: TCP, Range: 1024-65535, Source:
    --     0.0.0.0\/0
    --
    -- -   Type: Custom TCP Rule, Protocol: TCP, Range: 3268-33269, Source:
    --     0.0.0.0\/0
    --
    -- -   Type: DNS (UDP), Protocol: UDP, Range: 53, Source: 0.0.0.0\/0
    --
    -- -   Type: DNS (TCP), Protocol: TCP, Range: 53, Source: 0.0.0.0\/0
    --
    -- -   Type: LDAP, Protocol: TCP, Range: 389, Source: 0.0.0.0\/0
    --
    -- -   Type: All ICMP, Protocol: All, Range: N\/A, Source: 0.0.0.0\/0
    --
    -- Outbound:
    --
    -- -   Type: All traffic, Protocol: All, Range: All, Destination:
    --     0.0.0.0\/0
    --
    -- These security rules impact an internal network interface that is not
    -- exposed publicly.
    AddIpRoutes -> Maybe Bool
updateSecurityGroupForDirectoryControllers :: Prelude.Maybe Prelude.Bool,
    -- | Identifier (ID) of the directory to which to add the address block.
    AddIpRoutes -> Text
directoryId :: Prelude.Text,
    -- | IP address blocks, using CIDR format, of the traffic to route. This is
    -- often the IP address block of the DNS server used for your self-managed
    -- domain.
    AddIpRoutes -> [IpRoute]
ipRoutes :: [IpRoute]
  }
  deriving (AddIpRoutes -> AddIpRoutes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddIpRoutes -> AddIpRoutes -> Bool
$c/= :: AddIpRoutes -> AddIpRoutes -> Bool
== :: AddIpRoutes -> AddIpRoutes -> Bool
$c== :: AddIpRoutes -> AddIpRoutes -> Bool
Prelude.Eq, ReadPrec [AddIpRoutes]
ReadPrec AddIpRoutes
Int -> ReadS AddIpRoutes
ReadS [AddIpRoutes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddIpRoutes]
$creadListPrec :: ReadPrec [AddIpRoutes]
readPrec :: ReadPrec AddIpRoutes
$creadPrec :: ReadPrec AddIpRoutes
readList :: ReadS [AddIpRoutes]
$creadList :: ReadS [AddIpRoutes]
readsPrec :: Int -> ReadS AddIpRoutes
$creadsPrec :: Int -> ReadS AddIpRoutes
Prelude.Read, Int -> AddIpRoutes -> ShowS
[AddIpRoutes] -> ShowS
AddIpRoutes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddIpRoutes] -> ShowS
$cshowList :: [AddIpRoutes] -> ShowS
show :: AddIpRoutes -> String
$cshow :: AddIpRoutes -> String
showsPrec :: Int -> AddIpRoutes -> ShowS
$cshowsPrec :: Int -> AddIpRoutes -> ShowS
Prelude.Show, forall x. Rep AddIpRoutes x -> AddIpRoutes
forall x. AddIpRoutes -> Rep AddIpRoutes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddIpRoutes x -> AddIpRoutes
$cfrom :: forall x. AddIpRoutes -> Rep AddIpRoutes x
Prelude.Generic)

-- |
-- Create a value of 'AddIpRoutes' 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:
--
-- 'updateSecurityGroupForDirectoryControllers', 'addIpRoutes_updateSecurityGroupForDirectoryControllers' - If set to true, updates the inbound and outbound rules of the security
-- group that has the description: \"Amazon Web Services created security
-- group for /directory ID/ directory controllers.\" Following are the new
-- rules:
--
-- Inbound:
--
-- -   Type: Custom UDP Rule, Protocol: UDP, Range: 88, Source: 0.0.0.0\/0
--
-- -   Type: Custom UDP Rule, Protocol: UDP, Range: 123, Source: 0.0.0.0\/0
--
-- -   Type: Custom UDP Rule, Protocol: UDP, Range: 138, Source: 0.0.0.0\/0
--
-- -   Type: Custom UDP Rule, Protocol: UDP, Range: 389, Source: 0.0.0.0\/0
--
-- -   Type: Custom UDP Rule, Protocol: UDP, Range: 464, Source: 0.0.0.0\/0
--
-- -   Type: Custom UDP Rule, Protocol: UDP, Range: 445, Source: 0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 88, Source: 0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 135, Source: 0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 445, Source: 0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 464, Source: 0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 636, Source: 0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 1024-65535, Source:
--     0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 3268-33269, Source:
--     0.0.0.0\/0
--
-- -   Type: DNS (UDP), Protocol: UDP, Range: 53, Source: 0.0.0.0\/0
--
-- -   Type: DNS (TCP), Protocol: TCP, Range: 53, Source: 0.0.0.0\/0
--
-- -   Type: LDAP, Protocol: TCP, Range: 389, Source: 0.0.0.0\/0
--
-- -   Type: All ICMP, Protocol: All, Range: N\/A, Source: 0.0.0.0\/0
--
-- Outbound:
--
-- -   Type: All traffic, Protocol: All, Range: All, Destination:
--     0.0.0.0\/0
--
-- These security rules impact an internal network interface that is not
-- exposed publicly.
--
-- 'directoryId', 'addIpRoutes_directoryId' - Identifier (ID) of the directory to which to add the address block.
--
-- 'ipRoutes', 'addIpRoutes_ipRoutes' - IP address blocks, using CIDR format, of the traffic to route. This is
-- often the IP address block of the DNS server used for your self-managed
-- domain.
newAddIpRoutes ::
  -- | 'directoryId'
  Prelude.Text ->
  AddIpRoutes
newAddIpRoutes :: Text -> AddIpRoutes
newAddIpRoutes Text
pDirectoryId_ =
  AddIpRoutes'
    { $sel:updateSecurityGroupForDirectoryControllers:AddIpRoutes' :: Maybe Bool
updateSecurityGroupForDirectoryControllers =
        forall a. Maybe a
Prelude.Nothing,
      $sel:directoryId:AddIpRoutes' :: Text
directoryId = Text
pDirectoryId_,
      $sel:ipRoutes:AddIpRoutes' :: [IpRoute]
ipRoutes = forall a. Monoid a => a
Prelude.mempty
    }

-- | If set to true, updates the inbound and outbound rules of the security
-- group that has the description: \"Amazon Web Services created security
-- group for /directory ID/ directory controllers.\" Following are the new
-- rules:
--
-- Inbound:
--
-- -   Type: Custom UDP Rule, Protocol: UDP, Range: 88, Source: 0.0.0.0\/0
--
-- -   Type: Custom UDP Rule, Protocol: UDP, Range: 123, Source: 0.0.0.0\/0
--
-- -   Type: Custom UDP Rule, Protocol: UDP, Range: 138, Source: 0.0.0.0\/0
--
-- -   Type: Custom UDP Rule, Protocol: UDP, Range: 389, Source: 0.0.0.0\/0
--
-- -   Type: Custom UDP Rule, Protocol: UDP, Range: 464, Source: 0.0.0.0\/0
--
-- -   Type: Custom UDP Rule, Protocol: UDP, Range: 445, Source: 0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 88, Source: 0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 135, Source: 0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 445, Source: 0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 464, Source: 0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 636, Source: 0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 1024-65535, Source:
--     0.0.0.0\/0
--
-- -   Type: Custom TCP Rule, Protocol: TCP, Range: 3268-33269, Source:
--     0.0.0.0\/0
--
-- -   Type: DNS (UDP), Protocol: UDP, Range: 53, Source: 0.0.0.0\/0
--
-- -   Type: DNS (TCP), Protocol: TCP, Range: 53, Source: 0.0.0.0\/0
--
-- -   Type: LDAP, Protocol: TCP, Range: 389, Source: 0.0.0.0\/0
--
-- -   Type: All ICMP, Protocol: All, Range: N\/A, Source: 0.0.0.0\/0
--
-- Outbound:
--
-- -   Type: All traffic, Protocol: All, Range: All, Destination:
--     0.0.0.0\/0
--
-- These security rules impact an internal network interface that is not
-- exposed publicly.
addIpRoutes_updateSecurityGroupForDirectoryControllers :: Lens.Lens' AddIpRoutes (Prelude.Maybe Prelude.Bool)
addIpRoutes_updateSecurityGroupForDirectoryControllers :: Lens' AddIpRoutes (Maybe Bool)
addIpRoutes_updateSecurityGroupForDirectoryControllers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddIpRoutes' {Maybe Bool
updateSecurityGroupForDirectoryControllers :: Maybe Bool
$sel:updateSecurityGroupForDirectoryControllers:AddIpRoutes' :: AddIpRoutes -> Maybe Bool
updateSecurityGroupForDirectoryControllers} -> Maybe Bool
updateSecurityGroupForDirectoryControllers) (\s :: AddIpRoutes
s@AddIpRoutes' {} Maybe Bool
a -> AddIpRoutes
s {$sel:updateSecurityGroupForDirectoryControllers:AddIpRoutes' :: Maybe Bool
updateSecurityGroupForDirectoryControllers = Maybe Bool
a} :: AddIpRoutes)

-- | Identifier (ID) of the directory to which to add the address block.
addIpRoutes_directoryId :: Lens.Lens' AddIpRoutes Prelude.Text
addIpRoutes_directoryId :: Lens' AddIpRoutes Text
addIpRoutes_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddIpRoutes' {Text
directoryId :: Text
$sel:directoryId:AddIpRoutes' :: AddIpRoutes -> Text
directoryId} -> Text
directoryId) (\s :: AddIpRoutes
s@AddIpRoutes' {} Text
a -> AddIpRoutes
s {$sel:directoryId:AddIpRoutes' :: Text
directoryId = Text
a} :: AddIpRoutes)

-- | IP address blocks, using CIDR format, of the traffic to route. This is
-- often the IP address block of the DNS server used for your self-managed
-- domain.
addIpRoutes_ipRoutes :: Lens.Lens' AddIpRoutes [IpRoute]
addIpRoutes_ipRoutes :: Lens' AddIpRoutes [IpRoute]
addIpRoutes_ipRoutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddIpRoutes' {[IpRoute]
ipRoutes :: [IpRoute]
$sel:ipRoutes:AddIpRoutes' :: AddIpRoutes -> [IpRoute]
ipRoutes} -> [IpRoute]
ipRoutes) (\s :: AddIpRoutes
s@AddIpRoutes' {} [IpRoute]
a -> AddIpRoutes
s {$sel:ipRoutes:AddIpRoutes' :: [IpRoute]
ipRoutes = [IpRoute]
a} :: AddIpRoutes) 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 AddIpRoutes where
  type AWSResponse AddIpRoutes = AddIpRoutesResponse
  request :: (Service -> Service) -> AddIpRoutes -> Request AddIpRoutes
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 AddIpRoutes
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AddIpRoutes)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AddIpRoutesResponse
AddIpRoutesResponse'
            forall (f :: * -> *) a b. Functor 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 AddIpRoutes where
  hashWithSalt :: Int -> AddIpRoutes -> Int
hashWithSalt Int
_salt AddIpRoutes' {[IpRoute]
Maybe Bool
Text
ipRoutes :: [IpRoute]
directoryId :: Text
updateSecurityGroupForDirectoryControllers :: Maybe Bool
$sel:ipRoutes:AddIpRoutes' :: AddIpRoutes -> [IpRoute]
$sel:directoryId:AddIpRoutes' :: AddIpRoutes -> Text
$sel:updateSecurityGroupForDirectoryControllers:AddIpRoutes' :: AddIpRoutes -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
updateSecurityGroupForDirectoryControllers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [IpRoute]
ipRoutes

instance Prelude.NFData AddIpRoutes where
  rnf :: AddIpRoutes -> ()
rnf AddIpRoutes' {[IpRoute]
Maybe Bool
Text
ipRoutes :: [IpRoute]
directoryId :: Text
updateSecurityGroupForDirectoryControllers :: Maybe Bool
$sel:ipRoutes:AddIpRoutes' :: AddIpRoutes -> [IpRoute]
$sel:directoryId:AddIpRoutes' :: AddIpRoutes -> Text
$sel:updateSecurityGroupForDirectoryControllers:AddIpRoutes' :: AddIpRoutes -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf
      Maybe Bool
updateSecurityGroupForDirectoryControllers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
directoryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [IpRoute]
ipRoutes

instance Data.ToHeaders AddIpRoutes where
  toHeaders :: AddIpRoutes -> 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
"DirectoryService_20150416.AddIpRoutes" ::
                          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 AddIpRoutes where
  toJSON :: AddIpRoutes -> Value
toJSON AddIpRoutes' {[IpRoute]
Maybe Bool
Text
ipRoutes :: [IpRoute]
directoryId :: Text
updateSecurityGroupForDirectoryControllers :: Maybe Bool
$sel:ipRoutes:AddIpRoutes' :: AddIpRoutes -> [IpRoute]
$sel:directoryId:AddIpRoutes' :: AddIpRoutes -> Text
$sel:updateSecurityGroupForDirectoryControllers:AddIpRoutes' :: AddIpRoutes -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ ( Key
"UpdateSecurityGroupForDirectoryControllers"
                forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=
            )
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
updateSecurityGroupForDirectoryControllers,
            forall a. a -> Maybe a
Prelude.Just (Key
"DirectoryId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
directoryId),
            forall a. a -> Maybe a
Prelude.Just (Key
"IpRoutes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [IpRoute]
ipRoutes)
          ]
      )

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

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

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

-- |
-- Create a value of 'AddIpRoutesResponse' 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:
--
-- 'httpStatus', 'addIpRoutesResponse_httpStatus' - The response's http status code.
newAddIpRoutesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddIpRoutesResponse
newAddIpRoutesResponse :: Int -> AddIpRoutesResponse
newAddIpRoutesResponse Int
pHttpStatus_ =
  AddIpRoutesResponse' {$sel:httpStatus:AddIpRoutesResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData AddIpRoutesResponse where
  rnf :: AddIpRoutesResponse -> ()
rnf AddIpRoutesResponse' {Int
httpStatus :: Int
$sel:httpStatus:AddIpRoutesResponse' :: AddIpRoutesResponse -> Int
..} = forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus