{-# 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.DetachVolume
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disconnects a volume from an iSCSI connection and then detaches the
-- volume from 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. This operation is only supported in the volume gateway type.
module Amazonka.StorageGateway.DetachVolume
  ( -- * Creating a Request
    DetachVolume (..),
    newDetachVolume,

    -- * Request Lenses
    detachVolume_forceDetach,
    detachVolume_volumeARN,

    -- * Destructuring the Response
    DetachVolumeResponse (..),
    newDetachVolumeResponse,

    -- * Response Lenses
    detachVolumeResponse_volumeARN,
    detachVolumeResponse_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:/ 'newDetachVolume' smart constructor.
data DetachVolume = DetachVolume'
  { -- | Set to @true@ to forcibly remove the iSCSI connection of the target
    -- volume and detach the volume. The default is @false@. If this value is
    -- set to @false@, you must manually disconnect the iSCSI connection from
    -- the target volume.
    --
    -- Valid Values: @true@ | @false@
    DetachVolume -> Maybe Bool
forceDetach :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of the volume to detach from the gateway.
    DetachVolume -> Text
volumeARN :: Prelude.Text
  }
  deriving (DetachVolume -> DetachVolume -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetachVolume -> DetachVolume -> Bool
$c/= :: DetachVolume -> DetachVolume -> Bool
== :: DetachVolume -> DetachVolume -> Bool
$c== :: DetachVolume -> DetachVolume -> Bool
Prelude.Eq, ReadPrec [DetachVolume]
ReadPrec DetachVolume
Int -> ReadS DetachVolume
ReadS [DetachVolume]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetachVolume]
$creadListPrec :: ReadPrec [DetachVolume]
readPrec :: ReadPrec DetachVolume
$creadPrec :: ReadPrec DetachVolume
readList :: ReadS [DetachVolume]
$creadList :: ReadS [DetachVolume]
readsPrec :: Int -> ReadS DetachVolume
$creadsPrec :: Int -> ReadS DetachVolume
Prelude.Read, Int -> DetachVolume -> ShowS
[DetachVolume] -> ShowS
DetachVolume -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetachVolume] -> ShowS
$cshowList :: [DetachVolume] -> ShowS
show :: DetachVolume -> String
$cshow :: DetachVolume -> String
showsPrec :: Int -> DetachVolume -> ShowS
$cshowsPrec :: Int -> DetachVolume -> ShowS
Prelude.Show, forall x. Rep DetachVolume x -> DetachVolume
forall x. DetachVolume -> Rep DetachVolume x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetachVolume x -> DetachVolume
$cfrom :: forall x. DetachVolume -> Rep DetachVolume x
Prelude.Generic)

-- |
-- Create a value of 'DetachVolume' 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:
--
-- 'forceDetach', 'detachVolume_forceDetach' - Set to @true@ to forcibly remove the iSCSI connection of the target
-- volume and detach the volume. The default is @false@. If this value is
-- set to @false@, you must manually disconnect the iSCSI connection from
-- the target volume.
--
-- Valid Values: @true@ | @false@
--
-- 'volumeARN', 'detachVolume_volumeARN' - The Amazon Resource Name (ARN) of the volume to detach from the gateway.
newDetachVolume ::
  -- | 'volumeARN'
  Prelude.Text ->
  DetachVolume
newDetachVolume :: Text -> DetachVolume
newDetachVolume Text
pVolumeARN_ =
  DetachVolume'
    { $sel:forceDetach:DetachVolume' :: Maybe Bool
forceDetach = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeARN:DetachVolume' :: Text
volumeARN = Text
pVolumeARN_
    }

-- | Set to @true@ to forcibly remove the iSCSI connection of the target
-- volume and detach the volume. The default is @false@. If this value is
-- set to @false@, you must manually disconnect the iSCSI connection from
-- the target volume.
--
-- Valid Values: @true@ | @false@
detachVolume_forceDetach :: Lens.Lens' DetachVolume (Prelude.Maybe Prelude.Bool)
detachVolume_forceDetach :: Lens' DetachVolume (Maybe Bool)
detachVolume_forceDetach = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetachVolume' {Maybe Bool
forceDetach :: Maybe Bool
$sel:forceDetach:DetachVolume' :: DetachVolume -> Maybe Bool
forceDetach} -> Maybe Bool
forceDetach) (\s :: DetachVolume
s@DetachVolume' {} Maybe Bool
a -> DetachVolume
s {$sel:forceDetach:DetachVolume' :: Maybe Bool
forceDetach = Maybe Bool
a} :: DetachVolume)

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

instance Core.AWSRequest DetachVolume where
  type AWSResponse DetachVolume = DetachVolumeResponse
  request :: (Service -> Service) -> DetachVolume -> Request DetachVolume
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 DetachVolume
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DetachVolume)))
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 -> DetachVolumeResponse
DetachVolumeResponse'
            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
"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 DetachVolume where
  hashWithSalt :: Int -> DetachVolume -> Int
hashWithSalt Int
_salt DetachVolume' {Maybe Bool
Text
volumeARN :: Text
forceDetach :: Maybe Bool
$sel:volumeARN:DetachVolume' :: DetachVolume -> Text
$sel:forceDetach:DetachVolume' :: DetachVolume -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
forceDetach
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
volumeARN

instance Prelude.NFData DetachVolume where
  rnf :: DetachVolume -> ()
rnf DetachVolume' {Maybe Bool
Text
volumeARN :: Text
forceDetach :: Maybe Bool
$sel:volumeARN:DetachVolume' :: DetachVolume -> Text
$sel:forceDetach:DetachVolume' :: DetachVolume -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
forceDetach
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
volumeARN

instance Data.ToHeaders DetachVolume where
  toHeaders :: DetachVolume -> 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.DetachVolume" ::
                          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 DetachVolume where
  toJSON :: DetachVolume -> Value
toJSON DetachVolume' {Maybe Bool
Text
volumeARN :: Text
forceDetach :: Maybe Bool
$sel:volumeARN:DetachVolume' :: DetachVolume -> Text
$sel:forceDetach:DetachVolume' :: DetachVolume -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ForceDetach" 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 Bool
forceDetach,
            forall a. a -> Maybe a
Prelude.Just (Key
"VolumeARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
volumeARN)
          ]
      )

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

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

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

-- |
-- Create a value of 'DetachVolumeResponse' 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:
--
-- 'volumeARN', 'detachVolumeResponse_volumeARN' - The Amazon Resource Name (ARN) of the volume that was detached.
--
-- 'httpStatus', 'detachVolumeResponse_httpStatus' - The response's http status code.
newDetachVolumeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DetachVolumeResponse
newDetachVolumeResponse :: Int -> DetachVolumeResponse
newDetachVolumeResponse Int
pHttpStatus_ =
  DetachVolumeResponse'
    { $sel:volumeARN:DetachVolumeResponse' :: Maybe Text
volumeARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DetachVolumeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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