{-# 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.OpsWorks.UpdateVolume
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an Amazon EBS volume\'s name or mount point. For more
-- information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/resources.html Resource Management>.
--
-- __Required Permissions__: To use this action, an IAM user must have a
-- Manage permissions level for the stack, or an attached policy that
-- explicitly grants permissions. For more information on user permissions,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
module Amazonka.OpsWorks.UpdateVolume
  ( -- * Creating a Request
    UpdateVolume (..),
    newUpdateVolume,

    -- * Request Lenses
    updateVolume_mountPoint,
    updateVolume_name,
    updateVolume_volumeId,

    -- * Destructuring the Response
    UpdateVolumeResponse (..),
    newUpdateVolumeResponse,
  )
where

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

-- | /See:/ 'newUpdateVolume' smart constructor.
data UpdateVolume = UpdateVolume'
  { -- | The new mount point.
    UpdateVolume -> Maybe Text
mountPoint :: Prelude.Maybe Prelude.Text,
    -- | The new name.
    UpdateVolume -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The volume ID.
    UpdateVolume -> Text
volumeId :: Prelude.Text
  }
  deriving (UpdateVolume -> UpdateVolume -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateVolume -> UpdateVolume -> Bool
$c/= :: UpdateVolume -> UpdateVolume -> Bool
== :: UpdateVolume -> UpdateVolume -> Bool
$c== :: UpdateVolume -> UpdateVolume -> Bool
Prelude.Eq, ReadPrec [UpdateVolume]
ReadPrec UpdateVolume
Int -> ReadS UpdateVolume
ReadS [UpdateVolume]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateVolume]
$creadListPrec :: ReadPrec [UpdateVolume]
readPrec :: ReadPrec UpdateVolume
$creadPrec :: ReadPrec UpdateVolume
readList :: ReadS [UpdateVolume]
$creadList :: ReadS [UpdateVolume]
readsPrec :: Int -> ReadS UpdateVolume
$creadsPrec :: Int -> ReadS UpdateVolume
Prelude.Read, Int -> UpdateVolume -> ShowS
[UpdateVolume] -> ShowS
UpdateVolume -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateVolume] -> ShowS
$cshowList :: [UpdateVolume] -> ShowS
show :: UpdateVolume -> String
$cshow :: UpdateVolume -> String
showsPrec :: Int -> UpdateVolume -> ShowS
$cshowsPrec :: Int -> UpdateVolume -> ShowS
Prelude.Show, forall x. Rep UpdateVolume x -> UpdateVolume
forall x. UpdateVolume -> Rep UpdateVolume x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateVolume x -> UpdateVolume
$cfrom :: forall x. UpdateVolume -> Rep UpdateVolume x
Prelude.Generic)

-- |
-- Create a value of 'UpdateVolume' 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:
--
-- 'mountPoint', 'updateVolume_mountPoint' - The new mount point.
--
-- 'name', 'updateVolume_name' - The new name.
--
-- 'volumeId', 'updateVolume_volumeId' - The volume ID.
newUpdateVolume ::
  -- | 'volumeId'
  Prelude.Text ->
  UpdateVolume
newUpdateVolume :: Text -> UpdateVolume
newUpdateVolume Text
pVolumeId_ =
  UpdateVolume'
    { $sel:mountPoint:UpdateVolume' :: Maybe Text
mountPoint = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateVolume' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeId:UpdateVolume' :: Text
volumeId = Text
pVolumeId_
    }

-- | The new mount point.
updateVolume_mountPoint :: Lens.Lens' UpdateVolume (Prelude.Maybe Prelude.Text)
updateVolume_mountPoint :: Lens' UpdateVolume (Maybe Text)
updateVolume_mountPoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVolume' {Maybe Text
mountPoint :: Maybe Text
$sel:mountPoint:UpdateVolume' :: UpdateVolume -> Maybe Text
mountPoint} -> Maybe Text
mountPoint) (\s :: UpdateVolume
s@UpdateVolume' {} Maybe Text
a -> UpdateVolume
s {$sel:mountPoint:UpdateVolume' :: Maybe Text
mountPoint = Maybe Text
a} :: UpdateVolume)

-- | The new name.
updateVolume_name :: Lens.Lens' UpdateVolume (Prelude.Maybe Prelude.Text)
updateVolume_name :: Lens' UpdateVolume (Maybe Text)
updateVolume_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVolume' {Maybe Text
name :: Maybe Text
$sel:name:UpdateVolume' :: UpdateVolume -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateVolume
s@UpdateVolume' {} Maybe Text
a -> UpdateVolume
s {$sel:name:UpdateVolume' :: Maybe Text
name = Maybe Text
a} :: UpdateVolume)

