{-# 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.FSx.CreateVolume
-- 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 FSx for ONTAP or Amazon FSx for OpenZFS storage volume.
module Amazonka.FSx.CreateVolume
  ( -- * Creating a Request
    CreateVolume (..),
    newCreateVolume,

    -- * Request Lenses
    createVolume_clientRequestToken,
    createVolume_ontapConfiguration,
    createVolume_openZFSConfiguration,
    createVolume_tags,
    createVolume_volumeType,
    createVolume_name,

    -- * Destructuring the Response
    CreateVolumeResponse (..),
    newCreateVolumeResponse,

    -- * Response Lenses
    createVolumeResponse_volume,
    createVolumeResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateVolume' smart constructor.
data CreateVolume = CreateVolume'
  { CreateVolume -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | Specifies the configuration to use when creating the ONTAP volume.
    CreateVolume -> Maybe CreateOntapVolumeConfiguration
ontapConfiguration :: Prelude.Maybe CreateOntapVolumeConfiguration,
    -- | Specifies the configuration to use when creating the OpenZFS volume.
    CreateVolume -> Maybe CreateOpenZFSVolumeConfiguration
openZFSConfiguration :: Prelude.Maybe CreateOpenZFSVolumeConfiguration,
    CreateVolume -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | Specifies the type of volume to create; @ONTAP@ and @OPENZFS@ are the
    -- only valid volume types.
    CreateVolume -> VolumeType
volumeType :: VolumeType,
    -- | Specifies the name of the volume that you\'re creating.
    CreateVolume -> Text
name :: Prelude.Text
  }
  deriving (CreateVolume -> CreateVolume -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVolume -> CreateVolume -> Bool
$c/= :: CreateVolume -> CreateVolume -> Bool
== :: CreateVolume -> CreateVolume -> Bool
$c== :: CreateVolume -> CreateVolume -> Bool
Prelude.Eq, ReadPrec [CreateVolume]
ReadPrec CreateVolume
Int -> ReadS CreateVolume
ReadS [CreateVolume]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVolume]
$creadListPrec :: ReadPrec [CreateVolume]
readPrec :: ReadPrec CreateVolume
$creadPrec :: ReadPrec CreateVolume
readList :: ReadS [CreateVolume]
$creadList :: ReadS [CreateVolume]
readsPrec :: Int -> ReadS CreateVolume
$creadsPrec :: Int -> ReadS CreateVolume
Prelude.Read, Int -> CreateVolume -> ShowS
[CreateVolume] -> ShowS
CreateVolume -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVolume] -> ShowS
$cshowList :: [CreateVolume] -> ShowS
show :: CreateVolume -> String
$cshow :: CreateVolume -> String
showsPrec :: Int -> CreateVolume -> ShowS
$cshowsPrec :: Int -> CreateVolume -> ShowS
Prelude.Show, forall x. Rep CreateVolume x -> CreateVolume
forall x. CreateVolume -> Rep CreateVolume x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateVolume x -> CreateVolume
$cfrom :: forall x. CreateVolume -> Rep CreateVolume x
Prelude.Generic)

-- |
-- Create a value of 'CreateVolume' 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:
--
-- 'clientRequestToken', 'createVolume_clientRequestToken' - Undocumented member.
--
-- 'ontapConfiguration', 'createVolume_ontapConfiguration' - Specifies the configuration to use when creating the ONTAP volume.
--
-- 'openZFSConfiguration', 'createVolume_openZFSConfiguration' - Specifies the configuration to use when creating the OpenZFS volume.
--
-- 'tags', 'createVolume_tags' - Undocumented member.
--
-- 'volumeType', 'createVolume_volumeType' - Specifies the type of volume to create; @ONTAP@ and @OPENZFS@ are the
-- only valid volume types.
--
-- 'name', 'createVolume_name' - Specifies the name of the volume that you\'re creating.
newCreateVolume ::
  -- | 'volumeType'
  VolumeType ->
  -- | 'name'
  Prelude.Text ->
  CreateVolume
newCreateVolume :: VolumeType -> Text -> CreateVolume
newCreateVolume VolumeType
pVolumeType_ Text
pName_ =
  CreateVolume'
    { $sel:clientRequestToken:CreateVolume' :: Maybe Text
clientRequestToken = forall a. Maybe a
Prelude.Nothing,
      $sel:ontapConfiguration:CreateVolume' :: Maybe CreateOntapVolumeConfiguration
ontapConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:openZFSConfiguration:CreateVolume' :: Maybe CreateOpenZFSVolumeConfiguration
openZFSConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateVolume' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeType:CreateVolume' :: VolumeType
volumeType = VolumeType
pVolumeType_,
      $sel:name:CreateVolume' :: Text
name = Text
pName_
    }

