{-# 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.AssociateFileSystem
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associate an Amazon FSx file system with the FSx File Gateway. After the
-- association process is complete, the file shares on the Amazon FSx file
-- system are available for access through the gateway. This operation only
-- supports the FSx File Gateway type.
module Amazonka.StorageGateway.AssociateFileSystem
  ( -- * Creating a Request
    AssociateFileSystem (..),
    newAssociateFileSystem,

    -- * Request Lenses
    associateFileSystem_auditDestinationARN,
    associateFileSystem_cacheAttributes,
    associateFileSystem_endpointNetworkConfiguration,
    associateFileSystem_tags,
    associateFileSystem_userName,
    associateFileSystem_password,
    associateFileSystem_clientToken,
    associateFileSystem_gatewayARN,
    associateFileSystem_locationARN,

    -- * Destructuring the Response
    AssociateFileSystemResponse (..),
    newAssociateFileSystemResponse,

    -- * Response Lenses
    associateFileSystemResponse_fileSystemAssociationARN,
    associateFileSystemResponse_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

-- | /See:/ 'newAssociateFileSystem' smart constructor.
data AssociateFileSystem = AssociateFileSystem'
  { -- | The Amazon Resource Name (ARN) of the storage used for the audit logs.
    AssociateFileSystem -> Maybe Text
auditDestinationARN :: Prelude.Maybe Prelude.Text,
    AssociateFileSystem -> Maybe CacheAttributes
cacheAttributes :: Prelude.Maybe CacheAttributes,
    -- | Specifies the network configuration information for the gateway
    -- associated with the Amazon FSx file system.
    --
    -- If multiple file systems are associated with this gateway, this
    -- parameter\'s @IpAddresses@ field is required.
    AssociateFileSystem -> Maybe EndpointNetworkConfiguration
endpointNetworkConfiguration :: Prelude.Maybe EndpointNetworkConfiguration,
    -- | A list of up to 50 tags that can be assigned to the file system
    -- association. Each tag is a key-value pair.
    AssociateFileSystem -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The user name of the user credential that has permission to access the
    -- root share D$ of the Amazon FSx file system. The user account must
    -- belong to the Amazon FSx delegated admin user group.
    AssociateFileSystem -> Text
userName :: Prelude.Text,
    -- | The password of the user credential.
    AssociateFileSystem -> Sensitive Text
password :: Data.Sensitive Prelude.Text,
    -- | A unique string value that you supply that is used by the FSx File
    -- Gateway to ensure idempotent file system association creation.
    AssociateFileSystem -> Text
clientToken :: Prelude.Text,
    AssociateFileSystem -> Text
gatewayARN :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Amazon FSx file system to
    -- associate with the FSx File Gateway.
    AssociateFileSystem -> Text
locationARN :: Prelude.Text
  }
  deriving (AssociateFileSystem -> AssociateFileSystem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateFileSystem -> AssociateFileSystem -> Bool
$c/= :: AssociateFileSystem -> AssociateFileSystem -> Bool
== :: AssociateFileSystem -> AssociateFileSystem -> Bool
$c== :: AssociateFileSystem -> AssociateFileSystem -> Bool
Prelude.Eq, Int -> AssociateFileSystem -> ShowS
[AssociateFileSystem] -> ShowS
AssociateFileSystem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateFileSystem] -> ShowS
$cshowList :: [AssociateFileSystem] -> ShowS
show :: AssociateFileSystem -> String
$cshow :: AssociateFileSystem -> String
showsPrec :: Int -> AssociateFileSystem -> ShowS
$cshowsPrec :: Int -> AssociateFileSystem -> ShowS
Prelude.Show, forall x. Rep AssociateFileSystem x -> AssociateFileSystem
forall x. AssociateFileSystem -> Rep AssociateFileSystem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateFileSystem x -> AssociateFileSystem
$cfrom :: forall x. AssociateFileSystem -> Rep AssociateFileSystem x
Prelude.Generic)

-- |
-- Create a value of 'AssociateFileSystem' 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:
--
-- 'auditDestinationARN', 'associateFileSystem_auditDestinationARN' - The Amazon Resource Name (ARN) of the storage used for the audit logs.
--
-- 'cacheAttributes', 'associateFileSystem_cacheAttributes' - Undocumented member.
--
-- 'endpointNetworkConfiguration', 'associateFileSystem_endpointNetworkConfiguration' - Specifies the network configuration information for the gateway
-- associated with the Amazon FSx file system.
--
-- If multiple file systems are associated with this gateway, this
-- parameter\'s @IpAddresses@ field is required.
--
-- 'tags', 'associateFileSystem_tags' - A list of up to 50 tags that can be assigned to the file system
-- association. Each tag is a key-value pair.
--
-- 'userName', 'associateFileSystem_userName' - The user name of the user credential that has permission to access the
-- root share D$ of the Amazon FSx file system. The user account must
-- belong to the Amazon FSx delegated admin user group.
--
-- 'password', 'associateFileSystem_password' - The password of the user credential.
--
-- 'clientToken', 'associateFileSystem_clientToken' - A unique string value that you supply that is used by the FSx File
-- Gateway to ensure idempotent file system association creation.
--
-- 'gatewayARN', 'associateFileSystem_gatewayARN' - Undocumented member.
--
-- 'locationARN', 'associateFileSystem_locationARN' - The Amazon Resource Name (ARN) of the Amazon FSx file system to
-- associate with the FSx File Gateway.
newAssociateFileSystem ::
  -- | 'userName'
  Prelude.Text ->
  -- | 'password'
  Prelude.Text ->
  -- | 'clientToken'
  Prelude.Text ->
  -- | 'gatewayARN'
  Prelude.Text ->
  -- | 'locationARN'
  Prelude.Text ->
  AssociateFileSystem
newAssociateFileSystem :: Text -> Text -> Text -> Text -> Text -> AssociateFileSystem
newAssociateFileSystem
  Text
pUserName_
  Text
pPassword_
  Text
pClientToken_
  Text
pGatewayARN_
  Text
pLocationARN_ =
    AssociateFileSystem'
      { $sel:auditDestinationARN:AssociateFileSystem' :: Maybe Text
auditDestinationARN =
          forall a. Maybe a
Prelude.Nothing,
        $sel:cacheAttributes:AssociateFileSystem' :: Maybe CacheAttributes
cacheAttributes = forall a. Maybe a
Prelude.Nothing,
        $sel:endpointNetworkConfiguration:AssociateFileSystem' :: Maybe EndpointNetworkConfiguration
endpointNetworkConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:AssociateFileSystem' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:userName:AssociateFileSystem' :: Text
userName = Text
pUserName_,
        $sel:password:AssociateFileSystem' :: Sensitive Text
password = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPassword_,
        $sel:clientToken:AssociateFileSystem' :: Text
clientToken = Text
pClientToken_,
        $sel:gatewayARN:AssociateFileSystem' :: Text
gatewayARN = Text
pGatewayARN_,
        $sel:locationARN:AssociateFileSystem' :: Text
locationARN = Text
pLocationARN_
      }

-- | The Amazon Resource Name (ARN) of the storage used for the audit logs.
associateFileSystem_auditDestinationARN :: Lens.Lens' AssociateFileSystem (Prelude.Maybe Prelude.Text)
associateFileSystem_auditDestinationARN :: Lens' AssociateFileSystem (Maybe Text)
associateFileSystem_auditDestinationARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateFileSystem' {Maybe Text
auditDestinationARN :: Maybe Text
$sel:auditDestinationARN:AssociateFileSystem' :: AssociateFileSystem -> Maybe Text
auditDestinationARN} -> Maybe Text
auditDestinationARN) (\s :: AssociateFileSystem
s@AssociateFileSystem' {} Maybe Text
a -> AssociateFileSystem
s {$sel:auditDestinationARN:AssociateFileSystem' :: Maybe Text
auditDestinationARN = Maybe Text
a} :: AssociateFileSystem)