-- | The volume ID.
updateVolume_volumeId :: Lens.Lens' UpdateVolume Prelude.Text
updateVolume_volumeId :: Lens' UpdateVolume Text
updateVolume_volumeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVolume' {Text
volumeId :: Text
$sel:volumeId:UpdateVolume' :: UpdateVolume -> Text
volumeId} -> Text
volumeId) (\s :: UpdateVolume
s@UpdateVolume' {} Text
a -> UpdateVolume
s {$sel:volumeId:UpdateVolume' :: Text
volumeId = Text
a} :: UpdateVolume)

instance Core.AWSRequest UpdateVolume where
  type AWSResponse UpdateVolume = UpdateVolumeResponse
  request :: (Service -> Service) -> UpdateVolume -> Request UpdateVolume
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 UpdateVolume
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateVolume)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdateVolumeResponse
UpdateVolumeResponse'

instance Prelude.Hashable UpdateVolume where
  hashWithSalt :: Int -> UpdateVolume -> Int
hashWithSalt Int
_salt UpdateVolume' {Maybe Text
Text
volumeId :: Text
name :: Maybe Text
mountPoint :: Maybe Text
$sel:volumeId:UpdateVolume' :: UpdateVolume -> Text
$sel:name:UpdateVolume' :: UpdateVolume -> Maybe Text
$sel:mountPoint:UpdateVolume' :: UpdateVolume -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
mountPoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
volumeId

instance Prelude.NFData UpdateVolume where
  rnf :: UpdateVolume -> ()
rnf UpdateVolume' {Maybe Text
Text
volumeId :: Text
name :: Maybe Text
mountPoint :: Maybe Text
$sel:volumeId:UpdateVolume' :: UpdateVolume -> Text
$sel:name:UpdateVolume' :: UpdateVolume -> Maybe Text
$sel:mountPoint:UpdateVolume' :: UpdateVolume -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
mountPoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
volumeId

instance Data.ToHeaders UpdateVolume where
  toHeaders :: UpdateVolume -> [Header]
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 -> [Header]
Data.=# ( ByteString
"OpsWorks_20130218.UpdateVolume" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateVolume where
  toJSON :: UpdateVolume -> Value
toJSON UpdateVolume' {Maybe Text
Text
volumeId :: Text
name :: Maybe Text
mountPoint :: Maybe Text
$sel:volumeId:UpdateVolume' :: UpdateVolume -> Text
$sel:name:UpdateVolume' :: UpdateVolume -> Maybe Text
$sel:mountPoint:UpdateVolume' :: UpdateVolume -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MountPoint" 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
mountPoint,
            (Key
"Name" 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
name,
            forall a. a -> Maybe a
Prelude.Just (Key
"VolumeId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
volumeId)
          ]
      )

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

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

-- | /See:/ 'newUpdateVolumeResponse' smart constructor.
data UpdateVolumeResponse = UpdateVolumeResponse'
  {
  }
  deriving (UpdateVolumeResponse -> UpdateVolumeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateVolumeResponse -> UpdateVolumeResponse -> Bool
$c/= :: UpdateVolumeResponse -> UpdateVolumeResponse -> Bool
== :: UpdateVolumeResponse -> UpdateVolumeResponse -> Bool
$c== :: UpdateVolumeResponse -> UpdateVolumeResponse -> Bool
Prelude.Eq, ReadPrec [UpdateVolumeResponse]
ReadPrec UpdateVolumeResponse
Int -> ReadS UpdateVolumeResponse
ReadS [UpdateVolumeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateVolumeResponse]
$creadListPrec :: ReadPrec [UpdateVolumeResponse]
readPrec :: ReadPrec UpdateVolumeResponse
$creadPrec :: ReadPrec UpdateVolumeResponse
readList :: ReadS [UpdateVolumeResponse]
$creadList :: ReadS [UpdateVolumeResponse]
readsPrec :: Int -> ReadS UpdateVolumeResponse
$creadsPrec :: Int -> ReadS UpdateVolumeResponse
Prelude.Read, Int -> UpdateVolumeResponse -> ShowS
[UpdateVolumeResponse] -> ShowS
UpdateVolumeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateVolumeResponse] -> ShowS
$cshowList :: [UpdateVolumeResponse] -> ShowS
show :: UpdateVolumeResponse -> String
$cshow :: UpdateVolumeResponse -> String
showsPrec :: Int -> UpdateVolumeResponse -> ShowS
$cshowsPrec :: Int -> UpdateVolumeResponse -> ShowS
Prelude.Show, forall x. Rep UpdateVolumeResponse x -> UpdateVolumeResponse
forall x. UpdateVolumeResponse -> Rep UpdateVolumeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateVolumeResponse x -> UpdateVolumeResponse
$cfrom :: forall x. UpdateVolumeResponse -> Rep UpdateVolumeResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateVolumeResponse' 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.
newUpdateVolumeResponse ::
  UpdateVolumeResponse
newUpdateVolumeResponse :: UpdateVolumeResponse
newUpdateVolumeResponse = UpdateVolumeResponse
UpdateVolumeResponse'

instance Prelude.NFData UpdateVolumeResponse where
  rnf :: UpdateVolumeResponse -> ()
rnf UpdateVolumeResponse
_ = ()