{-# 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.AttachVolume
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Connects a volume to an iSCSI connection and then attaches the volume to
-- the specified gateway. Detaching and attaching a volume enables you to
-- recover your data from one gateway to a different gateway without
-- creating a snapshot. It also makes it easier to move your volumes from
-- an on-premises gateway to a gateway hosted on an Amazon EC2 instance.
module Amazonka.StorageGateway.AttachVolume
  ( -- * Creating a Request
    AttachVolume (..),
    newAttachVolume,

    -- * Request Lenses
    attachVolume_diskId,
    attachVolume_targetName,
    attachVolume_gatewayARN,
    attachVolume_volumeARN,
    attachVolume_networkInterfaceId,

    -- * Destructuring the Response
    AttachVolumeResponse (..),
    newAttachVolumeResponse,

    -- * Response Lenses
    attachVolumeResponse_targetARN,
    attachVolumeResponse_volumeARN,
    attachVolumeResponse_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

-- | AttachVolumeInput
--
-- /See:/ 'newAttachVolume' smart constructor.
data AttachVolume = AttachVolume'
  { -- | The unique device ID or other distinguishing data that identifies the
    -- local disk used to create the volume. This value is only required when
    -- you are attaching a stored volume.
    AttachVolume -> Maybe Text
diskId :: Prelude.Maybe Prelude.Text,
    -- | The name of the iSCSI target used by an initiator to connect to a volume
    -- and used as a suffix for the target ARN. For example, specifying
    -- @TargetName@ as /myvolume/ results in the target ARN of
    -- @arn:aws:storagegateway:us-east-2:111122223333:gateway\/sgw-12A3456B\/target\/iqn.1997-05.com.amazon:myvolume@.
    -- The target name must be unique across all volumes on a gateway.
    --
    -- If you don\'t specify a value, Storage Gateway uses the value that was
    -- previously used for this volume as the new target name.
    AttachVolume -> Maybe Text
targetName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the gateway that you want to attach
    -- the volume to.
    AttachVolume -> Text
gatewayARN :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the volume to attach to the specified
    -- gateway.
    AttachVolume -> Text
volumeARN :: Prelude.Text,
    -- | The network interface of the gateway on which to expose the iSCSI
    -- target. Only IPv4 addresses are accepted. Use DescribeGatewayInformation
    -- to get a list of the network interfaces available on a gateway.
    --
    -- Valid Values: A valid IP address.
    AttachVolume -> Text
networkInterfaceId :: Prelude.Text
  }
  deriving (AttachVolume -> AttachVolume -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachVolume -> AttachVolume -> Bool
$c/= :: AttachVolume -> AttachVolume -> Bool
== :: AttachVolume -> AttachVolume -> Bool
$c== :: AttachVolume -> AttachVolume -> Bool
Prelude.Eq, ReadPrec [AttachVolume]
ReadPrec AttachVolume
Int -> ReadS AttachVolume
ReadS [AttachVolume]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttachVolume]
$creadListPrec :: ReadPrec [AttachVolume]
readPrec :: ReadPrec AttachVolume
$creadPrec :: ReadPrec AttachVolume
readList :: ReadS [AttachVolume]
$creadList :: ReadS [AttachVolume]
readsPrec :: Int -> ReadS AttachVolume
$creadsPrec :: Int -> ReadS AttachVolume
Prelude.Read, Int -> AttachVolume -> ShowS
[AttachVolume] -> ShowS
AttachVolume -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttachVolume] -> ShowS
$cshowList :: [AttachVolume] -> ShowS
show :: AttachVolume -> String
$cshow :: AttachVolume -> String
showsPrec :: Int -> AttachVolume -> ShowS
$cshowsPrec :: Int -> AttachVolume -> ShowS
Prelude.Show, forall x. Rep AttachVolume x -> AttachVolume
forall x. AttachVolume -> Rep AttachVolume x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttachVolume x -> AttachVolume
$cfrom :: forall x. AttachVolume -> Rep AttachVolume x
Prelude.Generic)

