{-# 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.UpdateConditionalForwarder
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a conditional forwarder that has been set up for your Amazon Web
-- Services directory.
module Amazonka.DirectoryService.UpdateConditionalForwarder
  ( -- * Creating a Request
    UpdateConditionalForwarder (..),
    newUpdateConditionalForwarder,

    -- * Request Lenses
    updateConditionalForwarder_directoryId,
    updateConditionalForwarder_remoteDomainName,
    updateConditionalForwarder_dnsIpAddrs,

    -- * Destructuring the Response
    UpdateConditionalForwarderResponse (..),
    newUpdateConditionalForwarderResponse,

    -- * Response Lenses
    updateConditionalForwarderResponse_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

-- | Updates a conditional forwarder.
--
-- /See:/ 'newUpdateConditionalForwarder' smart constructor.
data UpdateConditionalForwarder = UpdateConditionalForwarder'
  { -- | The directory ID of the Amazon Web Services directory for which to
    -- update the conditional forwarder.
    UpdateConditionalForwarder -> Text
directoryId :: Prelude.Text,
    -- | The fully qualified domain name (FQDN) of the remote domain with which
    -- you will set up a trust relationship.
    UpdateConditionalForwarder -> Text
remoteDomainName :: Prelude.Text,
    -- | The updated IP addresses of the remote DNS server associated with the
    -- conditional forwarder.
    UpdateConditionalForwarder -> [Text]
dnsIpAddrs :: [Prelude.Text]
  }
  deriving (UpdateConditionalForwarder -> UpdateConditionalForwarder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateConditionalForwarder -> UpdateConditionalForwarder -> Bool
$c/= :: UpdateConditionalForwarder -> UpdateConditionalForwarder -> Bool
== :: UpdateConditionalForwarder -> UpdateConditionalForwarder -> Bool
$c== :: UpdateConditionalForwarder -> UpdateConditionalForwarder -> Bool
Prelude.Eq, ReadPrec [UpdateConditionalForwarder]
ReadPrec UpdateConditionalForwarder
Int -> ReadS UpdateConditionalForwarder
ReadS [UpdateConditionalForwarder]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateConditionalForwarder]
$creadListPrec :: ReadPrec [UpdateConditionalForwarder]
readPrec :: ReadPrec UpdateConditionalForwarder
$creadPrec :: ReadPrec UpdateConditionalForwarder
readList :: ReadS [UpdateConditionalForwarder]
$creadList :: ReadS [UpdateConditionalForwarder]
readsPrec :: Int -> ReadS UpdateConditionalForwarder
$creadsPrec :: Int -> ReadS UpdateConditionalForwarder
Prelude.Read, Int -> UpdateConditionalForwarder -> ShowS
[UpdateConditionalForwarder] -> ShowS
UpdateConditionalForwarder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateConditionalForwarder] -> ShowS
$cshowList :: [UpdateConditionalForwarder] -> ShowS
show :: UpdateConditionalForwarder -> String
$cshow :: UpdateConditionalForwarder -> String
showsPrec :: Int -> UpdateConditionalForwarder -> ShowS
$cshowsPrec :: Int -> UpdateConditionalForwarder -> ShowS
Prelude.Show, forall x.
Rep UpdateConditionalForwarder x -> UpdateConditionalForwarder
forall x.
UpdateConditionalForwarder -> Rep UpdateConditionalForwarder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateConditionalForwarder x -> UpdateConditionalForwarder
$cfrom :: forall x.
UpdateConditionalForwarder -> Rep UpdateConditionalForwarder x
Prelude.Generic)

-- |
-- Create a value of 'UpdateConditionalForwarder' 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', 'updateConditionalForwarder_directoryId' - The directory ID of the Amazon Web Services directory for which to
-- update the conditional forwarder.
--
-- 'remoteDomainName', 'updateConditionalForwarder_remoteDomainName' - The fully qualified domain name (FQDN) of the remote domain with which
-- you will set up a trust relationship.
--
-- 'dnsIpAddrs', 'updateConditionalForwarder_dnsIpAddrs' - The updated IP addresses of the remote DNS server associated with the
-- conditional forwarder.
newUpdateConditionalForwarder ::
  -- | 'directoryId'
  Prelude.Text ->
  -- | 'remoteDomainName'
  Prelude.Text ->
  UpdateConditionalForwarder
newUpdateConditionalForwarder :: Text -> Text -> UpdateConditionalForwarder
newUpdateConditionalForwarder
  Text
pDirectoryId_
  Text
pRemoteDomainName_ =
    UpdateConditionalForwarder'
      { $sel:directoryId:UpdateConditionalForwarder' :: Text
directoryId =
          Text
pDirectoryId_,
        $sel:remoteDomainName:UpdateConditionalForwarder' :: Text
remoteDomainName = Text
pRemoteDomainName_,
        $sel:dnsIpAddrs:UpdateConditionalForwarder' :: [Text]
dnsIpAddrs = forall a. Monoid a => a
Prelude.mempty
      }