-- | Undocumented member.
associateFileSystem_cacheAttributes :: Lens.Lens' AssociateFileSystem (Prelude.Maybe CacheAttributes)
associateFileSystem_cacheAttributes :: Lens' AssociateFileSystem (Maybe CacheAttributes)
associateFileSystem_cacheAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateFileSystem' {Maybe CacheAttributes
cacheAttributes :: Maybe CacheAttributes
$sel:cacheAttributes:AssociateFileSystem' :: AssociateFileSystem -> Maybe CacheAttributes
cacheAttributes} -> Maybe CacheAttributes
cacheAttributes) (\s :: AssociateFileSystem
s@AssociateFileSystem' {} Maybe CacheAttributes
a -> AssociateFileSystem
s {$sel:cacheAttributes:AssociateFileSystem' :: Maybe CacheAttributes
cacheAttributes = Maybe CacheAttributes
a} :: AssociateFileSystem)

-- | Specifies the network configuration information for the gateway
-- associated with the Amazon FSx file system.
--
-- If multiple file systems are associated with this gateway, this
-- parameter\'s @IpAddresses@ field is required.
associateFileSystem_endpointNetworkConfiguration :: Lens.Lens' AssociateFileSystem (Prelude.Maybe EndpointNetworkConfiguration)
associateFileSystem_endpointNetworkConfiguration :: Lens' AssociateFileSystem (Maybe EndpointNetworkConfiguration)
associateFileSystem_endpointNetworkConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateFileSystem' {Maybe EndpointNetworkConfiguration
endpointNetworkConfiguration :: Maybe EndpointNetworkConfiguration
$sel:endpointNetworkConfiguration:AssociateFileSystem' :: AssociateFileSystem -> Maybe EndpointNetworkConfiguration
endpointNetworkConfiguration} -> Maybe EndpointNetworkConfiguration
endpointNetworkConfiguration) (\s :: AssociateFileSystem
s@AssociateFileSystem' {} Maybe EndpointNetworkConfiguration
a -> AssociateFileSystem
s {$sel:endpointNetworkConfiguration:AssociateFileSystem' :: Maybe EndpointNetworkConfiguration
endpointNetworkConfiguration = Maybe EndpointNetworkConfiguration
a} :: AssociateFileSystem)

