{-# 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.CreateLocationFsxOntap
-- 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 NetApp ONTAP file system that
-- DataSync can access for a transfer. For more information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-ontap-location.html Creating a location for FSx for ONTAP>.
module Amazonka.DataSync.CreateLocationFsxOntap
  ( -- * Creating a Request
    CreateLocationFsxOntap (..),
    newCreateLocationFsxOntap,

    -- * Request Lenses
    createLocationFsxOntap_subdirectory,
    createLocationFsxOntap_tags,
    createLocationFsxOntap_protocol,
    createLocationFsxOntap_securityGroupArns,
    createLocationFsxOntap_storageVirtualMachineArn,

    -- * Destructuring the Response
    CreateLocationFsxOntapResponse (..),
    newCreateLocationFsxOntapResponse,

    -- * Response Lenses
    createLocationFsxOntapResponse_locationArn,
    createLocationFsxOntapResponse_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:/ 'newCreateLocationFsxOntap' smart constructor.
data CreateLocationFsxOntap = CreateLocationFsxOntap'
  { -- | Specifies the junction path (also known as a mount point) in the SVM
    -- volume where you\'re copying data to or from (for example, @\/vol1@).
    --
    -- Don\'t specify a junction path in the SVM\'s root volume. For more
    -- information, see
    -- <https://docs.aws.amazon.com/fsx/latest/ONTAPGuide/managing-svms.html Managing FSx for ONTAP storage virtual machines>
    -- in the /Amazon FSx for NetApp ONTAP User Guide/.
    CreateLocationFsxOntap -> 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.
    CreateLocationFsxOntap -> Maybe [TagListEntry]
tags :: Prelude.Maybe [TagListEntry],
    CreateLocationFsxOntap -> FsxProtocol
protocol :: FsxProtocol,
    -- | Specifies the Amazon EC2 security groups that provide access to your
    -- file system\'s preferred subnet.
    --
    -- The security groups must allow outbound traffic on the following ports
    -- (depending on the protocol you use):
    --
    -- -   __Network File System (NFS)__: TCP ports 111, 635, and 2049
    --
    -- -   __Server Message Block (SMB)__: TCP port 445
    --
    -- Your file system\'s security groups must also allow inbound traffic on
    -- the same ports.
    CreateLocationFsxOntap -> NonEmpty Text
securityGroupArns :: Prelude.NonEmpty Prelude.Text,
    -- | Specifies the ARN of the storage virtual machine (SVM) on your file
    -- system where you\'re copying data to or from.
    CreateLocationFsxOntap -> Text
storageVirtualMachineArn :: Prelude.Text
  }
  deriving (CreateLocationFsxOntap -> CreateLocationFsxOntap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLocationFsxOntap -> CreateLocationFsxOntap -> Bool
$c/= :: CreateLocationFsxOntap -> CreateLocationFsxOntap -> Bool
== :: CreateLocationFsxOntap -> CreateLocationFsxOntap -> Bool
$c== :: CreateLocationFsxOntap -> CreateLocationFsxOntap -> Bool
Prelude.Eq, Int -> CreateLocationFsxOntap -> ShowS
[CreateLocationFsxOntap] -> ShowS
CreateLocationFsxOntap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLocationFsxOntap] -> ShowS
$cshowList :: [CreateLocationFsxOntap] -> ShowS
show :: CreateLocationFsxOntap -> String
$cshow :: CreateLocationFsxOntap -> String
showsPrec :: Int -> CreateLocationFsxOntap -> ShowS
$cshowsPrec :: Int -> CreateLocationFsxOntap -> ShowS
Prelude.Show, forall x. Rep CreateLocationFsxOntap x -> CreateLocationFsxOntap
forall x. CreateLocationFsxOntap -> Rep CreateLocationFsxOntap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLocationFsxOntap x -> CreateLocationFsxOntap
$cfrom :: forall x. CreateLocationFsxOntap -> Rep CreateLocationFsxOntap x
Prelude.Generic)

-- |
-- Create a value of 'CreateLocationFsxOntap' 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:
--
-- 'subdirectory', 'createLocationFsxOntap_subdirectory' - Specifies the junction path (also known as a mount point) in the SVM
-- volume where you\'re copying data to or from (for example, @\/vol1@).
--
-- Don\'t specify a junction path in the SVM\'s root volume. For more
-- information, see
-- <https://docs.aws.amazon.com/fsx/latest/ONTAPGuide/managing-svms.html Managing FSx for ONTAP storage virtual machines>
-- in the /Amazon FSx for NetApp ONTAP User Guide/.
--
-- 'tags', 'createLocationFsxOntap_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.
--
-- 'protocol', 'createLocationFsxOntap_protocol' - Undocumented member.
--
-- 'securityGroupArns', 'createLocationFsxOntap_securityGroupArns' - Specifies the Amazon EC2 security groups that provide access to your
-- file system\'s preferred subnet.
--
-- The security groups must allow outbound traffic on the following ports
-- (depending on the protocol you use):
--
-- -   __Network File System (NFS)__: TCP ports 111, 635, and 2049
--
-- -   __Server Message Block (SMB)__: TCP port 445
--
-- Your file system\'s security groups must also allow inbound traffic on
-- the same ports.
--
-- 'storageVirtualMachineArn', 'createLocationFsxOntap_storageVirtualMachineArn' - Specifies the ARN of the storage virtual machine (SVM) on your file
-- system where you\'re copying data to or from.
newCreateLocationFsxOntap ::
  -- | 'protocol'
  FsxProtocol ->
  -- | 'securityGroupArns'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'storageVirtualMachineArn'
  Prelude.Text ->
  CreateLocationFsxOntap
newCreateLocationFsxOntap :: FsxProtocol -> NonEmpty Text -> Text -> CreateLocationFsxOntap
newCreateLocationFsxOntap
  FsxProtocol
pProtocol_
  NonEmpty Text
pSecurityGroupArns_
  Text
pStorageVirtualMachineArn_ =
    CreateLocationFsxOntap'
      { $sel:subdirectory:CreateLocationFsxOntap' :: Maybe Text
subdirectory =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateLocationFsxOntap' :: Maybe [TagListEntry]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:protocol:CreateLocationFsxOntap' :: FsxProtocol
protocol = FsxProtocol
pProtocol_,
        $sel:securityGroupArns:CreateLocationFsxOntap' :: 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:storageVirtualMachineArn:CreateLocationFsxOntap' :: Text
storageVirtualMachineArn =
          Text
pStorageVirtualMachineArn_
      }

-- | Specifies the junction path (also known as a mount point) in the SVM
-- volume where you\'re copying data to or from (for example, @\/vol1@).
--
-- Don\'t specify a junction path in the SVM\'s root volume. For more
-- information, see
-- <https://docs.aws.amazon.com/fsx/latest/ONTAPGuide/managing-svms.html Managing FSx for ONTAP storage virtual machines>
-- in the /Amazon FSx for NetApp ONTAP User Guide/.
createLocationFsxOntap_subdirectory :: Lens.Lens' CreateLocationFsxOntap (Prelude.Maybe Prelude.Text)
createLocationFsxOntap_subdirectory :: Lens' CreateLocationFsxOntap (Maybe Text)
createLocationFsxOntap_subdirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxOntap' {Maybe Text
subdirectory :: Maybe Text
$sel:subdirectory:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> Maybe Text
subdirectory} -> Maybe Text
subdirectory) (\s :: CreateLocationFsxOntap
s@CreateLocationFsxOntap' {} Maybe Text
a -> CreateLocationFsxOntap
s {$sel:subdirectory:CreateLocationFsxOntap' :: Maybe Text
subdirectory = Maybe Text
a} :: CreateLocationFsxOntap)

