{-# 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.DataSync.CreateLocationFsxWindows
-- 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 endpoint for an Amazon FSx for Windows File Server file
-- system.
module Amazonka.DataSync.CreateLocationFsxWindows
  ( -- * Creating a Request
    CreateLocationFsxWindows (..),
    newCreateLocationFsxWindows,

    -- * Request Lenses
    createLocationFsxWindows_domain,
    createLocationFsxWindows_subdirectory,
    createLocationFsxWindows_tags,
    createLocationFsxWindows_fsxFilesystemArn,
    createLocationFsxWindows_securityGroupArns,
    createLocationFsxWindows_user,
    createLocationFsxWindows_password,

    -- * Destructuring the Response
    CreateLocationFsxWindowsResponse (..),
    newCreateLocationFsxWindowsResponse,

    -- * Response Lenses
    createLocationFsxWindowsResponse_locationArn,
    createLocationFsxWindowsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateLocationFsxWindows' smart constructor.
data CreateLocationFsxWindows = CreateLocationFsxWindows'
  { -- | Specifies the name of the Windows domain that the FSx for Windows File
    -- Server belongs to.
    CreateLocationFsxWindows -> Maybe Text
domain :: Prelude.Maybe Prelude.Text,
    -- | Specifies a mount path for your file system using forward slashes. This
    -- is where DataSync reads or writes data (depending on if this is a source
    -- or destination location).
    CreateLocationFsxWindows -> Maybe Text
subdirectory :: Prelude.Maybe Prelude.Text,
    -- | Specifies labels that help you categorize, filter, and search for your
    -- Amazon Web Services resources. We recommend creating at least a name tag
    -- for your location.
    CreateLocationFsxWindows -> Maybe [TagListEntry]
tags :: Prelude.Maybe [TagListEntry],
    -- | Specifies the Amazon Resource Name (ARN) for the FSx for Windows File
    -- Server file system.
    CreateLocationFsxWindows -> Text
fsxFilesystemArn :: Prelude.Text,
    -- | Specifies the ARNs of the security groups that provide access to your
    -- file system\'s preferred subnet.
    --
    -- If you choose a security group that doesn\'t allow connections from
    -- within itself, do one of the following:
    --
    -- -   Configure the security group to allow it to communicate within
    --     itself.
    --
    -- -   Choose a different security group that can communicate with the
    --     mount target\'s security group.
    CreateLocationFsxWindows -> NonEmpty Text
securityGroupArns :: Prelude.NonEmpty Prelude.Text,
    -- | Specifies the user who has the permissions to access files and folders
    -- in the file system.
    --
    -- For information about choosing a user name that ensures sufficient
    -- permissions to files, folders, and metadata, see
    -- <create-fsx-location.html#FSxWuser user>.
    CreateLocationFsxWindows -> Text
user :: Prelude.Text,
    -- | Specifies the password of the user who has the permissions to access
    -- files and folders in the file system.
    CreateLocationFsxWindows -> Sensitive Text
password :: Data.Sensitive Prelude.Text
  }
  deriving (CreateLocationFsxWindows -> CreateLocationFsxWindows -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLocationFsxWindows -> CreateLocationFsxWindows -> Bool
$c/= :: CreateLocationFsxWindows -> CreateLocationFsxWindows -> Bool
== :: CreateLocationFsxWindows -> CreateLocationFsxWindows -> Bool
$c== :: CreateLocationFsxWindows -> CreateLocationFsxWindows -> Bool
Prelude.Eq, Int -> CreateLocationFsxWindows -> ShowS
[CreateLocationFsxWindows] -> ShowS
CreateLocationFsxWindows -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLocationFsxWindows] -> ShowS
$cshowList :: [CreateLocationFsxWindows] -> ShowS
show :: CreateLocationFsxWindows -> String
$cshow :: CreateLocationFsxWindows -> String
showsPrec :: Int -> CreateLocationFsxWindows -> ShowS
$cshowsPrec :: Int -> CreateLocationFsxWindows -> ShowS
Prelude.Show, forall x.
Rep CreateLocationFsxWindows x -> CreateLocationFsxWindows
forall x.
CreateLocationFsxWindows -> Rep CreateLocationFsxWindows x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateLocationFsxWindows x -> CreateLocationFsxWindows
$cfrom :: forall x.
CreateLocationFsxWindows -> Rep CreateLocationFsxWindows x
Prelude.Generic)

-- |
-- Create a value of 'CreateLocationFsxWindows' 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:
--
-- 'domain', 'createLocationFsxWindows_domain' - Specifies the name of the Windows domain that the FSx for Windows File
-- Server belongs to.
--
-- 'subdirectory', 'createLocationFsxWindows_subdirectory' - Specifies a mount path for your file system using forward slashes. This
-- is where DataSync reads or writes data (depending on if this is a source
-- or destination location).
--
-- 'tags', 'createLocationFsxWindows_tags' - Specifies labels that help you categorize, filter, and search for your
-- Amazon Web Services resources. We recommend creating at least a name tag
-- for your location.
--
-- 'fsxFilesystemArn', 'createLocationFsxWindows_fsxFilesystemArn' - Specifies the Amazon Resource Name (ARN) for the FSx for Windows File
-- Server file system.
--
-- 'securityGroupArns', 'createLocationFsxWindows_securityGroupArns' - Specifies the ARNs of the security groups that provide access to your
-- file system\'s preferred subnet.
--
-- If you choose a security group that doesn\'t allow connections from
-- within itself, do one of the following:
--
-- -   Configure the security group to allow it to communicate within
--     itself.
--
-- -   Choose a different security group that can communicate with the
--     mount target\'s security group.
--
-- 'user', 'createLocationFsxWindows_user' - Specifies the user who has the permissions to access files and folders
-- in the file system.
--
-- For information about choosing a user name that ensures sufficient
-- permissions to files, folders, and metadata, see
-- <create-fsx-location.html#FSxWuser user>.
--
-- 'password', 'createLocationFsxWindows_password' - Specifies the password of the user who has the permissions to access
-- files and folders in the file system.
newCreateLocationFsxWindows ::
  -- | 'fsxFilesystemArn'
  Prelude.Text ->
  -- | 'securityGroupArns'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'user'
  Prelude.Text ->
  -- | 'password'
  Prelude.Text ->
  CreateLocationFsxWindows
newCreateLocationFsxWindows :: Text -> NonEmpty Text -> Text -> Text -> CreateLocationFsxWindows
newCreateLocationFsxWindows
  Text
pFsxFilesystemArn_
  NonEmpty Text
pSecurityGroupArns_
  Text
pUser_
  Text
pPassword_ =
    CreateLocationFsxWindows'
      { $sel:domain:CreateLocationFsxWindows' :: Maybe Text
domain = forall a. Maybe a
Prelude.Nothing,
        $sel:subdirectory:CreateLocationFsxWindows' :: Maybe Text
subdirectory = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateLocationFsxWindows' :: Maybe [TagListEntry]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:fsxFilesystemArn:CreateLocationFsxWindows' :: Text
fsxFilesystemArn = Text
pFsxFilesystemArn_,
        $sel:securityGroupArns:CreateLocationFsxWindows' :: NonEmpty Text
securityGroupArns =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pSecurityGroupArns_,
        $sel:user:CreateLocationFsxWindows' :: Text
user = Text
pUser_,
        $sel:password:CreateLocationFsxWindows' :: Sensitive Text
password = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPassword_
      }

-- | Specifies the name of the Windows domain that the FSx for Windows File
-- Server belongs to.
createLocationFsxWindows_domain :: Lens.Lens' CreateLocationFsxWindows (Prelude.Maybe Prelude.Text)
createLocationFsxWindows_domain :: Lens' CreateLocationFsxWindows (Maybe Text)
createLocationFsxWindows_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxWindows' {Maybe Text
domain :: Maybe Text
$sel:domain:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Maybe Text
domain} -> Maybe Text
domain) (\s :: CreateLocationFsxWindows
s@CreateLocationFsxWindows' {} Maybe Text
a -> CreateLocationFsxWindows
s {$sel:domain:CreateLocationFsxWindows' :: Maybe Text
domain = Maybe Text
a} :: CreateLocationFsxWindows)