-- | A list of up to 50 tags that can be assigned to the file system
-- association. Each tag is a key-value pair.
associateFileSystem_tags :: Lens.Lens' AssociateFileSystem (Prelude.Maybe [Tag])
associateFileSystem_tags :: Lens' AssociateFileSystem (Maybe [Tag])
associateFileSystem_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateFileSystem' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:AssociateFileSystem' :: AssociateFileSystem -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: AssociateFileSystem
s@AssociateFileSystem' {} Maybe [Tag]
a -> AssociateFileSystem
s {$sel:tags:AssociateFileSystem' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: AssociateFileSystem) 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 user name of the user credential that has permission to access the
-- root share D$ of the Amazon FSx file system. The user account must
-- belong to the Amazon FSx delegated admin user group.
associateFileSystem_userName :: Lens.Lens' AssociateFileSystem Prelude.Text
associateFileSystem_userName :: Lens' AssociateFileSystem Text
associateFileSystem_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateFileSystem' {Text
userName :: Text
$sel:userName:AssociateFileSystem' :: AssociateFileSystem -> Text
userName} -> Text
userName) (\s :: AssociateFileSystem
s@AssociateFileSystem' {} Text
a -> AssociateFileSystem
s {$sel:userName:AssociateFileSystem' :: Text
userName = Text
a} :: AssociateFileSystem)

-- | The password of the user credential.
associateFileSystem_password :: Lens.Lens' AssociateFileSystem Prelude.Text
associateFileSystem_password :: Lens' AssociateFileSystem Text
associateFileSystem_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateFileSystem' {Sensitive Text
password :: Sensitive Text
$sel:password:AssociateFileSystem' :: AssociateFileSystem -> Sensitive Text
password} -> Sensitive Text
password) (\s :: AssociateFileSystem
s@AssociateFileSystem' {} Sensitive Text
a -> AssociateFileSystem
s {$sel:password:AssociateFileSystem' :: Sensitive Text
password = Sensitive Text
a} :: AssociateFileSystem) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | A unique string value that you supply that is used by the FSx File
-- Gateway to ensure idempotent file system association creation.
associateFileSystem_clientToken :: Lens.Lens' AssociateFileSystem Prelude.Text
associateFileSystem_clientToken :: Lens' AssociateFileSystem Text
associateFileSystem_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateFileSystem' {Text
clientToken :: Text
$sel:clientToken:AssociateFileSystem' :: AssociateFileSystem -> Text
clientToken} -> Text
clientToken) (\s :: AssociateFileSystem
s@AssociateFileSystem' {} Text
a -> AssociateFileSystem
s {$sel:clientToken:AssociateFileSystem' :: Text
clientToken = Text
a} :: AssociateFileSystem)