-- |
-- Create a value of 'AttachVolume' 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:
--
-- 'diskId', 'attachVolume_diskId' - The unique device ID or other distinguishing data that identifies the
-- local disk used to create the volume. This value is only required when
-- you are attaching a stored volume.
--
-- 'targetName', 'attachVolume_targetName' - The name of the iSCSI target used by an initiator to connect to a volume
-- and used as a suffix for the target ARN. For example, specifying
-- @TargetName@ as /myvolume/ results in the target ARN of
-- @arn:aws:storagegateway:us-east-2:111122223333:gateway\/sgw-12A3456B\/target\/iqn.1997-05.com.amazon:myvolume@.
-- The target name must be unique across all volumes on a gateway.
--
-- If you don\'t specify a value, Storage Gateway uses the value that was
-- previously used for this volume as the new target name.
--
-- 'gatewayARN', 'attachVolume_gatewayARN' - The Amazon Resource Name (ARN) of the gateway that you want to attach
-- the volume to.
--
-- 'volumeARN', 'attachVolume_volumeARN' - The Amazon Resource Name (ARN) of the volume to attach to the specified
-- gateway.
--
-- 'networkInterfaceId', 'attachVolume_networkInterfaceId' - The network interface of the gateway on which to expose the iSCSI
-- target. Only IPv4 addresses are accepted. Use DescribeGatewayInformation
-- to get a list of the network interfaces available on a gateway.
--
-- Valid Values: A valid IP address.
newAttachVolume ::
  -- | 'gatewayARN'
  Prelude.Text ->
  -- | 'volumeARN'
  Prelude.Text ->
  -- | 'networkInterfaceId'
  Prelude.Text ->
  AttachVolume
newAttachVolume :: Text -> Text -> Text -> AttachVolume
newAttachVolume
  Text
pGatewayARN_
  Text
pVolumeARN_
  Text
pNetworkInterfaceId_ =
    AttachVolume'
      { $sel:diskId:AttachVolume' :: Maybe Text
diskId = forall a. Maybe a
Prelude.Nothing,
        $sel:targetName:AttachVolume' :: Maybe Text
targetName = forall a. Maybe a
Prelude.Nothing,
        $sel:gatewayARN:AttachVolume' :: Text
gatewayARN = Text
pGatewayARN_,
        $sel:volumeARN:AttachVolume' :: Text
volumeARN = Text
pVolumeARN_,
        $sel:networkInterfaceId:AttachVolume' :: Text
networkInterfaceId = Text
pNetworkInterfaceId_
      }

-- | The unique device ID or other distinguishing data that identifies the
-- local disk used to create the volume. This value is only required when
-- you are attaching a stored volume.
attachVolume_diskId :: Lens.Lens' AttachVolume (Prelude.Maybe Prelude.Text)
attachVolume_diskId :: Lens' AttachVolume (Maybe Text)
attachVolume_diskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachVolume' {Maybe Text
diskId :: Maybe Text
$sel:diskId:AttachVolume' :: AttachVolume -> Maybe Text
diskId} -> Maybe Text
diskId) (\s :: AttachVolume
s@AttachVolume' {} Maybe Text
a -> AttachVolume
s {$sel:diskId:AttachVolume' :: Maybe Text
diskId = Maybe Text
a} :: AttachVolume)

-- | The name of the iSCSI target used by an initiator to connect to a volume
-- and used as a suffix for the target ARN. For example, specifying
-- @TargetName@ as /myvolume/ results in the target ARN of
-- @arn:aws:storagegateway:us-east-2:111122223333:gateway\/sgw-12A3456B\/target\/iqn.1997-05.com.amazon:myvolume@.
-- The target name must be unique across all volumes on a gateway.
--
-- If you don\'t specify a value, Storage Gateway uses the value that was
-- previously used for this volume as the new target name.
attachVolume_targetName :: Lens.Lens' AttachVolume (Prelude.Maybe Prelude.Text)
attachVolume_targetName :: Lens' AttachVolume (Maybe Text)
attachVolume_targetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachVolume' {Maybe Text
targetName :: Maybe Text
$sel:targetName:AttachVolume' :: AttachVolume -> Maybe Text
targetName} -> Maybe Text
targetName) (\s :: AttachVolume
s@AttachVolume' {} Maybe Text
a -> AttachVolume
s {$sel:targetName:AttachVolume' :: Maybe Text
targetName = Maybe Text
a} :: AttachVolume)

-- | The Amazon Resource Name (ARN) of the gateway that you want to attach
-- the volume to.
attachVolume_gatewayARN :: Lens.Lens' AttachVolume Prelude.Text
attachVolume_gatewayARN :: Lens' AttachVolume Text
attachVolume_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachVolume' {Text
gatewayARN :: Text
$sel:gatewayARN:AttachVolume' :: AttachVolume -> Text
gatewayARN} -> Text
gatewayARN) (\s :: AttachVolume
s@AttachVolume' {} Text
a -> AttachVolume
s {$sel:gatewayARN:AttachVolume' :: Text
gatewayARN = Text
a} :: AttachVolume)

