{-# 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.EC2.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)
--
-- Attaches an EBS volume to a running or stopped instance and exposes it
-- to the instance with the specified device name.
--
-- Encrypted EBS volumes must be attached to instances that support Amazon
-- EBS encryption. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html Amazon EBS encryption>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- After you attach an EBS volume, you must make it available. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-using-volumes.html Make an EBS volume available for use>.
--
-- If a volume has an Amazon Web Services Marketplace product code:
--
-- -   The volume can be attached only to a stopped instance.
--
-- -   Amazon Web Services Marketplace product codes are copied from the
--     volume to the instance.
--
-- -   You must be subscribed to the product.
--
-- -   The instance type and operating system of the instance must support
--     the product. For example, you can\'t detach a volume from a Windows
--     instance and attach it to a Linux instance.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-attaching-volume.html Attach an Amazon EBS volume to an instance>
-- in the /Amazon Elastic Compute Cloud User Guide/.
module Amazonka.EC2.AttachVolume
  ( -- * Creating a Request
    AttachVolume (..),
    newAttachVolume,

    -- * Request Lenses
    attachVolume_dryRun,
    attachVolume_device,
    attachVolume_instanceId,
    attachVolume_volumeId,

    -- * Destructuring the Response
    VolumeAttachment (..),
    newVolumeAttachment,

    -- * Response Lenses
    volumeAttachment_attachTime,
    volumeAttachment_deleteOnTermination,
    volumeAttachment_device,
    volumeAttachment_instanceId,
    volumeAttachment_state,
    volumeAttachment_volumeId,
  )
where

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

-- | /See:/ 'newAttachVolume' smart constructor.
data AttachVolume = AttachVolume'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    AttachVolume -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The device name (for example, @\/dev\/sdh@ or @xvdh@).
    AttachVolume -> Text
device :: Prelude.Text,
    -- | The ID of the instance.
    AttachVolume -> Text
instanceId :: Prelude.Text,
    -- | The ID of the EBS volume. The volume and instance must be within the
    -- same Availability Zone.
    AttachVolume -> Text
volumeId :: 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:
--
-- 'dryRun', 'attachVolume_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'device', 'attachVolume_device' - The device name (for example, @\/dev\/sdh@ or @xvdh@).
--
-- 'instanceId', 'attachVolume_instanceId' - The ID of the instance.
--
-- 'volumeId', 'attachVolume_volumeId' - The ID of the EBS volume. The volume and instance must be within the
-- same Availability Zone.
newAttachVolume ::
  -- | 'device'
  Prelude.Text ->
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'volumeId'
  Prelude.Text ->
  AttachVolume
newAttachVolume :: Text -> Text -> Text -> AttachVolume
newAttachVolume Text
pDevice_ Text
pInstanceId_ Text
pVolumeId_ =
  AttachVolume'
    { $sel:dryRun:AttachVolume' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:device:AttachVolume' :: Text
device = Text
pDevice_,
      $sel:instanceId:AttachVolume' :: Text
instanceId = Text
pInstanceId_,
      $sel:volumeId:AttachVolume' :: Text
volumeId = Text
pVolumeId_
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
attachVolume_dryRun :: Lens.Lens' AttachVolume (Prelude.Maybe Prelude.Bool)
attachVolume_dryRun :: Lens' AttachVolume (Maybe Bool)
attachVolume_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachVolume' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:AttachVolume' :: AttachVolume -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: AttachVolume
s@AttachVolume' {} Maybe Bool
a -> AttachVolume
s {$sel:dryRun:AttachVolume' :: Maybe Bool
dryRun = Maybe Bool
a} :: AttachVolume)

-- | The device name (for example, @\/dev\/sdh@ or @xvdh@).
attachVolume_device :: Lens.Lens' AttachVolume Prelude.Text
attachVolume_device :: Lens' AttachVolume Text
attachVolume_device = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachVolume' {Text
device :: Text
$sel:device:AttachVolume' :: AttachVolume -> Text
device} -> Text
device) (\s :: AttachVolume
s@AttachVolume' {} Text
a -> AttachVolume
s {$sel:device:AttachVolume' :: Text
device = Text
a} :: AttachVolume)

-- | The ID of the instance.
attachVolume_instanceId :: Lens.Lens' AttachVolume Prelude.Text
attachVolume_instanceId :: Lens' AttachVolume Text
attachVolume_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachVolume' {Text
instanceId :: Text
$sel:instanceId:AttachVolume' :: AttachVolume -> Text
instanceId} -> Text
instanceId) (\s :: AttachVolume
s@AttachVolume' {} Text
a -> AttachVolume
s {$sel:instanceId:AttachVolume' :: Text
instanceId = Text
a} :: AttachVolume)

-- | The ID of the EBS volume. The volume and instance must be within the
-- same Availability Zone.
attachVolume_volumeId :: Lens.Lens' AttachVolume Prelude.Text
attachVolume_volumeId :: Lens' AttachVolume Text
attachVolume_volumeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachVolume' {Text
volumeId :: Text
$sel:volumeId:AttachVolume' :: AttachVolume -> Text
volumeId} -> Text
volumeId) (\s :: AttachVolume
s@AttachVolume' {} Text
a -> AttachVolume
s {$sel:volumeId:AttachVolume' :: Text
volumeId = Text
a} :: AttachVolume)

instance Core.AWSRequest AttachVolume where
  type AWSResponse AttachVolume = VolumeAttachment
  request :: (Service -> Service) -> AttachVolume -> Request AttachVolume
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (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 -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable AttachVolume where
  hashWithSalt :: Int -> AttachVolume -> Int
hashWithSalt Int
_salt AttachVolume' {Maybe Bool
Text
volumeId :: Text
instanceId :: Text
device :: Text
dryRun :: Maybe Bool
$sel:volumeId:AttachVolume' :: AttachVolume -> Text
$sel:instanceId:AttachVolume' :: AttachVolume -> Text
$sel:device:AttachVolume' :: AttachVolume -> Text
$sel:dryRun:AttachVolume' :: AttachVolume -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
device
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
volumeId

instance Prelude.NFData AttachVolume where
  rnf :: AttachVolume -> ()
rnf AttachVolume' {Maybe Bool
Text
volumeId :: Text
instanceId :: Text
device :: Text
dryRun :: Maybe Bool
$sel:volumeId:AttachVolume' :: AttachVolume -> Text
$sel:instanceId:AttachVolume' :: AttachVolume -> Text
$sel:device:AttachVolume' :: AttachVolume -> Text
$sel:dryRun:AttachVolume' :: AttachVolume -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
device
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
volumeId

instance Data.ToHeaders AttachVolume where
  toHeaders :: AttachVolume -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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 AttachVolume' {Maybe Bool
Text
volumeId :: Text
instanceId :: Text
device :: Text
dryRun :: Maybe Bool
$sel:volumeId:AttachVolume' :: AttachVolume -> Text
$sel:instanceId:AttachVolume' :: AttachVolume -> Text
$sel:device:AttachVolume' :: AttachVolume -> Text
$sel:dryRun:AttachVolume' :: AttachVolume -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"AttachVolume" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"Device" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
device,
        ByteString
"InstanceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
instanceId,
        ByteString
"VolumeId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
volumeId
      ]