-- | Undocumented member.
associateFileSystem_gatewayARN :: Lens.Lens' AssociateFileSystem Prelude.Text
associateFileSystem_gatewayARN :: Lens' AssociateFileSystem Text
associateFileSystem_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateFileSystem' {Text
gatewayARN :: Text
$sel:gatewayARN:AssociateFileSystem' :: AssociateFileSystem -> Text
gatewayARN} -> Text
gatewayARN) (\s :: AssociateFileSystem
s@AssociateFileSystem' {} Text
a -> AssociateFileSystem
s {$sel:gatewayARN:AssociateFileSystem' :: Text
gatewayARN = Text
a} :: AssociateFileSystem)

-- | The Amazon Resource Name (ARN) of the Amazon FSx file system to
-- associate with the FSx File Gateway.
associateFileSystem_locationARN :: Lens.Lens' AssociateFileSystem Prelude.Text
associateFileSystem_locationARN :: Lens' AssociateFileSystem Text
associateFileSystem_locationARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateFileSystem' {Text
locationARN :: Text
$sel:locationARN:AssociateFileSystem' :: AssociateFileSystem -> Text
locationARN} -> Text
locationARN) (\s :: AssociateFileSystem
s@AssociateFileSystem' {} Text
a -> AssociateFileSystem
s {$sel:locationARN:AssociateFileSystem' :: Text
locationARN = Text
a} :: AssociateFileSystem)

instance Core.AWSRequest AssociateFileSystem where
  type
    AWSResponse AssociateFileSystem =
      AssociateFileSystemResponse
  request :: (Service -> Service)
-> AssociateFileSystem -> Request AssociateFileSystem
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 AssociateFileSystem
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AssociateFileSystem)))
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 -> AssociateFileSystemResponse
AssociateFileSystemResponse'
            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
"FileSystemAssociationARN")
            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 AssociateFileSystem where
  hashWithSalt :: Int -> AssociateFileSystem -> Int
hashWithSalt Int
_salt AssociateFileSystem' {Maybe [Tag]
Maybe Text
Maybe CacheAttributes
Maybe EndpointNetworkConfiguration
Text
Sensitive Text
locationARN :: Text
gatewayARN :: Text
clientToken :: Text
password :: Sensitive Text
userName :: Text
tags :: Maybe [Tag]
endpointNetworkConfiguration :: Maybe EndpointNetworkConfiguration
cacheAttributes :: Maybe CacheAttributes
auditDestinationARN :: Maybe Text
$sel:locationARN:AssociateFileSystem' :: AssociateFileSystem -> Text
$sel:gatewayARN:AssociateFileSystem' :: AssociateFileSystem -> Text
$sel:clientToken:AssociateFileSystem' :: AssociateFileSystem -> Text
$sel:password:AssociateFileSystem' :: AssociateFileSystem -> Sensitive Text
$sel:userName:AssociateFileSystem' :: AssociateFileSystem -> Text
$sel:tags:AssociateFileSystem' :: AssociateFileSystem -> Maybe [Tag]
$sel:endpointNetworkConfiguration:AssociateFileSystem' :: AssociateFileSystem -> Maybe EndpointNetworkConfiguration
$sel:cacheAttributes:AssociateFileSystem' :: AssociateFileSystem -> Maybe CacheAttributes
$sel:auditDestinationARN:AssociateFileSystem' :: AssociateFileSystem -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
auditDestinationARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CacheAttributes
cacheAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndpointNetworkConfiguration
endpointNetworkConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
password
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
locationARN

instance Prelude.NFData AssociateFileSystem where
  rnf :: AssociateFileSystem -> ()
rnf AssociateFileSystem' {Maybe [Tag]
Maybe Text
Maybe CacheAttributes
Maybe EndpointNetworkConfiguration
Text
Sensitive Text
locationARN :: Text
gatewayARN :: Text
clientToken :: Text
password :: Sensitive Text
userName :: Text
tags :: Maybe [Tag]
endpointNetworkConfiguration :: Maybe EndpointNetworkConfiguration
cacheAttributes :: Maybe CacheAttributes
auditDestinationARN :: Maybe Text
$sel:locationARN:AssociateFileSystem' :: AssociateFileSystem -> Text
$sel:gatewayARN:AssociateFileSystem' :: AssociateFileSystem -> Text
$sel:clientToken:AssociateFileSystem' :: AssociateFileSystem -> Text
$sel:password:AssociateFileSystem' :: AssociateFileSystem -> Sensitive Text
$sel:userName:AssociateFileSystem' :: AssociateFileSystem -> Text
$sel:tags:AssociateFileSystem' :: AssociateFileSystem -> Maybe [Tag]
$sel:endpointNetworkConfiguration:AssociateFileSystem' :: AssociateFileSystem -> Maybe EndpointNetworkConfiguration
$sel:cacheAttributes:AssociateFileSystem' :: AssociateFileSystem -> Maybe CacheAttributes
$sel:auditDestinationARN:AssociateFileSystem' :: AssociateFileSystem -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
auditDestinationARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CacheAttributes
cacheAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EndpointNetworkConfiguration
endpointNetworkConfiguration
      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