-- | Undocumented member.
createVolume_clientRequestToken :: Lens.Lens' CreateVolume (Prelude.Maybe Prelude.Text)
createVolume_clientRequestToken :: Lens' CreateVolume (Maybe Text)
createVolume_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateVolume' :: CreateVolume -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateVolume
s@CreateVolume' {} Maybe Text
a -> CreateVolume
s {$sel:clientRequestToken:CreateVolume' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateVolume)

-- | Specifies the configuration to use when creating the ONTAP volume.
createVolume_ontapConfiguration :: Lens.Lens' CreateVolume (Prelude.Maybe CreateOntapVolumeConfiguration)
createVolume_ontapConfiguration :: Lens' CreateVolume (Maybe CreateOntapVolumeConfiguration)
createVolume_ontapConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe CreateOntapVolumeConfiguration
ontapConfiguration :: Maybe CreateOntapVolumeConfiguration
$sel:ontapConfiguration:CreateVolume' :: CreateVolume -> Maybe CreateOntapVolumeConfiguration
ontapConfiguration} -> Maybe CreateOntapVolumeConfiguration
ontapConfiguration) (\s :: CreateVolume
s@CreateVolume' {} Maybe CreateOntapVolumeConfiguration
a -> CreateVolume
s {$sel:ontapConfiguration:CreateVolume' :: Maybe CreateOntapVolumeConfiguration
ontapConfiguration = Maybe CreateOntapVolumeConfiguration
a} :: CreateVolume)

-- | Specifies the configuration to use when creating the OpenZFS volume.
createVolume_openZFSConfiguration :: Lens.Lens' CreateVolume (Prelude.Maybe CreateOpenZFSVolumeConfiguration)
createVolume_openZFSConfiguration :: Lens' CreateVolume (Maybe CreateOpenZFSVolumeConfiguration)
createVolume_openZFSConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe CreateOpenZFSVolumeConfiguration
openZFSConfiguration :: Maybe CreateOpenZFSVolumeConfiguration
$sel:openZFSConfiguration:CreateVolume' :: CreateVolume -> Maybe CreateOpenZFSVolumeConfiguration
openZFSConfiguration} -> Maybe CreateOpenZFSVolumeConfiguration
openZFSConfiguration) (\s :: CreateVolume
s@CreateVolume' {} Maybe CreateOpenZFSVolumeConfiguration
a -> CreateVolume
s {$sel:openZFSConfiguration:CreateVolume' :: Maybe CreateOpenZFSVolumeConfiguration
openZFSConfiguration = Maybe CreateOpenZFSVolumeConfiguration
a} :: CreateVolume)

-- | Undocumented member.
createVolume_tags :: Lens.Lens' CreateVolume (Prelude.Maybe (Prelude.NonEmpty Tag))
createVolume_tags :: Lens' CreateVolume (Maybe (NonEmpty Tag))
createVolume_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateVolume' :: CreateVolume -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateVolume
s@CreateVolume' {} Maybe (NonEmpty Tag)
a -> CreateVolume
s {$sel:tags:CreateVolume' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateVolume) 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

-- | Specifies the type of volume to create; @ONTAP@ and @OPENZFS@ are the
-- only valid volume types.
createVolume_volumeType :: Lens.Lens' CreateVolume VolumeType
createVolume_volumeType :: Lens' CreateVolume VolumeType
createVolume_volumeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {VolumeType
volumeType :: VolumeType
$sel:volumeType:CreateVolume' :: CreateVolume -> VolumeType
volumeType} -> VolumeType
volumeType) (\s :: CreateVolume
s@CreateVolume' {} VolumeType
a -> CreateVolume
s {$sel:volumeType:CreateVolume' :: VolumeType
volumeType = VolumeType
a} :: CreateVolume)

-- | Specifies the name of the volume that you\'re creating.
createVolume_name :: Lens.Lens' CreateVolume Prelude.Text
createVolume_name :: Lens' CreateVolume Text
createVolume_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Text
name :: Text
$sel:name:CreateVolume' :: CreateVolume -> Text
name} -> Text
name) (\s :: CreateVolume
s@CreateVolume' {} Text
a -> CreateVolume
s {$sel:name:CreateVolume' :: Text
name = Text
a} :: CreateVolume)

