{-# 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.AddRegion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds two domain controllers in the specified Region for the specified
-- directory.
module Amazonka.DirectoryService.AddRegion
  ( -- * Creating a Request
    AddRegion (..),
    newAddRegion,

    -- * Request Lenses
    addRegion_directoryId,
    addRegion_regionName,
    addRegion_vPCSettings,

    -- * Destructuring the Response
    AddRegionResponse (..),
    newAddRegionResponse,

    -- * Response Lenses
    addRegionResponse_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:/ 'newAddRegion' smart constructor.
data AddRegion = AddRegion'
  { -- | The identifier of the directory to which you want to add Region
    -- replication.
    AddRegion -> Text
directoryId :: Prelude.Text,
    -- | The name of the Region where you want to add domain controllers for
    -- replication. For example, @us-east-1@.
    AddRegion -> Text
regionName :: Prelude.Text,
    AddRegion -> DirectoryVpcSettings
vPCSettings :: DirectoryVpcSettings
  }
  deriving (AddRegion -> AddRegion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddRegion -> AddRegion -> Bool
$c/= :: AddRegion -> AddRegion -> Bool
== :: AddRegion -> AddRegion -> Bool
$c== :: AddRegion -> AddRegion -> Bool
Prelude.Eq, ReadPrec [AddRegion]
ReadPrec AddRegion
Int -> ReadS AddRegion
ReadS [AddRegion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddRegion]
$creadListPrec :: ReadPrec [AddRegion]
readPrec :: ReadPrec AddRegion
$creadPrec :: ReadPrec AddRegion
readList :: ReadS [AddRegion]
$creadList :: ReadS [AddRegion]
readsPrec :: Int -> ReadS AddRegion
$creadsPrec :: Int -> ReadS AddRegion
Prelude.Read, Int -> AddRegion -> ShowS
[AddRegion] -> ShowS
AddRegion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddRegion] -> ShowS
$cshowList :: [AddRegion] -> ShowS
show :: AddRegion -> String
$cshow :: AddRegion -> String
showsPrec :: Int -> AddRegion -> ShowS
$cshowsPrec :: Int -> AddRegion -> ShowS
Prelude.Show, forall x. Rep AddRegion x -> AddRegion
forall x. AddRegion -> Rep AddRegion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddRegion x -> AddRegion
$cfrom :: forall x. AddRegion -> Rep AddRegion x
Prelude.Generic)

-- |
-- Create a value of 'AddRegion' 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', 'addRegion_directoryId' - The identifier of the directory to which you want to add Region
-- replication.
--
-- 'regionName', 'addRegion_regionName' - The name of the Region where you want to add domain controllers for
-- replication. For example, @us-east-1@.
--
-- 'vPCSettings', 'addRegion_vPCSettings' - Undocumented member.
newAddRegion ::
  -- | 'directoryId'
  Prelude.Text ->
  -- | 'regionName'
  Prelude.Text ->
  -- | 'vPCSettings'
  DirectoryVpcSettings ->
  AddRegion
newAddRegion :: Text -> Text -> DirectoryVpcSettings -> AddRegion
newAddRegion Text
pDirectoryId_ Text
pRegionName_ DirectoryVpcSettings
pVPCSettings_ =
  AddRegion'
    { $sel:directoryId:AddRegion' :: Text
directoryId = Text
pDirectoryId_,
      $sel:regionName:AddRegion' :: Text
regionName = Text
pRegionName_,
      $sel:vPCSettings:AddRegion' :: DirectoryVpcSettings
vPCSettings = DirectoryVpcSettings
pVPCSettings_
    }

-- | The identifier of the directory to which you want to add Region
-- replication.
addRegion_directoryId :: Lens.Lens' AddRegion Prelude.Text
addRegion_directoryId :: Lens' AddRegion Text
addRegion_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddRegion' {Text
directoryId :: Text
$sel:directoryId:AddRegion' :: AddRegion -> Text
directoryId} -> Text
directoryId) (\s :: AddRegion
s@AddRegion' {} Text
a -> AddRegion
s {$sel:directoryId:AddRegion' :: Text
directoryId = Text
a} :: AddRegion)

-- | The name of the Region where you want to add domain controllers for
-- replication. For example, @us-east-1@.
addRegion_regionName :: Lens.Lens' AddRegion Prelude.Text
addRegion_regionName :: Lens' AddRegion Text
addRegion_regionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddRegion' {Text
regionName :: Text
$sel:regionName:AddRegion' :: AddRegion -> Text
regionName} -> Text
regionName) (\s :: AddRegion
s@AddRegion' {} Text
a -> AddRegion
s {$sel:regionName:AddRegion' :: Text
regionName = Text
a} :: AddRegion)

-- | Undocumented member.
addRegion_vPCSettings :: Lens.Lens' AddRegion DirectoryVpcSettings
addRegion_vPCSettings :: Lens' AddRegion DirectoryVpcSettings
addRegion_vPCSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddRegion' {DirectoryVpcSettings
vPCSettings :: DirectoryVpcSettings
$sel:vPCSettings:AddRegion' :: AddRegion -> DirectoryVpcSettings
vPCSettings} -> DirectoryVpcSettings
vPCSettings) (\s :: AddRegion
s@AddRegion' {} DirectoryVpcSettings
a -> AddRegion
s {$sel:vPCSettings:AddRegion' :: DirectoryVpcSettings
vPCSettings = DirectoryVpcSettings
a} :: AddRegion)

instance Core.AWSRequest AddRegion where
  type AWSResponse AddRegion = AddRegionResponse
  request :: (Service -> Service) -> AddRegion -> Request AddRegion
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 AddRegion
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AddRegion)))
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 -> AddRegionResponse
AddRegionResponse'
            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 AddRegion where
  hashWithSalt :: Int -> AddRegion -> Int
hashWithSalt Int
_salt AddRegion' {Text
DirectoryVpcSettings
vPCSettings :: DirectoryVpcSettings
regionName :: Text
directoryId :: Text
$sel:vPCSettings:AddRegion' :: AddRegion -> DirectoryVpcSettings
$sel:regionName:AddRegion' :: AddRegion -> Text
$sel:directoryId:AddRegion' :: AddRegion -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
regionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DirectoryVpcSettings
vPCSettings

instance Prelude.NFData AddRegion where
  rnf :: AddRegion -> ()
rnf AddRegion' {Text
DirectoryVpcSettings
vPCSettings :: DirectoryVpcSettings
regionName :: Text
directoryId :: Text
$sel:vPCSettings:AddRegion' :: AddRegion -> DirectoryVpcSettings
$sel:regionName:AddRegion' :: AddRegion -> Text
$sel:directoryId:AddRegion' :: AddRegion -> 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
regionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DirectoryVpcSettings
vPCSettings

instance Data.ToHeaders AddRegion where
  toHeaders :: AddRegion -> 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.AddRegion" ::
                          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 AddRegion where
  toJSON :: AddRegion -> Value
toJSON AddRegion' {Text
DirectoryVpcSettings
vPCSettings :: DirectoryVpcSettings
regionName :: Text
directoryId :: Text
$sel:vPCSettings:AddRegion' :: AddRegion -> DirectoryVpcSettings
$sel:regionName:AddRegion' :: AddRegion -> Text
$sel:directoryId:AddRegion' :: AddRegion -> 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
"RegionName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
regionName),
            forall a. a -> Maybe a
Prelude.Just (Key
"VPCSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DirectoryVpcSettings
vPCSettings)
          ]
      )

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

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

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

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

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

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