-- | Specifies a mount path for your file system using forward slashes. This
-- is where DataSync reads or writes data (depending on if this is a source
-- or destination location).
createLocationFsxWindows_subdirectory :: Lens.Lens' CreateLocationFsxWindows (Prelude.Maybe Prelude.Text)
createLocationFsxWindows_subdirectory :: Lens' CreateLocationFsxWindows (Maybe Text)
createLocationFsxWindows_subdirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxWindows' {Maybe Text
subdirectory :: Maybe Text
$sel:subdirectory:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Maybe Text
subdirectory} -> Maybe Text
subdirectory) (\s :: CreateLocationFsxWindows
s@CreateLocationFsxWindows' {} Maybe Text
a -> CreateLocationFsxWindows
s {$sel:subdirectory:CreateLocationFsxWindows' :: Maybe Text
subdirectory = Maybe Text
a} :: CreateLocationFsxWindows)

-- | Specifies labels that help you categorize, filter, and search for your
-- Amazon Web Services resources. We recommend creating at least a name tag
-- for your location.
createLocationFsxWindows_tags :: Lens.Lens' CreateLocationFsxWindows (Prelude.Maybe [TagListEntry])
createLocationFsxWindows_tags :: Lens' CreateLocationFsxWindows (Maybe [TagListEntry])
createLocationFsxWindows_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxWindows' {Maybe [TagListEntry]
tags :: Maybe [TagListEntry]
$sel:tags:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Maybe [TagListEntry]
tags} -> Maybe [TagListEntry]
tags) (\s :: CreateLocationFsxWindows
s@CreateLocationFsxWindows' {} Maybe [TagListEntry]
a -> CreateLocationFsxWindows
s {$sel:tags:CreateLocationFsxWindows' :: Maybe [TagListEntry]
tags = Maybe [TagListEntry]
a} :: CreateLocationFsxWindows) 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

