{-# 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.StorageGateway.JoinDomain
-- 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 a file gateway to an Active Directory domain. This operation is
-- only supported for file gateways that support the SMB file protocol.
module Amazonka.StorageGateway.JoinDomain
  ( -- * Creating a Request
    JoinDomain (..),
    newJoinDomain,

    -- * Request Lenses
    joinDomain_domainControllers,
    joinDomain_organizationalUnit,
    joinDomain_timeoutInSeconds,
    joinDomain_gatewayARN,
    joinDomain_domainName,
    joinDomain_userName,
    joinDomain_password,

    -- * Destructuring the Response
    JoinDomainResponse (..),
    newJoinDomainResponse,

    -- * Response Lenses
    joinDomainResponse_activeDirectoryStatus,
    joinDomainResponse_gatewayARN,
    joinDomainResponse_httpStatus,
  )
where

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

-- | JoinDomainInput
--
-- /See:/ 'newJoinDomain' smart constructor.
data JoinDomain = JoinDomain'
  { -- | List of IPv4 addresses, NetBIOS names, or host names of your domain
    -- server. If you need to specify the port number include it after the
    -- colon (“:”). For example, @mydc.mydomain.com:389@.
    JoinDomain -> Maybe [Text]
domainControllers :: Prelude.Maybe [Prelude.Text],
    -- | The organizational unit (OU) is a container in an Active Directory that
    -- can hold users, groups, computers, and other OUs and this parameter
    -- specifies the OU that the gateway will join within the AD domain.
    JoinDomain -> Maybe Text
organizationalUnit :: Prelude.Maybe Prelude.Text,
    -- | Specifies the time in seconds, in which the @JoinDomain@ operation must
    -- complete. The default is 20 seconds.
    JoinDomain -> Maybe Natural
timeoutInSeconds :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon Resource Name (ARN) of the gateway. Use the @ListGateways@
    -- operation to return a list of gateways for your account and Amazon Web
    -- Services Region.
    JoinDomain -> Text
gatewayARN :: Prelude.Text,
    -- | The name of the domain that you want the gateway to join.
    JoinDomain -> Text
domainName :: Prelude.Text,
    -- | Sets the user name of user who has permission to add the gateway to the
    -- Active Directory domain. The domain user account should be enabled to
    -- join computers to the domain. For example, you can use the domain
    -- administrator account or an account with delegated permissions to join
    -- computers to the domain.
    JoinDomain -> Text
userName :: Prelude.Text,
    -- | Sets the password of the user who has permission to add the gateway to
    -- the Active Directory domain.
    JoinDomain -> Sensitive Text
password :: Data.Sensitive Prelude.Text
  }
  deriving (JoinDomain -> JoinDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoinDomain -> JoinDomain -> Bool
$c/= :: JoinDomain -> JoinDomain -> Bool
== :: JoinDomain -> JoinDomain -> Bool
$c== :: JoinDomain -> JoinDomain -> Bool
Prelude.Eq, Int -> JoinDomain -> ShowS
[JoinDomain] -> ShowS
JoinDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoinDomain] -> ShowS
$cshowList :: [JoinDomain] -> ShowS
show :: JoinDomain -> String
$cshow :: JoinDomain -> String
showsPrec :: Int -> JoinDomain -> ShowS
$cshowsPrec :: Int -> JoinDomain -> ShowS
Prelude.Show, forall x. Rep JoinDomain x -> JoinDomain
forall x. JoinDomain -> Rep JoinDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JoinDomain x -> JoinDomain
$cfrom :: forall x. JoinDomain -> Rep JoinDomain x
Prelude.Generic)