-- | The Amazon Resource Name (ARN) of the volume to attach to the specified
-- gateway.
attachVolume_volumeARN :: Lens.Lens' AttachVolume Prelude.Text
attachVolume_volumeARN :: Lens' AttachVolume Text
attachVolume_volumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachVolume' {Text
volumeARN :: Text
$sel:volumeARN:AttachVolume' :: AttachVolume -> Text
volumeARN} -> Text
volumeARN) (\s :: AttachVolume
s@AttachVolume' {} Text
a -> AttachVolume
s {$sel:volumeARN:AttachVolume' :: Text
volumeARN = Text
a} :: AttachVolume)

-- | The network interface of the gateway on which to expose the iSCSI
-- target. Only IPv4 addresses are accepted. Use DescribeGatewayInformation
-- to get a list of the network interfaces available on a gateway.
--
-- Valid Values: A valid IP address.
attachVolume_networkInterfaceId :: Lens.Lens' AttachVolume Prelude.Text
attachVolume_networkInterfaceId :: Lens' AttachVolume Text
attachVolume_networkInterfaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachVolume' {Text
networkInterfaceId :: Text
$sel:networkInterfaceId:AttachVolume' :: AttachVolume -> Text
networkInterfaceId} -> Text
networkInterfaceId) (\s :: AttachVolume
s@AttachVolume' {} Text
a -> AttachVolume
s {$sel:networkInterfaceId:AttachVolume' :: Text
networkInterfaceId = Text
a} :: AttachVolume)

instance Core.AWSRequest AttachVolume where
  type AWSResponse AttachVolume = AttachVolumeResponse
  request :: (Service -> Service) -> AttachVolume -> Request AttachVolume
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 AttachVolume
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AttachVolume)))
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 -> Maybe Text -> Int -> AttachVolumeResponse
AttachVolumeResponse'
            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
"TargetARN")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VolumeARN")
            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 AttachVolume where
  hashWithSalt :: Int -> AttachVolume -> Int
hashWithSalt Int
_salt AttachVolume' {Maybe Text
Text
networkInterfaceId :: Text
volumeARN :: Text
gatewayARN :: Text
targetName :: Maybe Text
diskId :: Maybe Text
$sel:networkInterfaceId:AttachVolume' :: AttachVolume -> Text
$sel:volumeARN:AttachVolume' :: AttachVolume -> Text
$sel:gatewayARN:AttachVolume' :: AttachVolume -> Text
$sel:targetName:AttachVolume' :: AttachVolume -> Maybe Text
$sel:diskId:AttachVolume' :: AttachVolume -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
diskId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
volumeARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
networkInterfaceId

instance Prelude.NFData AttachVolume where
  rnf :: AttachVolume -> ()
rnf AttachVolume' {Maybe Text
Text
networkInterfaceId :: Text
volumeARN :: Text
gatewayARN :: Text
targetName :: Maybe Text
diskId :: Maybe Text
$sel:networkInterfaceId:AttachVolume' :: AttachVolume -> Text
$sel:volumeARN:AttachVolume' :: AttachVolume -> Text
$sel:gatewayARN:AttachVolume' :: AttachVolume -> Text
$sel:targetName:AttachVolume' :: AttachVolume -> Maybe Text
$sel:diskId:AttachVolume' :: AttachVolume -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
diskId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetName
      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
volumeARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
networkInterfaceId

instance Data.ToHeaders AttachVolume where
  toHeaders :: AttachVolume -> 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.AttachVolume" ::
                          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 AttachVolume where
  toJSON :: AttachVolume -> Value
toJSON AttachVolume' {Maybe Text
Text
networkInterfaceId :: Text
volumeARN :: Text
gatewayARN :: Text
targetName :: Maybe Text
diskId :: Maybe Text
$sel:networkInterfaceId:AttachVolume' :: AttachVolume -> Text
$sel:volumeARN:AttachVolume' :: AttachVolume -> Text
$sel:gatewayARN:AttachVolume' :: AttachVolume -> Text
$sel:targetName:AttachVolume' :: AttachVolume -> Maybe Text
$sel:diskId:AttachVolume' :: AttachVolume -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DiskId" 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
diskId,
            (Key
"TargetName" 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
targetName,
            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
"VolumeARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
volumeARN),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"NetworkInterfaceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
networkInterfaceId)
          ]
      )

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

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