-- | Specifies the Amazon Resource Name (ARN) for the FSx for Windows File
-- Server file system.
createLocationFsxWindows_fsxFilesystemArn :: Lens.Lens' CreateLocationFsxWindows Prelude.Text
createLocationFsxWindows_fsxFilesystemArn :: Lens' CreateLocationFsxWindows Text
createLocationFsxWindows_fsxFilesystemArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxWindows' {Text
fsxFilesystemArn :: Text
$sel:fsxFilesystemArn:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Text
fsxFilesystemArn} -> Text
fsxFilesystemArn) (\s :: CreateLocationFsxWindows
s@CreateLocationFsxWindows' {} Text
a -> CreateLocationFsxWindows
s {$sel:fsxFilesystemArn:CreateLocationFsxWindows' :: Text
fsxFilesystemArn = Text
a} :: CreateLocationFsxWindows)

-- | Specifies the ARNs of the security groups that provide access to your
-- file system\'s preferred subnet.
--
-- If you choose a security group that doesn\'t allow connections from
-- within itself, do one of the following:
--
-- -   Configure the security group to allow it to communicate within
--     itself.
--
-- -   Choose a different security group that can communicate with the
--     mount target\'s security group.
createLocationFsxWindows_securityGroupArns :: Lens.Lens' CreateLocationFsxWindows (Prelude.NonEmpty Prelude.Text)
createLocationFsxWindows_securityGroupArns :: Lens' CreateLocationFsxWindows (NonEmpty Text)
createLocationFsxWindows_securityGroupArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxWindows' {NonEmpty Text
securityGroupArns :: NonEmpty Text
$sel:securityGroupArns:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> NonEmpty Text
securityGroupArns} -> NonEmpty Text
securityGroupArns) (\s :: CreateLocationFsxWindows
s@CreateLocationFsxWindows' {} NonEmpty Text
a -> CreateLocationFsxWindows
s {$sel:securityGroupArns:CreateLocationFsxWindows' :: NonEmpty Text
securityGroupArns = NonEmpty Text
a} :: CreateLocationFsxWindows) 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

-- | Specifies the user who has the permissions to access files and folders
-- in the file system.
--
-- For information about choosing a user name that ensures sufficient
-- permissions to files, folders, and metadata, see
-- <create-fsx-location.html#FSxWuser user>.
createLocationFsxWindows_user :: Lens.Lens' CreateLocationFsxWindows Prelude.Text
createLocationFsxWindows_user :: Lens' CreateLocationFsxWindows Text
createLocationFsxWindows_user = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxWindows' {Text
user :: Text
$sel:user:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Text
user} -> Text
user) (\s :: CreateLocationFsxWindows
s@CreateLocationFsxWindows' {} Text
a -> CreateLocationFsxWindows
s {$sel:user:CreateLocationFsxWindows' :: Text
user = Text
a} :: CreateLocationFsxWindows)