-- |
-- Create a value of 'JoinDomain' 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:
--
-- 'domainControllers', 'joinDomain_domainControllers' - List of IPv4 addresses, NetBIOS names, or host names of your domain
-- server. If you need to specify the port number include it after the
-- colon (“:”). For example, @mydc.mydomain.com:389@.
--
-- 'organizationalUnit', 'joinDomain_organizationalUnit' - The organizational unit (OU) is a container in an Active Directory that
-- can hold users, groups, computers, and other OUs and this parameter
-- specifies the OU that the gateway will join within the AD domain.
--
-- 'timeoutInSeconds', 'joinDomain_timeoutInSeconds' - Specifies the time in seconds, in which the @JoinDomain@ operation must
-- complete. The default is 20 seconds.
--
-- 'gatewayARN', 'joinDomain_gatewayARN' - The Amazon Resource Name (ARN) of the gateway. Use the @ListGateways@
-- operation to return a list of gateways for your account and Amazon Web
-- Services Region.
--
-- 'domainName', 'joinDomain_domainName' - The name of the domain that you want the gateway to join.
--
-- 'userName', 'joinDomain_userName' - Sets the user name of user who has permission to add the gateway to the
-- Active Directory domain. The domain user account should be enabled to
-- join computers to the domain. For example, you can use the domain
-- administrator account or an account with delegated permissions to join
-- computers to the domain.
--
-- 'password', 'joinDomain_password' - Sets the password of the user who has permission to add the gateway to
-- the Active Directory domain.
newJoinDomain ::
  -- | 'gatewayARN'
  Prelude.Text ->
  -- | 'domainName'
  Prelude.Text ->
  -- | 'userName'
  Prelude.Text ->
  -- | 'password'
  Prelude.Text ->
  JoinDomain
newJoinDomain :: Text -> Text -> Text -> Text -> JoinDomain
newJoinDomain
  Text
pGatewayARN_
  Text
pDomainName_
  Text
pUserName_
  Text
pPassword_ =
    JoinDomain'
      { $sel:domainControllers:JoinDomain' :: Maybe [Text]
domainControllers = forall a. Maybe a
Prelude.Nothing,
        $sel:organizationalUnit:JoinDomain' :: Maybe Text
organizationalUnit = forall a. Maybe a
Prelude.Nothing,
        $sel:timeoutInSeconds:JoinDomain' :: Maybe Natural
timeoutInSeconds = forall a. Maybe a
Prelude.Nothing,
        $sel:gatewayARN:JoinDomain' :: Text
gatewayARN = Text
pGatewayARN_,
        $sel:domainName:JoinDomain' :: Text
domainName = Text
pDomainName_,
        $sel:userName:JoinDomain' :: Text
userName = Text
pUserName_,
        $sel:password:JoinDomain' :: Sensitive Text
password = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPassword_
      }

-- | List of IPv4 addresses, NetBIOS names, or host names of your domain
-- server. If you need to specify the port number include it after the
-- colon (“:”). For example, @mydc.mydomain.com:389@.
joinDomain_domainControllers :: Lens.Lens' JoinDomain (Prelude.Maybe [Prelude.Text])
joinDomain_domainControllers :: Lens' JoinDomain (Maybe [Text])
joinDomain_domainControllers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JoinDomain' {Maybe [Text]
domainControllers :: Maybe [Text]
$sel:domainControllers:JoinDomain' :: JoinDomain -> Maybe [Text]
domainControllers} -> Maybe [Text]
domainControllers) (\s :: JoinDomain
s@JoinDomain' {} Maybe [Text]
a -> JoinDomain
s {$sel:domainControllers:JoinDomain' :: Maybe [Text]
domainControllers = Maybe [Text]
a} :: JoinDomain) 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 organizational unit (OU) is a container in an Active Directory that
-- can hold users, groups, computers, and other OUs and this parameter
-- specifies the OU that the gateway will join within the AD domain.
joinDomain_organizationalUnit :: Lens.Lens' JoinDomain (Prelude.Maybe Prelude.Text)
joinDomain_organizationalUnit :: Lens' JoinDomain (Maybe Text)
joinDomain_organizationalUnit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JoinDomain' {Maybe Text
organizationalUnit :: Maybe Text
$sel:organizationalUnit:JoinDomain' :: JoinDomain -> Maybe Text
organizationalUnit} -> Maybe Text
organizationalUnit) (\s :: JoinDomain
s@JoinDomain' {} Maybe Text
a -> JoinDomain
s {$sel:organizationalUnit:JoinDomain' :: Maybe Text
organizationalUnit = Maybe Text
a} :: JoinDomain)