-- | AttachVolumeOutput
--
-- /See:/ 'newAttachVolumeResponse' smart constructor.
data AttachVolumeResponse = AttachVolumeResponse'
  { -- | The Amazon Resource Name (ARN) of the volume target, which includes the
    -- iSCSI name for the initiator that was used to connect to the target.
    AttachVolumeResponse -> Maybe Text
targetARN :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the volume that was attached to the
    -- gateway.
    AttachVolumeResponse -> Maybe Text
volumeARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    AttachVolumeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AttachVolumeResponse -> AttachVolumeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachVolumeResponse -> AttachVolumeResponse -> Bool
$c/= :: AttachVolumeResponse -> AttachVolumeResponse -> Bool
== :: AttachVolumeResponse -> AttachVolumeResponse -> Bool
$c== :: AttachVolumeResponse -> AttachVolumeResponse -> Bool
Prelude.Eq, ReadPrec [AttachVolumeResponse]
ReadPrec AttachVolumeResponse
Int -> ReadS AttachVolumeResponse
ReadS [AttachVolumeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttachVolumeResponse]
$creadListPrec :: ReadPrec [AttachVolumeResponse]
readPrec :: ReadPrec AttachVolumeResponse
$creadPrec :: ReadPrec AttachVolumeResponse
readList :: ReadS [AttachVolumeResponse]
$creadList :: ReadS [AttachVolumeResponse]
readsPrec :: Int -> ReadS AttachVolumeResponse
$creadsPrec :: Int -> ReadS AttachVolumeResponse
Prelude.Read, Int -> AttachVolumeResponse -> ShowS
[AttachVolumeResponse] -> ShowS
AttachVolumeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttachVolumeResponse] -> ShowS
$cshowList :: [AttachVolumeResponse] -> ShowS
show :: AttachVolumeResponse -> String
$cshow :: AttachVolumeResponse -> String
showsPrec :: Int -> AttachVolumeResponse -> ShowS
$cshowsPrec :: Int -> AttachVolumeResponse -> ShowS
Prelude.Show, forall x. Rep AttachVolumeResponse x -> AttachVolumeResponse
forall x. AttachVolumeResponse -> Rep AttachVolumeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttachVolumeResponse x -> AttachVolumeResponse
$cfrom :: forall x. AttachVolumeResponse -> Rep AttachVolumeResponse x
Prelude.Generic)

-- |
-- Create a value of 'AttachVolumeResponse' 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:
--
-- 'targetARN', 'attachVolumeResponse_targetARN' - The Amazon Resource Name (ARN) of the volume target, which includes the
-- iSCSI name for the initiator that was used to connect to the target.
--
-- 'volumeARN', 'attachVolumeResponse_volumeARN' - The Amazon Resource Name (ARN) of the volume that was attached to the
-- gateway.
--
-- 'httpStatus', 'attachVolumeResponse_httpStatus' - The response's http status code.
newAttachVolumeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AttachVolumeResponse
newAttachVolumeResponse :: Int -> AttachVolumeResponse
newAttachVolumeResponse Int
pHttpStatus_ =
  AttachVolumeResponse'
    { $sel:targetARN:AttachVolumeResponse' :: Maybe Text
targetARN = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeARN:AttachVolumeResponse' :: Maybe Text
volumeARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AttachVolumeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the volume target, which includes the
-- iSCSI name for the initiator that was used to connect to the target.
attachVolumeResponse_targetARN :: Lens.Lens' AttachVolumeResponse (Prelude.Maybe Prelude.Text)
attachVolumeResponse_targetARN :: Lens' AttachVolumeResponse (Maybe Text)
attachVolumeResponse_targetARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachVolumeResponse' {Maybe Text
targetARN :: Maybe Text
$sel:targetARN:AttachVolumeResponse' :: AttachVolumeResponse -> Maybe Text
targetARN} -> Maybe Text
targetARN) (\s :: AttachVolumeResponse
s@AttachVolumeResponse' {} Maybe Text
a -> AttachVolumeResponse
s {$sel:targetARN:AttachVolumeResponse' :: Maybe Text
targetARN = Maybe Text
a} :: AttachVolumeResponse)

-- | The Amazon Resource Name (ARN) of the volume that was attached to the
-- gateway.
attachVolumeResponse_volumeARN :: Lens.Lens' AttachVolumeResponse (Prelude.Maybe Prelude.Text)
attachVolumeResponse_volumeARN :: Lens' AttachVolumeResponse (Maybe Text)
attachVolumeResponse_volumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachVolumeResponse' {Maybe Text
volumeARN :: Maybe Text
$sel:volumeARN:AttachVolumeResponse' :: AttachVolumeResponse -> Maybe Text
volumeARN} -> Maybe Text
volumeARN) (\s :: AttachVolumeResponse
s@AttachVolumeResponse' {} Maybe Text
a -> AttachVolumeResponse
s {$sel:volumeARN:AttachVolumeResponse' :: Maybe Text
volumeARN = Maybe Text
a} :: AttachVolumeResponse)

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

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