-- | Specifies the password of the user who has the permissions to access
-- files and folders in the file system.
createLocationFsxWindows_password :: Lens.Lens' CreateLocationFsxWindows Prelude.Text
createLocationFsxWindows_password :: Lens' CreateLocationFsxWindows Text
createLocationFsxWindows_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxWindows' {Sensitive Text
password :: Sensitive Text
$sel:password:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Sensitive Text
password} -> Sensitive Text
password) (\s :: CreateLocationFsxWindows
s@CreateLocationFsxWindows' {} Sensitive Text
a -> CreateLocationFsxWindows
s {$sel:password:CreateLocationFsxWindows' :: Sensitive Text
password = Sensitive Text
a} :: CreateLocationFsxWindows) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest CreateLocationFsxWindows where
  type
    AWSResponse CreateLocationFsxWindows =
      CreateLocationFsxWindowsResponse
  request :: (Service -> Service)
-> CreateLocationFsxWindows -> Request CreateLocationFsxWindows
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 CreateLocationFsxWindows
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLocationFsxWindows)))
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 -> CreateLocationFsxWindowsResponse
CreateLocationFsxWindowsResponse'
            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
"LocationArn")
            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 CreateLocationFsxWindows where
  hashWithSalt :: Int -> CreateLocationFsxWindows -> Int
hashWithSalt Int
_salt CreateLocationFsxWindows' {Maybe [TagListEntry]
Maybe Text
NonEmpty Text
Text
Sensitive Text
password :: Sensitive Text
user :: Text
securityGroupArns :: NonEmpty Text
fsxFilesystemArn :: Text
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
domain :: Maybe Text
$sel:password:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Sensitive Text
$sel:user:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Text
$sel:securityGroupArns:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> NonEmpty Text
$sel:fsxFilesystemArn:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Text
$sel:tags:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Maybe Text
$sel:domain:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subdirectory
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagListEntry]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fsxFilesystemArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
securityGroupArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
user
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
password

instance Prelude.NFData CreateLocationFsxWindows where
  rnf :: CreateLocationFsxWindows -> ()
rnf CreateLocationFsxWindows' {Maybe [TagListEntry]
Maybe Text
NonEmpty Text
Text
Sensitive Text
password :: Sensitive Text
user :: Text
securityGroupArns :: NonEmpty Text
fsxFilesystemArn :: Text
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
domain :: Maybe Text
$sel:password:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Sensitive Text
$sel:user:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Text
$sel:securityGroupArns:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> NonEmpty Text
$sel:fsxFilesystemArn:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Text
$sel:tags:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Maybe Text
$sel:domain:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subdirectory
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagListEntry]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fsxFilesystemArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
securityGroupArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
user
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
password

instance Data.ToHeaders CreateLocationFsxWindows where
  toHeaders :: CreateLocationFsxWindows -> 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
"FmrsService.CreateLocationFsxWindows" ::
                          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 CreateLocationFsxWindows where
  toJSON :: CreateLocationFsxWindows -> Value