-- | 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.
createLocationFsxOntap_tags :: Lens.Lens' CreateLocationFsxOntap (Prelude.Maybe [TagListEntry])
createLocationFsxOntap_tags :: Lens' CreateLocationFsxOntap (Maybe [TagListEntry])
createLocationFsxOntap_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxOntap' {Maybe [TagListEntry]
tags :: Maybe [TagListEntry]
$sel:tags:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> Maybe [TagListEntry]
tags} -> Maybe [TagListEntry]
tags) (\s :: CreateLocationFsxOntap
s@CreateLocationFsxOntap' {} Maybe [TagListEntry]
a -> CreateLocationFsxOntap
s {$sel:tags:CreateLocationFsxOntap' :: Maybe [TagListEntry]
tags = Maybe [TagListEntry]
a} :: CreateLocationFsxOntap) 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

-- | Undocumented member.
createLocationFsxOntap_protocol :: Lens.Lens' CreateLocationFsxOntap FsxProtocol
createLocationFsxOntap_protocol :: Lens' CreateLocationFsxOntap FsxProtocol
createLocationFsxOntap_protocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxOntap' {FsxProtocol
protocol :: FsxProtocol
$sel:protocol:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> FsxProtocol
protocol} -> FsxProtocol
protocol) (\s :: CreateLocationFsxOntap
s@CreateLocationFsxOntap' {} FsxProtocol
a -> CreateLocationFsxOntap
s {$sel:protocol:CreateLocationFsxOntap' :: FsxProtocol
protocol = FsxProtocol
a} :: CreateLocationFsxOntap)