instance Core.AWSRequest CreateVolume where
  type AWSResponse CreateVolume = CreateVolumeResponse
  request :: (Service -> Service) -> CreateVolume -> Request CreateVolume
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 CreateVolume
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateVolume)))
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 Volume -> Int -> CreateVolumeResponse
CreateVolumeResponse'
            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
"Volume")
            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 CreateVolume where
  hashWithSalt :: Int -> CreateVolume -> Int
hashWithSalt Int
_salt CreateVolume' {Maybe (NonEmpty Tag)
Maybe Text
Maybe CreateOpenZFSVolumeConfiguration
Maybe CreateOntapVolumeConfiguration
Text
VolumeType
name :: Text
volumeType :: VolumeType
tags :: Maybe (NonEmpty Tag)
openZFSConfiguration :: Maybe CreateOpenZFSVolumeConfiguration
ontapConfiguration :: Maybe CreateOntapVolumeConfiguration
clientRequestToken :: Maybe Text
$sel:name:CreateVolume' :: CreateVolume -> Text
$sel:volumeType:CreateVolume' :: CreateVolume -> VolumeType
$sel:tags:CreateVolume' :: CreateVolume -> Maybe (NonEmpty Tag)
$sel:openZFSConfiguration:CreateVolume' :: CreateVolume -> Maybe CreateOpenZFSVolumeConfiguration
$sel:ontapConfiguration:CreateVolume' :: CreateVolume -> Maybe CreateOntapVolumeConfiguration
$sel:clientRequestToken:CreateVolume' :: CreateVolume -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateOntapVolumeConfiguration
ontapConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateOpenZFSVolumeConfiguration
openZFSConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VolumeType
volumeType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateVolume where
  rnf :: CreateVolume -> ()
rnf CreateVolume' {Maybe (NonEmpty Tag)
Maybe Text
Maybe CreateOpenZFSVolumeConfiguration
Maybe CreateOntapVolumeConfiguration
Text
VolumeType
name :: Text
volumeType :: VolumeType
tags :: Maybe (NonEmpty Tag)
openZFSConfiguration :: Maybe CreateOpenZFSVolumeConfiguration
ontapConfiguration :: Maybe CreateOntapVolumeConfiguration
clientRequestToken :: Maybe Text
$sel:name:CreateVolume' :: CreateVolume -> Text
$sel:volumeType:CreateVolume' :: CreateVolume -> VolumeType
$sel:tags:CreateVolume' :: CreateVolume -> Maybe (NonEmpty Tag)
$sel:openZFSConfiguration:CreateVolume' :: CreateVolume -> Maybe CreateOpenZFSVolumeConfiguration
$sel:ontapConfiguration:CreateVolume' :: CreateVolume -> Maybe CreateOntapVolumeConfiguration
$sel:clientRequestToken:CreateVolume' :: CreateVolume -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CreateOntapVolumeConfiguration
ontapConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CreateOpenZFSVolumeConfiguration
openZFSConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VolumeType
volumeType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateVolume where
  toHeaders :: CreateVolume -> 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
"AWSSimbaAPIService_v20180301.CreateVolume" ::
                          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 CreateVolume where
  toJSON :: CreateVolume -> Value