toJSON CreateLocationFsxWindows' {Maybe [TagListEntry]
Maybe Text
NonEmpty Text
Text
Sensitive Text
password :: Sensitive Text
user :: Text
securityGroupArns :: NonEmpty Text
fsxFilesystemArn :: Text
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
domain :: Maybe Text
$sel:password:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Sensitive Text
$sel:user:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Text
$sel:securityGroupArns:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> NonEmpty Text
$sel:fsxFilesystemArn:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Text
$sel:tags:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Maybe Text
$sel:domain:CreateLocationFsxWindows' :: CreateLocationFsxWindows -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Domain" 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
domain,
            (Key
"Subdirectory" 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
subdirectory,
            (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 [TagListEntry]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"FsxFilesystemArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fsxFilesystemArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SecurityGroupArns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
securityGroupArns),
            forall a. a -> Maybe a
Prelude.Just (Key
"User" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
user),
            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 CreateLocationFsxWindows where
  toPath :: CreateLocationFsxWindows -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newCreateLocationFsxWindowsResponse' smart constructor.
data CreateLocationFsxWindowsResponse = CreateLocationFsxWindowsResponse'
  { -- | The ARN of the FSx for Windows File Server file system location you
    -- created.
    CreateLocationFsxWindowsResponse -> Maybe Text
locationArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateLocationFsxWindowsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateLocationFsxWindowsResponse
-> CreateLocationFsxWindowsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLocationFsxWindowsResponse
-> CreateLocationFsxWindowsResponse -> Bool
$c/= :: CreateLocationFsxWindowsResponse
-> CreateLocationFsxWindowsResponse -> Bool
== :: CreateLocationFsxWindowsResponse
-> CreateLocationFsxWindowsResponse -> Bool
$c== :: CreateLocationFsxWindowsResponse
-> CreateLocationFsxWindowsResponse -> Bool
Prelude.Eq, ReadPrec [CreateLocationFsxWindowsResponse]
ReadPrec CreateLocationFsxWindowsResponse
Int -> ReadS CreateLocationFsxWindowsResponse
ReadS [CreateLocationFsxWindowsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLocationFsxWindowsResponse]
$creadListPrec :: ReadPrec [CreateLocationFsxWindowsResponse]
readPrec :: ReadPrec CreateLocationFsxWindowsResponse
$creadPrec :: ReadPrec CreateLocationFsxWindowsResponse
readList :: ReadS [CreateLocationFsxWindowsResponse]
$creadList :: ReadS [CreateLocationFsxWindowsResponse]
readsPrec :: Int -> ReadS CreateLocationFsxWindowsResponse
$creadsPrec :: Int -> ReadS CreateLocationFsxWindowsResponse
Prelude.Read, Int -> CreateLocationFsxWindowsResponse -> ShowS
[CreateLocationFsxWindowsResponse] -> ShowS
CreateLocationFsxWindowsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLocationFsxWindowsResponse] -> ShowS
$cshowList :: [CreateLocationFsxWindowsResponse] -> ShowS
show :: CreateLocationFsxWindowsResponse -> String
$cshow :: CreateLocationFsxWindowsResponse -> String
showsPrec :: Int -> CreateLocationFsxWindowsResponse -> ShowS
$cshowsPrec :: Int -> CreateLocationFsxWindowsResponse -> ShowS
Prelude.Show, forall x.
Rep CreateLocationFsxWindowsResponse x
-> CreateLocationFsxWindowsResponse
forall x.
CreateLocationFsxWindowsResponse
-> Rep CreateLocationFsxWindowsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateLocationFsxWindowsResponse x
-> CreateLocationFsxWindowsResponse
$cfrom :: forall x.
CreateLocationFsxWindowsResponse
-> Rep CreateLocationFsxWindowsResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateLocationFsxWindowsResponse' 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:
--
-- 'locationArn', 'createLocationFsxWindowsResponse_locationArn' - The ARN of the FSx for Windows File Server file system location you
-- created.
--
-- 'httpStatus', 'createLocationFsxWindowsResponse_httpStatus' - The response's http status code.
newCreateLocationFsxWindowsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLocationFsxWindowsResponse
newCreateLocationFsxWindowsResponse :: Int -> CreateLocationFsxWindowsResponse
newCreateLocationFsxWindowsResponse Int
pHttpStatus_ =
  CreateLocationFsxWindowsResponse'
    { $sel:locationArn:CreateLocationFsxWindowsResponse' :: Maybe Text
locationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLocationFsxWindowsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the FSx for Windows File Server file system location you
-- created.
createLocationFsxWindowsResponse_locationArn :: Lens.Lens' CreateLocationFsxWindowsResponse (Prelude.Maybe Prelude.Text)
createLocationFsxWindowsResponse_locationArn :: Lens' CreateLocationFsxWindowsResponse (Maybe Text)
createLocationFsxWindowsResponse_locationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxWindowsResponse' {Maybe Text
locationArn :: Maybe Text
$sel:locationArn:CreateLocationFsxWindowsResponse' :: CreateLocationFsxWindowsResponse -> Maybe Text
locationArn} -> Maybe Text
locationArn) (\s :: CreateLocationFsxWindowsResponse
s@CreateLocationFsxWindowsResponse' {} Maybe Text
a -> CreateLocationFsxWindowsResponse
s {$sel:locationArn:CreateLocationFsxWindowsResponse' :: Maybe Text
locationArn = Maybe Text
a} :: CreateLocationFsxWindowsResponse)

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

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