-- | Specifies the time in seconds, in which the @JoinDomain@ operation must
-- complete. The default is 20 seconds.
joinDomain_timeoutInSeconds :: Lens.Lens' JoinDomain (Prelude.Maybe Prelude.Natural)
joinDomain_timeoutInSeconds :: Lens' JoinDomain (Maybe Natural)
joinDomain_timeoutInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JoinDomain' {Maybe Natural
timeoutInSeconds :: Maybe Natural
$sel:timeoutInSeconds:JoinDomain' :: JoinDomain -> Maybe Natural
timeoutInSeconds} -> Maybe Natural
timeoutInSeconds) (\s :: JoinDomain
s@JoinDomain' {} Maybe Natural
a -> JoinDomain
s {$sel:timeoutInSeconds:JoinDomain' :: Maybe Natural
timeoutInSeconds = Maybe Natural
a} :: JoinDomain)

-- | The Amazon Resource Name (ARN) of the gateway. Use the @ListGateways@
-- operation to return a list of gateways for your account and Amazon Web
-- Services Region.
joinDomain_gatewayARN :: Lens.Lens' JoinDomain Prelude.Text
joinDomain_gatewayARN :: Lens' JoinDomain Text
joinDomain_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JoinDomain' {Text
gatewayARN :: Text
$sel:gatewayARN:JoinDomain' :: JoinDomain -> Text
gatewayARN} -> Text
gatewayARN) (\s :: JoinDomain
s@JoinDomain' {} Text
a -> JoinDomain
s {$sel:gatewayARN:JoinDomain' :: Text
gatewayARN = Text
a} :: JoinDomain)

-- | The name of the domain that you want the gateway to join.
joinDomain_domainName :: Lens.Lens' JoinDomain Prelude.Text
joinDomain_domainName :: Lens' JoinDomain Text
joinDomain_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JoinDomain' {Text
domainName :: Text
$sel:domainName:JoinDomain' :: JoinDomain -> Text
domainName} -> Text
domainName) (\s :: JoinDomain
s@JoinDomain' {} Text
a -> JoinDomain
s {$sel:domainName:JoinDomain' :: Text
domainName = Text
a} :: JoinDomain)

-- | Sets the user name of user who has permission to add the gateway to the
-- Active Directory domain. The domain user account should be enabled to
-- join computers to the domain. For example, you can use the domain
-- administrator account or an account with delegated permissions to join
-- computers to the domain.
joinDomain_userName :: Lens.Lens' JoinDomain Prelude.Text
joinDomain_userName :: Lens' JoinDomain Text
joinDomain_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JoinDomain' {Text
userName :: Text
$sel:userName:JoinDomain' :: JoinDomain -> Text
userName} -> Text
userName) (\s :: JoinDomain
s@JoinDomain' {} Text
a -> JoinDomain
s {$sel:userName:JoinDomain' :: Text
userName = Text
a} :: JoinDomain)

-- | Sets the password of the user who has permission to add the gateway to
-- the Active Directory domain.
joinDomain_password :: Lens.Lens' JoinDomain Prelude.Text
joinDomain_password :: Lens' JoinDomain Text
joinDomain_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JoinDomain' {Sensitive Text
password :: Sensitive Text
$sel:password:JoinDomain' :: JoinDomain -> Sensitive Text
password} -> Sensitive Text
password) (\s :: JoinDomain
s@JoinDomain' {} Sensitive Text
a -> JoinDomain
s {$sel:password:JoinDomain' :: Sensitive Text
password = Sensitive Text
a} :: JoinDomain) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest JoinDomain where
  type AWSResponse JoinDomain = JoinDomainResponse
  request :: (Service -> Service) -> JoinDomain -> Request JoinDomain
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 JoinDomain
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse JoinDomain)))
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 ActiveDirectoryStatus
-> Maybe Text -> Int -> JoinDomainResponse
JoinDomainResponse'
            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
"ActiveDirectoryStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"GatewayARN")
            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 JoinDomain where
  hashWithSalt :: Int -> JoinDomain -> Int
hashWithSalt Int
_salt JoinDomain' {Maybe Natural
Maybe [Text]
Maybe Text
Text
Sensitive Text
password :: Sensitive Text
userName :: Text
domainName :: Text
gatewayARN :: Text
timeoutInSeconds :: Maybe Natural
organizationalUnit :: Maybe Text
domainControllers :: Maybe [Text]
$sel:password:JoinDomain' :: JoinDomain -> Sensitive Text
$sel:userName:JoinDomain' :: JoinDomain -> Text
$sel:domainName:JoinDomain' :: JoinDomain -> Text
$sel:gatewayARN:JoinDomain' :: JoinDomain -> Text
$sel:timeoutInSeconds:JoinDomain' :: JoinDomain -> Maybe Natural
$sel:organizationalUnit:JoinDomain' :: JoinDomain -> Maybe Text
$sel:domainControllers:JoinDomain' :: JoinDomain -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
domainControllers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
organizationalUnit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
timeoutInSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
password

instance Prelude.NFData JoinDomain where
  rnf :: JoinDomain -> ()
rnf JoinDomain' {Maybe Natural
Maybe [Text]
Maybe Text
Text
Sensitive Text
password :: Sensitive Text
userName :: Text
domainName :: Text
gatewayARN :: Text
timeoutInSeconds :: Maybe Natural
organizationalUnit :: Maybe Text
domainControllers :: Maybe [Text]
$sel:password:JoinDomain' :: JoinDomain -> Sensitive Text
$sel:userName:JoinDomain' :: JoinDomain -> Text
$sel:domainName:JoinDomain' :: JoinDomain -> Text
$sel:gatewayARN:JoinDomain' :: JoinDomain -> Text
$sel:timeoutInSeconds:JoinDomain' :: JoinDomain -> Maybe Natural
$sel:organizationalUnit:JoinDomain' :: JoinDomain -> Maybe Text
$sel:domainControllers:JoinDomain' :: JoinDomain -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
domainControllers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
organizationalUnit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
timeoutInSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gatewayARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
password

instance Data.ToHeaders JoinDomain where
  toHeaders :: JoinDomain -> 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
"StorageGateway_20130630.JoinDomain" ::
                          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 JoinDomain where
  toJSON :: JoinDomain -> Value