toJSON CreateVolume' {Maybe (NonEmpty Tag)
Maybe Text
Maybe CreateOpenZFSVolumeConfiguration
Maybe CreateOntapVolumeConfiguration
Text
VolumeType
name :: Text
volumeType :: VolumeType
tags :: Maybe (NonEmpty Tag)
openZFSConfiguration :: Maybe CreateOpenZFSVolumeConfiguration
ontapConfiguration :: Maybe CreateOntapVolumeConfiguration
clientRequestToken :: Maybe Text
$sel:name:CreateVolume' :: CreateVolume -> Text
$sel:volumeType:CreateVolume' :: CreateVolume -> VolumeType
$sel:tags:CreateVolume' :: CreateVolume -> Maybe (NonEmpty Tag)
$sel:openZFSConfiguration:CreateVolume' :: CreateVolume -> Maybe CreateOpenZFSVolumeConfiguration
$sel:ontapConfiguration:CreateVolume' :: CreateVolume -> Maybe CreateOntapVolumeConfiguration
$sel:clientRequestToken:CreateVolume' :: CreateVolume -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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
clientRequestToken,
            (Key
"OntapConfiguration" 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 CreateOntapVolumeConfiguration
ontapConfiguration,
            (Key
"OpenZFSConfiguration" 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 CreateOpenZFSVolumeConfiguration
openZFSConfiguration,
            (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 (NonEmpty Tag)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"VolumeType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= VolumeType
volumeType),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

-- | /See:/ 'newCreateVolumeResponse' smart constructor.
data CreateVolumeResponse = CreateVolumeResponse'
  { -- | Returned after a successful @CreateVolume@ API operation, describing the
    -- volume just created.
    CreateVolumeResponse -> Maybe Volume
volume :: Prelude.Maybe Volume,
    -- | The response's http status code.
    CreateVolumeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateVolumeResponse -> CreateVolumeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVolumeResponse -> CreateVolumeResponse -> Bool
$c/= :: CreateVolumeResponse -> CreateVolumeResponse -> Bool
== :: CreateVolumeResponse -> CreateVolumeResponse -> Bool
$c== :: CreateVolumeResponse -> CreateVolumeResponse -> Bool
Prelude.Eq, ReadPrec [CreateVolumeResponse]
ReadPrec CreateVolumeResponse
Int -> ReadS CreateVolumeResponse
ReadS [CreateVolumeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVolumeResponse]
$creadListPrec :: ReadPrec [CreateVolumeResponse]
readPrec :: ReadPrec CreateVolumeResponse
$creadPrec :: ReadPrec CreateVolumeResponse
readList :: ReadS [CreateVolumeResponse]
$creadList :: ReadS [CreateVolumeResponse]
readsPrec :: Int -> ReadS CreateVolumeResponse
$creadsPrec :: Int -> ReadS CreateVolumeResponse
Prelude.Read, Int -> CreateVolumeResponse -> ShowS
[CreateVolumeResponse] -> ShowS
CreateVolumeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVolumeResponse] -> ShowS
$cshowList :: [CreateVolumeResponse] -> ShowS
show :: CreateVolumeResponse -> String
$cshow :: CreateVolumeResponse -> String
showsPrec :: Int -> CreateVolumeResponse -> ShowS
$cshowsPrec :: Int -> CreateVolumeResponse -> ShowS
Prelude.Show, forall x. Rep CreateVolumeResponse x -> CreateVolumeResponse
forall x. CreateVolumeResponse -> Rep CreateVolumeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateVolumeResponse x -> CreateVolumeResponse
$cfrom :: forall x. CreateVolumeResponse -> Rep CreateVolumeResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateVolumeResponse' 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:
--
-- 'volume', 'createVolumeResponse_volume' - Returned after a successful @CreateVolume@ API operation, describing the
-- volume just created.
--
-- 'httpStatus', 'createVolumeResponse_httpStatus' - The response's http status code.
newCreateVolumeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateVolumeResponse
newCreateVolumeResponse :: Int -> CreateVolumeResponse
newCreateVolumeResponse Int
pHttpStatus_ =
  CreateVolumeResponse'
    { $sel:volume:CreateVolumeResponse' :: Maybe Volume
volume = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateVolumeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returned after a successful @CreateVolume@ API operation, describing the
-- volume just created.
createVolumeResponse_volume :: Lens.Lens' CreateVolumeResponse (Prelude.Maybe Volume)
createVolumeResponse_volume :: Lens' CreateVolumeResponse (Maybe Volume)
createVolumeResponse_volume = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolumeResponse' {Maybe Volume
volume :: Maybe Volume
$sel:volume:CreateVolumeResponse' :: CreateVolumeResponse -> Maybe Volume
volume} -> Maybe Volume
volume) (\s :: CreateVolumeResponse
s@CreateVolumeResponse' {} Maybe Volume
a -> CreateVolumeResponse
s {$sel:volume:CreateVolumeResponse' :: Maybe Volume
volume = Maybe Volume
a} :: CreateVolumeResponse)

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

instance Prelude.NFData CreateVolumeResponse where
  rnf :: CreateVolumeResponse -> ()
rnf CreateVolumeResponse' {Int
Maybe Volume
httpStatus :: Int
volume :: Maybe Volume
$sel:httpStatus:CreateVolumeResponse' :: CreateVolumeResponse -> Int
$sel:volume:CreateVolumeResponse' :: CreateVolumeResponse -> Maybe Volume
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Volume
volume
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus