{-# 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.ConnectDirectory
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an AD Connector to connect to a self-managed directory.
--
-- Before you call @ConnectDirectory@, ensure that all of the required
-- permissions have been explicitly granted through a policy. For details
-- about what permissions are required to run the @ConnectDirectory@
-- 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.ConnectDirectory
  ( -- * Creating a Request
    ConnectDirectory (..),
    newConnectDirectory,

    -- * Request Lenses
    connectDirectory_description,
    connectDirectory_shortName,
    connectDirectory_tags,
    connectDirectory_name,
    connectDirectory_password,
    connectDirectory_size,
    connectDirectory_connectSettings,

    -- * Destructuring the Response
    ConnectDirectoryResponse (..),
    newConnectDirectoryResponse,

    -- * Response Lenses
    connectDirectoryResponse_directoryId,
    connectDirectoryResponse_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

-- | Contains the inputs for the ConnectDirectory operation.
--
-- /See:/ 'newConnectDirectory' smart constructor.
data ConnectDirectory = ConnectDirectory'
  { -- | A description for the directory.
    ConnectDirectory -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The NetBIOS name of your self-managed directory, such as @CORP@.
    ConnectDirectory -> Maybe Text
shortName :: Prelude.Maybe Prelude.Text,
    -- | The tags to be assigned to AD Connector.
    ConnectDirectory -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The fully qualified name of your self-managed directory, such as
    -- @corp.example.com@.
    ConnectDirectory -> Text
name :: Prelude.Text,
    -- | The password for your self-managed user account.
    ConnectDirectory -> Sensitive Text
password :: Data.Sensitive Prelude.Text,
    -- | The size of the directory.
    ConnectDirectory -> DirectorySize
size :: DirectorySize,
    -- | A DirectoryConnectSettings object that contains additional information
    -- for the operation.
    ConnectDirectory -> DirectoryConnectSettings
connectSettings :: DirectoryConnectSettings
  }
  deriving (ConnectDirectory -> ConnectDirectory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectDirectory -> ConnectDirectory -> Bool
$c/= :: ConnectDirectory -> ConnectDirectory -> Bool
== :: ConnectDirectory -> ConnectDirectory -> Bool
$c== :: ConnectDirectory -> ConnectDirectory -> Bool
Prelude.Eq, Int -> ConnectDirectory -> ShowS
[ConnectDirectory] -> ShowS
ConnectDirectory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectDirectory] -> ShowS
$cshowList :: [ConnectDirectory] -> ShowS
show :: ConnectDirectory -> String
$cshow :: ConnectDirectory -> String
showsPrec :: Int -> ConnectDirectory -> ShowS
$cshowsPrec :: Int -> ConnectDirectory -> ShowS
Prelude.Show, forall x. Rep ConnectDirectory x -> ConnectDirectory
forall x. ConnectDirectory -> Rep ConnectDirectory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConnectDirectory x -> ConnectDirectory
$cfrom :: forall x. ConnectDirectory -> Rep ConnectDirectory x
Prelude.Generic)

-- |
-- Create a value of 'ConnectDirectory' 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:
--
-- 'description', 'connectDirectory_description' - A description for the directory.
--
-- 'shortName', 'connectDirectory_shortName' - The NetBIOS name of your self-managed directory, such as @CORP@.
--
-- 'tags', 'connectDirectory_tags' - The tags to be assigned to AD Connector.
--
-- 'name', 'connectDirectory_name' - The fully qualified name of your self-managed directory, such as
-- @corp.example.com@.
--
-- 'password', 'connectDirectory_password' - The password for your self-managed user account.
--
-- 'size', 'connectDirectory_size' - The size of the directory.
--
-- 'connectSettings', 'connectDirectory_connectSettings' - A DirectoryConnectSettings object that contains additional information
-- for the operation.
newConnectDirectory ::
  -- | 'name'
  Prelude.Text ->
  -- | 'password'
  Prelude.Text ->
  -- | 'size'
  DirectorySize ->
  -- | 'connectSettings'
  DirectoryConnectSettings ->
  ConnectDirectory
newConnectDirectory :: Text
-> Text
-> DirectorySize
-> DirectoryConnectSettings
-> ConnectDirectory
newConnectDirectory
  Text
pName_
  Text
pPassword_
  DirectorySize
pSize_
  DirectoryConnectSettings
pConnectSettings_ =
    ConnectDirectory'
      { $sel:description:ConnectDirectory' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:shortName:ConnectDirectory' :: Maybe Text
shortName = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:ConnectDirectory' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:ConnectDirectory' :: Text
name = Text
pName_,
        $sel:password:ConnectDirectory' :: Sensitive Text
password = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPassword_,
        $sel:size:ConnectDirectory' :: DirectorySize
size = DirectorySize
pSize_,
        $sel:connectSettings:ConnectDirectory' :: DirectoryConnectSettings
connectSettings = DirectoryConnectSettings
pConnectSettings_
      }

-- | A description for the directory.
connectDirectory_description :: Lens.Lens' ConnectDirectory (Prelude.Maybe Prelude.Text)
connectDirectory_description :: Lens' ConnectDirectory (Maybe Text)
connectDirectory_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectDirectory' {Maybe Text
description :: Maybe Text
$sel:description:ConnectDirectory' :: ConnectDirectory -> Maybe Text
description} -> Maybe Text
description) (\s :: ConnectDirectory
s@ConnectDirectory' {} Maybe Text
a -> ConnectDirectory
s {$sel:description:ConnectDirectory' :: Maybe Text
description = Maybe Text
a} :: ConnectDirectory)

