{-# 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.RemoveIpRoutes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes IP address blocks from a directory.
module Amazonka.DirectoryService.RemoveIpRoutes
  ( -- * Creating a Request
    RemoveIpRoutes (..),
    newRemoveIpRoutes,

    -- * Request Lenses
    removeIpRoutes_directoryId,
    removeIpRoutes_cidrIps,

    -- * Destructuring the Response
    RemoveIpRoutesResponse (..),
    newRemoveIpRoutesResponse,

    -- * Response Lenses
    removeIpRoutesResponse_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:/ 'newRemoveIpRoutes' smart constructor.
data RemoveIpRoutes = RemoveIpRoutes'
  { -- | Identifier (ID) of the directory from which you want to remove the IP
    -- addresses.
    RemoveIpRoutes -> Text
directoryId :: Prelude.Text,
    -- | IP address blocks that you want to remove.
    RemoveIpRoutes -> [Text]
cidrIps :: [Prelude.Text]
  }
  deriving (RemoveIpRoutes -> RemoveIpRoutes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveIpRoutes -> RemoveIpRoutes -> Bool
$c/= :: RemoveIpRoutes -> RemoveIpRoutes -> Bool
== :: RemoveIpRoutes -> RemoveIpRoutes -> Bool
$c== :: RemoveIpRoutes -> RemoveIpRoutes -> Bool
Prelude.Eq, ReadPrec [RemoveIpRoutes]
ReadPrec RemoveIpRoutes
Int -> ReadS RemoveIpRoutes
ReadS [RemoveIpRoutes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoveIpRoutes]
$creadListPrec :: ReadPrec [RemoveIpRoutes]
readPrec :: ReadPrec RemoveIpRoutes
$creadPrec :: ReadPrec RemoveIpRoutes
readList :: ReadS [RemoveIpRoutes]
$creadList :: ReadS [RemoveIpRoutes]
readsPrec :: Int -> ReadS RemoveIpRoutes
$creadsPrec :: Int -> ReadS RemoveIpRoutes
Prelude.Read, Int -> RemoveIpRoutes -> ShowS
[RemoveIpRoutes] -> ShowS
RemoveIpRoutes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveIpRoutes] -> ShowS
$cshowList :: [RemoveIpRoutes] -> ShowS
show :: RemoveIpRoutes -> String
$cshow :: RemoveIpRoutes -> String
showsPrec :: Int -> RemoveIpRoutes -> ShowS
$cshowsPrec :: Int -> RemoveIpRoutes -> ShowS
Prelude.Show, forall x. Rep RemoveIpRoutes x -> RemoveIpRoutes
forall x. RemoveIpRoutes -> Rep RemoveIpRoutes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoveIpRoutes x -> RemoveIpRoutes
$cfrom :: forall x. RemoveIpRoutes -> Rep RemoveIpRoutes x
Prelude.Generic)

-- |
-- Create a value of 'RemoveIpRoutes' 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:
--
-- 'directoryId', 'removeIpRoutes_directoryId' - Identifier (ID) of the directory from which you want to remove the IP
-- addresses.
--
-- 'cidrIps', 'removeIpRoutes_cidrIps' - IP address blocks that you want to remove.
newRemoveIpRoutes ::
  -- | 'directoryId'
  Prelude.Text ->
  RemoveIpRoutes
newRemoveIpRoutes :: Text -> RemoveIpRoutes
newRemoveIpRoutes Text
pDirectoryId_ =
  RemoveIpRoutes'
    { $sel:directoryId:RemoveIpRoutes' :: Text
directoryId = Text
pDirectoryId_,
      $sel:cidrIps:RemoveIpRoutes' :: [Text]
cidrIps = forall a. Monoid a => a
Prelude.mempty
    }

-- | Identifier (ID) of the directory from which you want to remove the IP
-- addresses.
removeIpRoutes_directoryId :: Lens.Lens' RemoveIpRoutes Prelude.Text
removeIpRoutes_directoryId :: Lens' RemoveIpRoutes Text
removeIpRoutes_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveIpRoutes' {Text
directoryId :: Text
$sel:directoryId:RemoveIpRoutes' :: RemoveIpRoutes -> Text
directoryId} -> Text
directoryId) (\s :: RemoveIpRoutes
s@RemoveIpRoutes' {} Text
a -> RemoveIpRoutes
s {$sel:directoryId:RemoveIpRoutes' :: Text
directoryId = Text
a} :: RemoveIpRoutes)

-- | IP address blocks that you want to remove.
removeIpRoutes_cidrIps :: Lens.Lens' RemoveIpRoutes [Prelude.Text]
removeIpRoutes_cidrIps :: Lens' RemoveIpRoutes [Text]
removeIpRoutes_cidrIps = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveIpRoutes' {[Text]
cidrIps :: [Text]
$sel:cidrIps:RemoveIpRoutes' :: RemoveIpRoutes -> [Text]
cidrIps} -> [Text]
cidrIps) (\s :: RemoveIpRoutes
s@RemoveIpRoutes' {} [Text]
a -> RemoveIpRoutes
s {$sel:cidrIps:RemoveIpRoutes' :: [Text]
cidrIps = [Text]
a} :: RemoveIpRoutes) 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 RemoveIpRoutes where
  type
    AWSResponse RemoveIpRoutes =
      RemoveIpRoutesResponse
  request :: (Service -> Service) -> RemoveIpRoutes -> Request RemoveIpRoutes
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 RemoveIpRoutes
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RemoveIpRoutes)))
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 -> RemoveIpRoutesResponse
RemoveIpRoutesResponse'
            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 RemoveIpRoutes where
  hashWithSalt :: Int -> RemoveIpRoutes -> Int
hashWithSalt Int
_salt RemoveIpRoutes' {[Text]
Text
cidrIps :: [Text]
directoryId :: Text
$sel:cidrIps:RemoveIpRoutes' :: RemoveIpRoutes -> [Text]
$sel:directoryId:RemoveIpRoutes' :: RemoveIpRoutes -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
cidrIps

instance Prelude.NFData RemoveIpRoutes where
  rnf :: RemoveIpRoutes -> ()
rnf RemoveIpRoutes' {[Text]
Text
cidrIps :: [Text]
directoryId :: Text
$sel:cidrIps:RemoveIpRoutes' :: RemoveIpRoutes -> [Text]
$sel:directoryId:RemoveIpRoutes' :: RemoveIpRoutes -> Text
..} =
    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 [Text]
cidrIps

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

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

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

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

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

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

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