userName
      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 Text
clientToken
      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
locationARN

instance Data.ToHeaders AssociateFileSystem where
  toHeaders :: AssociateFileSystem -> 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.AssociateFileSystem" ::
                          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 AssociateFileSystem where
  toJSON :: AssociateFileSystem -> Value
toJSON AssociateFileSystem' {Maybe [Tag]
Maybe Text
Maybe CacheAttributes
Maybe EndpointNetworkConfiguration
Text
Sensitive Text
locationARN :: Text
gatewayARN :: Text
clientToken :: Text
password :: Sensitive Text
userName :: Text
tags :: Maybe [Tag]
endpointNetworkConfiguration :: Maybe EndpointNetworkConfiguration
cacheAttributes :: Maybe CacheAttributes
auditDestinationARN :: Maybe Text
$sel:locationARN:AssociateFileSystem' :: AssociateFileSystem -> Text
$sel:gatewayARN:AssociateFileSystem' :: AssociateFileSystem -> Text
$sel:clientToken:AssociateFileSystem' :: AssociateFileSystem -> Text
$sel:password:AssociateFileSystem' :: AssociateFileSystem -> Sensitive Text
$sel:userName:AssociateFileSystem' :: AssociateFileSystem -> Text
$sel:tags:AssociateFileSystem' :: AssociateFileSystem -> Maybe [Tag]
$sel:endpointNetworkConfiguration:AssociateFileSystem' :: AssociateFileSystem -> Maybe EndpointNetworkConfiguration
$sel:cacheAttributes:AssociateFileSystem' :: AssociateFileSystem -> Maybe CacheAttributes
$sel:auditDestinationARN:AssociateFileSystem' :: AssociateFileSystem -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AuditDestinationARN" 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
auditDestinationARN,
            (Key
"CacheAttributes" 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 CacheAttributes
cacheAttributes,
            (Key
"EndpointNetworkConfiguration" 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 EndpointNetworkConfiguration
endpointNetworkConfiguration,
            (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
"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),
            forall a. a -> Maybe a
Prelude.Just (Key
"ClientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken),
            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
"LocationARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
locationARN)
          ]
      )

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

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

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

-- |
-- Create a value of 'AssociateFileSystemResponse' 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:
--
-- 'fileSystemAssociationARN', 'associateFileSystemResponse_fileSystemAssociationARN' - The ARN of the newly created file system association.
--
-- 'httpStatus', 'associateFileSystemResponse_httpStatus' - The response's http status code.
newAssociateFileSystemResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateFileSystemResponse
newAssociateFileSystemResponse :: Int -> AssociateFileSystemResponse
newAssociateFileSystemResponse Int
pHttpStatus_ =
  AssociateFileSystemResponse'
    { $sel:fileSystemAssociationARN:AssociateFileSystemResponse' :: Maybe Text
fileSystemAssociationARN =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AssociateFileSystemResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the newly created file system association.
associateFileSystemResponse_fileSystemAssociationARN :: Lens.Lens' AssociateFileSystemResponse (Prelude.Maybe Prelude.Text)
associateFileSystemResponse_fileSystemAssociationARN :: Lens' AssociateFileSystemResponse (Maybe Text)
associateFileSystemResponse_fileSystemAssociationARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateFileSystemResponse' {Maybe Text
fileSystemAssociationARN :: Maybe Text
$sel:fileSystemAssociationARN:AssociateFileSystemResponse' :: AssociateFileSystemResponse -> Maybe Text
fileSystemAssociationARN} -> Maybe Text
fileSystemAssociationARN) (\s :: AssociateFileSystemResponse
s@AssociateFileSystemResponse' {} Maybe Text
a -> AssociateFileSystemResponse
s {$sel:fileSystemAssociationARN:AssociateFileSystemResponse' :: Maybe Text
fileSystemAssociationARN = Maybe Text
a} :: AssociateFileSystemResponse)

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

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