-- | Specifies the Amazon EC2 security groups that provide access to your
-- file system\'s preferred subnet.
--
-- The security groups must allow outbound traffic on the following ports
-- (depending on the protocol you use):
--
-- -   __Network File System (NFS)__: TCP ports 111, 635, and 2049
--
-- -   __Server Message Block (SMB)__: TCP port 445
--
-- Your file system\'s security groups must also allow inbound traffic on
-- the same ports.
createLocationFsxOntap_securityGroupArns :: Lens.Lens' CreateLocationFsxOntap (Prelude.NonEmpty Prelude.Text)
createLocationFsxOntap_securityGroupArns :: Lens' CreateLocationFsxOntap (NonEmpty Text)
createLocationFsxOntap_securityGroupArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxOntap' {NonEmpty Text
securityGroupArns :: NonEmpty Text
$sel:securityGroupArns:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> NonEmpty Text
securityGroupArns} -> NonEmpty Text
securityGroupArns) (\s :: CreateLocationFsxOntap
s@CreateLocationFsxOntap' {} NonEmpty Text
a -> CreateLocationFsxOntap
s {$sel:securityGroupArns:CreateLocationFsxOntap' :: NonEmpty Text
securityGroupArns = NonEmpty Text
a} :: CreateLocationFsxOntap) 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 ARN of the storage virtual machine (SVM) on your file
-- system where you\'re copying data to or from.
createLocationFsxOntap_storageVirtualMachineArn :: Lens.Lens' CreateLocationFsxOntap Prelude.Text
createLocationFsxOntap_storageVirtualMachineArn :: Lens' CreateLocationFsxOntap Text
createLocationFsxOntap_storageVirtualMachineArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxOntap' {Text
storageVirtualMachineArn :: Text
$sel:storageVirtualMachineArn:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> Text
storageVirtualMachineArn} -> Text
storageVirtualMachineArn) (\s :: CreateLocationFsxOntap
s@CreateLocationFsxOntap' {} Text
a -> CreateLocationFsxOntap
s {$sel:storageVirtualMachineArn:CreateLocationFsxOntap' :: Text
storageVirtualMachineArn = Text
a} :: CreateLocationFsxOntap)

instance Core.AWSRequest CreateLocationFsxOntap where
  type
    AWSResponse CreateLocationFsxOntap =
      CreateLocationFsxOntapResponse
  request :: (Service -> Service)
-> CreateLocationFsxOntap -> Request CreateLocationFsxOntap
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 CreateLocationFsxOntap
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLocationFsxOntap)))
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 -> CreateLocationFsxOntapResponse
CreateLocationFsxOntapResponse'
            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 CreateLocationFsxOntap where
  hashWithSalt :: Int -> CreateLocationFsxOntap -> Int
hashWithSalt Int
_salt CreateLocationFsxOntap' {Maybe [TagListEntry]
Maybe Text
NonEmpty Text
Text
FsxProtocol
storageVirtualMachineArn :: Text
securityGroupArns :: NonEmpty Text
protocol :: FsxProtocol
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
$sel:storageVirtualMachineArn:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> Text
$sel:securityGroupArns:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> NonEmpty Text
$sel:protocol:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> FsxProtocol
$sel:tags:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> Maybe Text
..} =
    Int
_salt
      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` FsxProtocol
protocol
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
securityGroupArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
storageVirtualMachineArn

instance Prelude.NFData CreateLocationFsxOntap where
  rnf :: CreateLocationFsxOntap -> ()
rnf CreateLocationFsxOntap' {Maybe [TagListEntry]
Maybe Text
NonEmpty Text
Text
FsxProtocol
storageVirtualMachineArn :: Text
securityGroupArns :: NonEmpty Text
protocol :: FsxProtocol
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
$sel:storageVirtualMachineArn:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> Text
$sel:securityGroupArns:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> NonEmpty Text
$sel:protocol:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> FsxProtocol
$sel:tags:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> Maybe Text
..} =
    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 FsxProtocol
protocol
      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
storageVirtualMachineArn

instance Data.ToHeaders CreateLocationFsxOntap where
  toHeaders :: CreateLocationFsxOntap -> 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.CreateLocationFsxOntap" ::
                          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 CreateLocationFsxOntap where
  toJSON :: CreateLocationFsxOntap -> Value
toJSON CreateLocationFsxOntap' {Maybe [TagListEntry]
Maybe Text
NonEmpty Text
Text
FsxProtocol
storageVirtualMachineArn :: Text
securityGroupArns :: NonEmpty Text
protocol :: FsxProtocol
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
$sel:storageVirtualMachineArn:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> Text
$sel:securityGroupArns:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> NonEmpty Text
$sel:protocol:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> FsxProtocol
$sel:tags:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationFsxOntap' :: CreateLocationFsxOntap -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"Protocol" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= FsxProtocol
protocol),
            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
"StorageVirtualMachineArn"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
storageVirtualMachineArn
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateLocationFsxOntapResponse' 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', 'createLocationFsxOntapResponse_locationArn' - Specifies the ARN of the FSx for ONTAP file system location that you
-- create.
--
-- 'httpStatus', 'createLocationFsxOntapResponse_httpStatus' - The response's http status code.
newCreateLocationFsxOntapResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLocationFsxOntapResponse
newCreateLocationFsxOntapResponse :: Int -> CreateLocationFsxOntapResponse
newCreateLocationFsxOntapResponse Int
pHttpStatus_ =
  CreateLocationFsxOntapResponse'
    { $sel:locationArn:CreateLocationFsxOntapResponse' :: Maybe Text
locationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLocationFsxOntapResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Specifies the ARN of the FSx for ONTAP file system location that you
-- create.
createLocationFsxOntapResponse_locationArn :: Lens.Lens' CreateLocationFsxOntapResponse (Prelude.Maybe Prelude.Text)
createLocationFsxOntapResponse_locationArn :: Lens' CreateLocationFsxOntapResponse (Maybe Text)
createLocationFsxOntapResponse_locationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationFsxOntapResponse' {Maybe Text
locationArn :: Maybe Text
$sel:locationArn:CreateLocationFsxOntapResponse' :: CreateLocationFsxOntapResponse -> Maybe Text
locationArn} -> Maybe Text
locationArn) (\s :: CreateLocationFsxOntapResponse
s@CreateLocationFsxOntapResponse' {} Maybe Text
a -> CreateLocationFsxOntapResponse
s {$sel:locationArn:CreateLocationFsxOntapResponse' :: Maybe Text
locationArn = Maybe Text
a} :: CreateLocationFsxOntapResponse)

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

instance
  Prelude.NFData
    CreateLocationFsxOntapResponse
  where
  rnf :: CreateLocationFsxOntapResponse -> ()
rnf CreateLocationFsxOntapResponse' {Int
Maybe Text
httpStatus :: Int
locationArn :: Maybe Text
$sel:httpStatus:CreateLocationFsxOntapResponse' :: CreateLocationFsxOntapResponse -> Int
$sel:locationArn:CreateLocationFsxOntapResponse' :: CreateLocationFsxOntapResponse -> 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