-- | The directory ID of the Amazon Web Services directory for which to
-- update the conditional forwarder.
updateConditionalForwarder_directoryId :: Lens.Lens' UpdateConditionalForwarder Prelude.Text
updateConditionalForwarder_directoryId :: Lens' UpdateConditionalForwarder Text
updateConditionalForwarder_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConditionalForwarder' {Text
directoryId :: Text
$sel:directoryId:UpdateConditionalForwarder' :: UpdateConditionalForwarder -> Text
directoryId} -> Text
directoryId) (\s :: UpdateConditionalForwarder
s@UpdateConditionalForwarder' {} Text
a -> UpdateConditionalForwarder
s {$sel:directoryId:UpdateConditionalForwarder' :: Text
directoryId = Text
a} :: UpdateConditionalForwarder)

-- | The fully qualified domain name (FQDN) of the remote domain with which
-- you will set up a trust relationship.
updateConditionalForwarder_remoteDomainName :: Lens.Lens' UpdateConditionalForwarder Prelude.Text
updateConditionalForwarder_remoteDomainName :: Lens' UpdateConditionalForwarder Text
updateConditionalForwarder_remoteDomainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConditionalForwarder' {Text
remoteDomainName :: Text
$sel:remoteDomainName:UpdateConditionalForwarder' :: UpdateConditionalForwarder -> Text
remoteDomainName} -> Text
remoteDomainName) (\s :: UpdateConditionalForwarder
s@UpdateConditionalForwarder' {} Text
a -> UpdateConditionalForwarder
s {$sel:remoteDomainName:UpdateConditionalForwarder' :: Text
remoteDomainName = Text
a} :: UpdateConditionalForwarder)

-- | The updated IP addresses of the remote DNS server associated with the
-- conditional forwarder.
updateConditionalForwarder_dnsIpAddrs :: Lens.Lens' UpdateConditionalForwarder [Prelude.Text]
updateConditionalForwarder_dnsIpAddrs :: Lens' UpdateConditionalForwarder [Text]
updateConditionalForwarder_dnsIpAddrs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConditionalForwarder' {[Text]
dnsIpAddrs :: [Text]
$sel:dnsIpAddrs:UpdateConditionalForwarder' :: UpdateConditionalForwarder -> [Text]
dnsIpAddrs} -> [Text]
dnsIpAddrs) (\s :: UpdateConditionalForwarder
s@UpdateConditionalForwarder' {} [Text]
a -> UpdateConditionalForwarder
s {$sel:dnsIpAddrs:UpdateConditionalForwarder' :: [Text]
dnsIpAddrs = [Text]
a} :: UpdateConditionalForwarder) 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 UpdateConditionalForwarder where
  type
    AWSResponse UpdateConditionalForwarder =
      UpdateConditionalForwarderResponse
  request :: (Service -> Service)
-> UpdateConditionalForwarder -> Request UpdateConditionalForwarder
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 UpdateConditionalForwarder
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateConditionalForwarder)))
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 -> UpdateConditionalForwarderResponse
UpdateConditionalForwarderResponse'
            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 UpdateConditionalForwarder where
  hashWithSalt :: Int -> UpdateConditionalForwarder -> Int
hashWithSalt Int
_salt UpdateConditionalForwarder' {[Text]
Text
dnsIpAddrs :: [Text]
remoteDomainName :: Text
directoryId :: Text
$sel:dnsIpAddrs:UpdateConditionalForwarder' :: UpdateConditionalForwarder -> [Text]
$sel:remoteDomainName:UpdateConditionalForwarder' :: UpdateConditionalForwarder -> Text
$sel:directoryId:UpdateConditionalForwarder' :: UpdateConditionalForwarder -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
remoteDomainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
dnsIpAddrs

instance Prelude.NFData UpdateConditionalForwarder where
  rnf :: UpdateConditionalForwarder -> ()
rnf UpdateConditionalForwarder' {[Text]
Text
dnsIpAddrs :: [Text]
remoteDomainName :: Text
directoryId :: Text
$sel:dnsIpAddrs:UpdateConditionalForwarder' :: UpdateConditionalForwarder -> [Text]
$sel:remoteDomainName:UpdateConditionalForwarder' :: UpdateConditionalForwarder -> Text
$sel:directoryId:UpdateConditionalForwarder' :: UpdateConditionalForwarder -> 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
remoteDomainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
dnsIpAddrs

instance Data.ToHeaders UpdateConditionalForwarder where
  toHeaders :: UpdateConditionalForwarder -> 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.UpdateConditionalForwarder" ::
                          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 UpdateConditionalForwarder where
  toJSON :: UpdateConditionalForwarder -> Value
toJSON UpdateConditionalForwarder' {[Text]
Text
dnsIpAddrs :: [Text]
remoteDomainName :: Text
directoryId :: Text
$sel:dnsIpAddrs:UpdateConditionalForwarder' :: UpdateConditionalForwarder -> [Text]
$sel:remoteDomainName:UpdateConditionalForwarder' :: UpdateConditionalForwarder -> Text
$sel:directoryId:UpdateConditionalForwarder' :: UpdateConditionalForwarder -> 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
"RemoteDomainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
remoteDomainName),
            forall a. a -> Maybe a
Prelude.Just (Key
"DnsIpAddrs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
dnsIpAddrs)
          ]
      )

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

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

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

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

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

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