-- | The NetBIOS name of your self-managed directory, such as @CORP@.
connectDirectory_shortName :: Lens.Lens' ConnectDirectory (Prelude.Maybe Prelude.Text)
connectDirectory_shortName :: Lens' ConnectDirectory (Maybe Text)
connectDirectory_shortName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectDirectory' {Maybe Text
shortName :: Maybe Text
$sel:shortName:ConnectDirectory' :: ConnectDirectory -> Maybe Text
shortName} -> Maybe Text
shortName) (\s :: ConnectDirectory
s@ConnectDirectory' {} Maybe Text
a -> ConnectDirectory
s {$sel:shortName:ConnectDirectory' :: Maybe Text
shortName = Maybe Text
a} :: ConnectDirectory)

-- | The tags to be assigned to AD Connector.
connectDirectory_tags :: Lens.Lens' ConnectDirectory (Prelude.Maybe [Tag])
connectDirectory_tags :: Lens' ConnectDirectory (Maybe [Tag])
connectDirectory_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectDirectory' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ConnectDirectory' :: ConnectDirectory -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ConnectDirectory
s@ConnectDirectory' {} Maybe [Tag]
a -> ConnectDirectory
s {$sel:tags:ConnectDirectory' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ConnectDirectory) 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 fully qualified name of your self-managed directory, such as
-- @corp.example.com@.
connectDirectory_name :: Lens.Lens' ConnectDirectory Prelude.Text
connectDirectory_name :: Lens' ConnectDirectory Text
connectDirectory_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectDirectory' {Text
name :: Text
$sel:name:ConnectDirectory' :: ConnectDirectory -> Text
name} -> Text
name) (\s :: ConnectDirectory
s@ConnectDirectory' {} Text
a -> ConnectDirectory
s {$sel:name:ConnectDirectory' :: Text
name = Text
a} :: ConnectDirectory)

-- | The password for your self-managed user account.
connectDirectory_password :: Lens.Lens' ConnectDirectory Prelude.Text
connectDirectory_password :: Lens' ConnectDirectory Text
connectDirectory_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectDirectory' {Sensitive Text
password :: Sensitive Text
$sel:password:ConnectDirectory' :: ConnectDirectory -> Sensitive Text
password} -> Sensitive Text
password) (\s :: ConnectDirectory
s@ConnectDirectory' {} Sensitive Text
a -> ConnectDirectory
s {$sel:password:ConnectDirectory' :: Sensitive Text
password = Sensitive Text
a} :: ConnectDirectory) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The size of the directory.
connectDirectory_size :: Lens.Lens' ConnectDirectory DirectorySize
connectDirectory_size :: Lens' ConnectDirectory DirectorySize
connectDirectory_size = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectDirectory' {DirectorySize
size :: DirectorySize
$sel:size:ConnectDirectory' :: ConnectDirectory -> DirectorySize
size} -> DirectorySize
size) (\s :: ConnectDirectory
s@ConnectDirectory' {} DirectorySize
a -> ConnectDirectory
s {$sel:size:ConnectDirectory' :: DirectorySize
size = DirectorySize
a} :: ConnectDirectory)

-- | A DirectoryConnectSettings object that contains additional information
-- for the operation.
connectDirectory_connectSettings :: Lens.Lens' ConnectDirectory DirectoryConnectSettings
connectDirectory_connectSettings :: Lens' ConnectDirectory DirectoryConnectSettings
connectDirectory_connectSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectDirectory' {DirectoryConnectSettings
connectSettings :: DirectoryConnectSettings
$sel:connectSettings:ConnectDirectory' :: ConnectDirectory -> DirectoryConnectSettings
connectSettings} -> DirectoryConnectSettings
connectSettings) (\s :: ConnectDirectory
s@ConnectDirectory' {} DirectoryConnectSettings
a -> ConnectDirectory
s {$sel:connectSettings:ConnectDirectory' :: DirectoryConnectSettings
connectSettings = DirectoryConnectSettings
a} :: ConnectDirectory)

instance Core.AWSRequest ConnectDirectory where
  type
    AWSResponse ConnectDirectory =
      ConnectDirectoryResponse
  request :: (Service -> Service)
-> ConnectDirectory -> Request ConnectDirectory
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 ConnectDirectory
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ConnectDirectory)))
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 Text -> Int -> ConnectDirectoryResponse
ConnectDirectoryResponse'
            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
"DirectoryId")
            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 ConnectDirectory where
  hashWithSalt :: Int -> ConnectDirectory -> Int
hashWithSalt Int
_salt ConnectDirectory' {Maybe [Tag]
Maybe Text
Text
Sensitive Text
DirectoryConnectSettings
DirectorySize
connectSettings :: DirectoryConnectSettings
size :: DirectorySize
password :: Sensitive Text
name :: Text
tags :: Maybe [Tag]
shortName :: Maybe Text
description :: Maybe Text
$sel:connectSettings:ConnectDirectory' :: ConnectDirectory -> DirectoryConnectSettings
$sel:size:ConnectDirectory' :: ConnectDirectory -> DirectorySize
$sel:password:ConnectDirectory' :: ConnectDirectory -> Sensitive Text
$sel:name:ConnectDirectory' :: ConnectDirectory -> Text
$sel:tags:ConnectDirectory' :: ConnectDirectory -> Maybe [Tag]
$sel:shortName:ConnectDirectory' :: ConnectDirectory -> Maybe Text
$sel:description:ConnectDirectory' :: ConnectDirectory -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
shortName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
password
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DirectorySize
size
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DirectoryConnectSettings
connectSettings

instance Prelude.NFData ConnectDirectory where
  rnf :: ConnectDirectory -> ()
rnf ConnectDirectory' {Maybe [Tag]
Maybe Text
Text
Sensitive Text
DirectoryConnectSettings
DirectorySize
connectSettings :: DirectoryConnectSettings
size :: DirectorySize
password :: Sensitive Text
name :: Text
tags :: Maybe [Tag]
shortName :: Maybe Text
description :: Maybe Text
$sel:connectSettings:ConnectDirectory' :: ConnectDirectory -> DirectoryConnectSettings
$sel:size:ConnectDirectory' :: ConnectDirectory -> DirectorySize
$sel:password:ConnectDirectory' :: ConnectDirectory -> Sensitive Text
$sel:name:ConnectDirectory' :: ConnectDirectory -> Text
$sel:tags:ConnectDirectory' :: ConnectDirectory -> Maybe [Tag]
$sel:shortName:ConnectDirectory' :: ConnectDirectory -> Maybe Text
$sel:description:ConnectDirectory' :: ConnectDirectory -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
shortName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
password
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DirectorySize
size
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DirectoryConnectSettings
connectSettings

instance Data.ToHeaders ConnectDirectory where
  toHeaders :: ConnectDirectory -> 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.ConnectDirectory" ::
                          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 ConnectDirectory where
  toJSON :: ConnectDirectory -> Value
toJSON ConnectDirectory' {Maybe [Tag]
Maybe Text
Text
Sensitive Text
DirectoryConnectSettings
DirectorySize
connectSettings :: DirectoryConnectSettings
size :: DirectorySize
password :: Sensitive Text
name :: Text
tags :: Maybe [Tag]
shortName :: Maybe Text
description :: Maybe Text
$sel:connectSettings:ConnectDirectory' :: ConnectDirectory -> DirectoryConnectSettings
$sel:size:ConnectDirectory' :: ConnectDirectory -> DirectorySize
$sel:password:ConnectDirectory' :: ConnectDirectory -> Sensitive Text
$sel:name:ConnectDirectory' :: ConnectDirectory -> Text
$sel:tags:ConnectDirectory' :: ConnectDirectory -> Maybe [Tag]
$sel:shortName:ConnectDirectory' :: ConnectDirectory -> Maybe Text
$sel:description:ConnectDirectory' :: ConnectDirectory -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (Key
"ShortName" 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
shortName,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"Password" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
password),
            forall a. a -> Maybe a
Prelude.Just (Key
"Size" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DirectorySize
size),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ConnectSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DirectoryConnectSettings
connectSettings)
          ]
      )

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

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

-- | Contains the results of the ConnectDirectory operation.
--
-- /See:/ 'newConnectDirectoryResponse' smart constructor.
data ConnectDirectoryResponse = ConnectDirectoryResponse'
  { -- | The identifier of the new directory.
    ConnectDirectoryResponse -> Maybe Text
directoryId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ConnectDirectoryResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ConnectDirectoryResponse -> ConnectDirectoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectDirectoryResponse -> ConnectDirectoryResponse -> Bool
$c/= :: ConnectDirectoryResponse -> ConnectDirectoryResponse -> Bool
== :: ConnectDirectoryResponse -> ConnectDirectoryResponse -> Bool
$c== :: ConnectDirectoryResponse -> ConnectDirectoryResponse -> Bool
Prelude.Eq, ReadPrec [ConnectDirectoryResponse]
ReadPrec ConnectDirectoryResponse
Int -> ReadS ConnectDirectoryResponse
ReadS [ConnectDirectoryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConnectDirectoryResponse]
$creadListPrec :: ReadPrec [ConnectDirectoryResponse]
readPrec :: ReadPrec ConnectDirectoryResponse
$creadPrec :: ReadPrec ConnectDirectoryResponse
readList :: ReadS [ConnectDirectoryResponse]
$creadList :: ReadS [ConnectDirectoryResponse]
readsPrec :: Int -> ReadS ConnectDirectoryResponse
$creadsPrec :: Int -> ReadS ConnectDirectoryResponse
Prelude.Read, Int -> ConnectDirectoryResponse -> ShowS
[ConnectDirectoryResponse] -> ShowS
ConnectDirectoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectDirectoryResponse] -> ShowS
$cshowList :: [ConnectDirectoryResponse] -> ShowS
show :: ConnectDirectoryResponse -> String
$cshow :: ConnectDirectoryResponse -> String
showsPrec :: Int -> ConnectDirectoryResponse -> ShowS
$cshowsPrec :: Int -> ConnectDirectoryResponse -> ShowS
Prelude.Show, forall x.
Rep ConnectDirectoryResponse x -> ConnectDirectoryResponse
forall x.
ConnectDirectoryResponse -> Rep ConnectDirectoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ConnectDirectoryResponse x -> ConnectDirectoryResponse
$cfrom :: forall x.
ConnectDirectoryResponse -> Rep ConnectDirectoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'ConnectDirectoryResponse' 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', 'connectDirectoryResponse_directoryId' - The identifier of the new directory.
--
-- 'httpStatus', 'connectDirectoryResponse_httpStatus' - The response's http status code.
newConnectDirectoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ConnectDirectoryResponse
newConnectDirectoryResponse :: Int -> ConnectDirectoryResponse
newConnectDirectoryResponse Int
pHttpStatus_ =
  ConnectDirectoryResponse'
    { $sel:directoryId:ConnectDirectoryResponse' :: Maybe Text
directoryId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ConnectDirectoryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the new directory.
connectDirectoryResponse_directoryId :: Lens.Lens' ConnectDirectoryResponse (Prelude.Maybe Prelude.Text)
connectDirectoryResponse_directoryId :: Lens' ConnectDirectoryResponse (Maybe Text)
connectDirectoryResponse_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectDirectoryResponse' {Maybe Text
directoryId :: Maybe Text
$sel:directoryId:ConnectDirectoryResponse' :: ConnectDirectoryResponse -> Maybe Text
directoryId} -> Maybe Text
directoryId) (\s :: ConnectDirectoryResponse
s@ConnectDirectoryResponse' {} Maybe Text
a -> ConnectDirectoryResponse
s {$sel:directoryId:ConnectDirectoryResponse' :: Maybe Text
directoryId = Maybe Text
a} :: ConnectDirectoryResponse)

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

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