toJSON JoinDomain' {Maybe Natural
Maybe [Text]
Maybe Text
Text
Sensitive Text
password :: Sensitive Text
userName :: Text
domainName :: Text
gatewayARN :: Text
timeoutInSeconds :: Maybe Natural
organizationalUnit :: Maybe Text
domainControllers :: Maybe [Text]
$sel:password:JoinDomain' :: JoinDomain -> Sensitive Text
$sel:userName:JoinDomain' :: JoinDomain -> Text
$sel:domainName:JoinDomain' :: JoinDomain -> Text
$sel:gatewayARN:JoinDomain' :: JoinDomain -> Text
$sel:timeoutInSeconds:JoinDomain' :: JoinDomain -> Maybe Natural
$sel:organizationalUnit:JoinDomain' :: JoinDomain -> Maybe Text
$sel:domainControllers:JoinDomain' :: JoinDomain -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DomainControllers" 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 [Text]
domainControllers,
            (Key
"OrganizationalUnit" 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 Text
organizationalUnit,
            (Key
"TimeoutInSeconds" 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 Natural
timeoutInSeconds,
            forall a. a -> Maybe a
Prelude.Just (Key
"GatewayARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gatewayARN),
            forall a. a -> Maybe a
Prelude.Just (Key
"DomainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainName),
            forall a. a -> Maybe a
Prelude.Just (Key
"UserName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Password" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
password)
          ]
      )

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

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

-- | JoinDomainOutput
--
-- /See:/ 'newJoinDomainResponse' smart constructor.
data JoinDomainResponse = JoinDomainResponse'
  { -- | Indicates the status of the gateway as a member of the Active Directory
    -- domain.
    --
    -- -   @ACCESS_DENIED@: Indicates that the @JoinDomain@ operation failed
    --     due to an authentication error.
    --
    -- -   @DETACHED@: Indicates that gateway is not joined to a domain.
    --
    -- -   @JOINED@: Indicates that the gateway has successfully joined a
    --     domain.
    --
    -- -   @JOINING@: Indicates that a @JoinDomain@ operation is in progress.
    --
    -- -   @NETWORK_ERROR@: Indicates that @JoinDomain@ operation failed due to
    --     a network or connectivity error.
    --
    -- -   @TIMEOUT@: Indicates that the @JoinDomain@ operation failed because
    --     the operation didn\'t complete within the allotted time.
    --
    -- -   @UNKNOWN_ERROR@: Indicates that the @JoinDomain@ operation failed
    --     due to another type of error.
    JoinDomainResponse -> Maybe ActiveDirectoryStatus
activeDirectoryStatus :: Prelude.Maybe ActiveDirectoryStatus,
    -- | The unique Amazon Resource Name (ARN) of the gateway that joined the
    -- domain.
    JoinDomainResponse -> Maybe Text
gatewayARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    JoinDomainResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (JoinDomainResponse -> JoinDomainResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoinDomainResponse -> JoinDomainResponse -> Bool
$c/= :: JoinDomainResponse -> JoinDomainResponse -> Bool
== :: JoinDomainResponse -> JoinDomainResponse -> Bool
$c== :: JoinDomainResponse -> JoinDomainResponse -> Bool
Prelude.Eq, ReadPrec [JoinDomainResponse]
ReadPrec JoinDomainResponse
Int -> ReadS JoinDomainResponse
ReadS [JoinDomainResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JoinDomainResponse]
$creadListPrec :: ReadPrec [JoinDomainResponse]
readPrec :: ReadPrec JoinDomainResponse
$creadPrec :: ReadPrec JoinDomainResponse
readList :: ReadS [JoinDomainResponse]
$creadList :: ReadS [JoinDomainResponse]
readsPrec :: Int -> ReadS JoinDomainResponse
$creadsPrec :: Int -> ReadS JoinDomainResponse
Prelude.Read, Int -> JoinDomainResponse -> ShowS
[JoinDomainResponse] -> ShowS
JoinDomainResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoinDomainResponse] -> ShowS
$cshowList :: [JoinDomainResponse] -> ShowS
show :: JoinDomainResponse -> String
$cshow :: JoinDomainResponse -> String
showsPrec :: Int -> JoinDomainResponse -> ShowS
$cshowsPrec :: Int -> JoinDomainResponse -> ShowS
Prelude.Show, forall x. Rep JoinDomainResponse x -> JoinDomainResponse
forall x. JoinDomainResponse -> Rep JoinDomainResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JoinDomainResponse x -> JoinDomainResponse
$cfrom :: forall x. JoinDomainResponse -> Rep JoinDomainResponse x
Prelude.Generic)

-- |
-- Create a value of 'JoinDomainResponse' 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:
--
-- 'activeDirectoryStatus', 'joinDomainResponse_activeDirectoryStatus' - Indicates the status of the gateway as a member of the Active Directory
-- domain.
--
-- -   @ACCESS_DENIED@: Indicates that the @JoinDomain@ operation failed
--     due to an authentication error.
--
-- -   @DETACHED@: Indicates that gateway is not joined to a domain.
--
-- -   @JOINED@: Indicates that the gateway has successfully joined a
--     domain.
--
-- -   @JOINING@: Indicates that a @JoinDomain@ operation is in progress.
--
-- -   @NETWORK_ERROR@: Indicates that @JoinDomain@ operation failed due to
--     a network or connectivity error.
--
-- -   @TIMEOUT@: Indicates that the @JoinDomain@ operation failed because
--     the operation didn\'t complete within the allotted time.
--
-- -   @UNKNOWN_ERROR@: Indicates that the @JoinDomain@ operation failed
--     due to another type of error.
--
-- 'gatewayARN', 'joinDomainResponse_gatewayARN' - The unique Amazon Resource Name (ARN) of the gateway that joined the
-- domain.
--
-- 'httpStatus', 'joinDomainResponse_httpStatus' - The response's http status code.
newJoinDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  JoinDomainResponse
newJoinDomainResponse :: Int -> JoinDomainResponse
newJoinDomainResponse Int
pHttpStatus_ =
  JoinDomainResponse'
    { $sel:activeDirectoryStatus:JoinDomainResponse' :: Maybe ActiveDirectoryStatus
activeDirectoryStatus =
        forall a. Maybe a
Prelude.Nothing,
      $sel:gatewayARN:JoinDomainResponse' :: Maybe Text
gatewayARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:JoinDomainResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Indicates the status of the gateway as a member of the Active Directory
-- domain.
--
-- -   @ACCESS_DENIED@: Indicates that the @JoinDomain@ operation failed
--     due to an authentication error.
--
-- -   @DETACHED@: Indicates that gateway is not joined to a domain.
--
-- -   @JOINED@: Indicates that the gateway has successfully joined a
--     domain.
--
-- -   @JOINING@: Indicates that a @JoinDomain@ operation is in progress.
--
-- -   @NETWORK_ERROR@: Indicates that @JoinDomain@ operation failed due to
--     a network or connectivity error.
--
-- -   @TIMEOUT@: Indicates that the @JoinDomain@ operation failed because
--     the operation didn\'t complete within the allotted time.
--
-- -   @UNKNOWN_ERROR@: Indicates that the @JoinDomain@ operation failed
--     due to another type of error.
joinDomainResponse_activeDirectoryStatus :: Lens.Lens' JoinDomainResponse (Prelude.Maybe ActiveDirectoryStatus)
joinDomainResponse_activeDirectoryStatus :: Lens' JoinDomainResponse (Maybe ActiveDirectoryStatus)
joinDomainResponse_activeDirectoryStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JoinDomainResponse' {Maybe ActiveDirectoryStatus
activeDirectoryStatus :: Maybe ActiveDirectoryStatus
$sel:activeDirectoryStatus:JoinDomainResponse' :: JoinDomainResponse -> Maybe ActiveDirectoryStatus
activeDirectoryStatus} -> Maybe ActiveDirectoryStatus
activeDirectoryStatus) (\s :: JoinDomainResponse
s@JoinDomainResponse' {} Maybe ActiveDirectoryStatus
a -> JoinDomainResponse
s {$sel:activeDirectoryStatus:JoinDomainResponse' :: Maybe ActiveDirectoryStatus
activeDirectoryStatus = Maybe ActiveDirectoryStatus
a} :: JoinDomainResponse)

-- | The unique Amazon Resource Name (ARN) of the gateway that joined the
-- domain.
joinDomainResponse_gatewayARN :: Lens.Lens' JoinDomainResponse (Prelude.Maybe Prelude.Text)
joinDomainResponse_gatewayARN :: Lens' JoinDomainResponse (Maybe Text)
joinDomainResponse_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JoinDomainResponse' {Maybe Text
gatewayARN :: Maybe Text
$sel:gatewayARN:JoinDomainResponse' :: JoinDomainResponse -> Maybe Text
gatewayARN} -> Maybe Text
gatewayARN) (\s :: JoinDomainResponse
s@JoinDomainResponse' {} Maybe Text
a -> JoinDomainResponse
s {$sel:gatewayARN:JoinDomainResponse' :: Maybe Text
gatewayARN = Maybe Text
a} :: JoinDomainResponse)

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

instance Prelude.NFData JoinDomainResponse where
  rnf :: JoinDomainResponse -> ()
rnf JoinDomainResponse' {Int
Maybe Text
Maybe ActiveDirectoryStatus
httpStatus :: Int
gatewayARN :: Maybe Text
activeDirectoryStatus :: Maybe ActiveDirectoryStatus
$sel:httpStatus:JoinDomainResponse' :: JoinDomainResponse -> Int
$sel:gatewayARN:JoinDomainResponse' :: JoinDomainResponse -> Maybe Text
$sel:activeDirectoryStatus:JoinDomainResponse' :: JoinDomainResponse -> Maybe ActiveDirectoryStatus
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ActiveDirectoryStatus
activeDirectoryStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
gatewayARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus