{-# 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.Personalize.CreateSolutionVersion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Trains or retrains an active solution in a Custom dataset group. A
-- solution is created using the
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_CreateSolution.html CreateSolution>
-- operation and must be in the ACTIVE state before calling
-- @CreateSolutionVersion@. A new version of the solution is created every
-- time you call this operation.
--
-- __Status__
--
-- A solution version can be in one of the following states:
--
-- -   CREATE PENDING
--
-- -   CREATE IN_PROGRESS
--
-- -   ACTIVE
--
-- -   CREATE FAILED
--
-- -   CREATE STOPPING
--
-- -   CREATE STOPPED
--
-- To get the status of the version, call
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_DescribeSolutionVersion.html DescribeSolutionVersion>.
-- Wait until the status shows as ACTIVE before calling @CreateCampaign@.
--
-- If the status shows as CREATE FAILED, the response includes a
-- @failureReason@ key, which describes why the job failed.
--
-- __Related APIs__
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_ListSolutionVersions.html ListSolutionVersions>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_DescribeSolutionVersion.html DescribeSolutionVersion>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_ListSolutions.html ListSolutions>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_CreateSolution.html CreateSolution>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_DescribeSolution.html DescribeSolution>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_DeleteSolution.html DeleteSolution>
module Amazonka.Personalize.CreateSolutionVersion
  ( -- * Creating a Request
    CreateSolutionVersion (..),
    newCreateSolutionVersion,

    -- * Request Lenses
    createSolutionVersion_name,
    createSolutionVersion_tags,
    createSolutionVersion_trainingMode,
    createSolutionVersion_solutionArn,

    -- * Destructuring the Response
    CreateSolutionVersionResponse (..),
    newCreateSolutionVersionResponse,

    -- * Response Lenses
    createSolutionVersionResponse_solutionVersionArn,
    createSolutionVersionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateSolutionVersion' smart constructor.
data CreateSolutionVersion = CreateSolutionVersion'
  { -- | The name of the solution version.
    CreateSolutionVersion -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | A list of
    -- <https://docs.aws.amazon.com/personalize/latest/dev/tagging-resources.html tags>
    -- to apply to the solution version.
    CreateSolutionVersion -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The scope of training to be performed when creating the solution
    -- version. The @FULL@ option trains the solution version based on the
    -- entirety of the input solution\'s training data, while the @UPDATE@
    -- option processes only the data that has changed in comparison to the
    -- input solution. Choose @UPDATE@ when you want to incrementally update
    -- your solution version instead of creating an entirely new one.
    --
    -- The @UPDATE@ option can only be used when you already have an active
    -- solution version created from the input solution using the @FULL@ option
    -- and the input solution was trained with the
    -- <https://docs.aws.amazon.com/personalize/latest/dg/native-recipe-new-item-USER_PERSONALIZATION.html User-Personalization>
    -- recipe or the
    -- <https://docs.aws.amazon.com/personalize/latest/dg/native-recipe-hrnn-coldstart.html HRNN-Coldstart>
    -- recipe.
    CreateSolutionVersion -> Maybe TrainingMode
trainingMode :: Prelude.Maybe TrainingMode,
    -- | The Amazon Resource Name (ARN) of the solution containing the training
    -- configuration information.
    CreateSolutionVersion -> Text
solutionArn :: Prelude.Text
  }
  deriving (CreateSolutionVersion -> CreateSolutionVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSolutionVersion -> CreateSolutionVersion -> Bool
$c/= :: CreateSolutionVersion -> CreateSolutionVersion -> Bool
== :: CreateSolutionVersion -> CreateSolutionVersion -> Bool
$c== :: CreateSolutionVersion -> CreateSolutionVersion -> Bool
Prelude.Eq, ReadPrec [CreateSolutionVersion]
ReadPrec CreateSolutionVersion
Int -> ReadS CreateSolutionVersion
ReadS [CreateSolutionVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSolutionVersion]
$creadListPrec :: ReadPrec [CreateSolutionVersion]
readPrec :: ReadPrec CreateSolutionVersion
$creadPrec :: ReadPrec CreateSolutionVersion
readList :: ReadS [CreateSolutionVersion]
$creadList :: ReadS [CreateSolutionVersion]
readsPrec :: Int -> ReadS CreateSolutionVersion
$creadsPrec :: Int -> ReadS CreateSolutionVersion
Prelude.Read, Int -> CreateSolutionVersion -> ShowS
[CreateSolutionVersion] -> ShowS
CreateSolutionVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSolutionVersion] -> ShowS
$cshowList :: [CreateSolutionVersion] -> ShowS
show :: CreateSolutionVersion -> String
$cshow :: CreateSolutionVersion -> String
showsPrec :: Int -> CreateSolutionVersion -> ShowS
$cshowsPrec :: Int -> CreateSolutionVersion -> ShowS
Prelude.Show, forall x. Rep CreateSolutionVersion x -> CreateSolutionVersion
forall x. CreateSolutionVersion -> Rep CreateSolutionVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSolutionVersion x -> CreateSolutionVersion
$cfrom :: forall x. CreateSolutionVersion -> Rep CreateSolutionVersion x
Prelude.Generic)

-- |
-- Create a value of 'CreateSolutionVersion' 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:
--
-- 'name', 'createSolutionVersion_name' - The name of the solution version.
--
-- 'tags', 'createSolutionVersion_tags' - A list of
-- <https://docs.aws.amazon.com/personalize/latest/dev/tagging-resources.html tags>
-- to apply to the solution version.
--
-- 'trainingMode', 'createSolutionVersion_trainingMode' - The scope of training to be performed when creating the solution
-- version. The @FULL@ option trains the solution version based on the
-- entirety of the input solution\'s training data, while the @UPDATE@
-- option processes only the data that has changed in comparison to the
-- input solution. Choose @UPDATE@ when you want to incrementally update
-- your solution version instead of creating an entirely new one.
--
-- The @UPDATE@ option can only be used when you already have an active
-- solution version created from the input solution using the @FULL@ option
-- and the input solution was trained with the
-- <https://docs.aws.amazon.com/personalize/latest/dg/native-recipe-new-item-USER_PERSONALIZATION.html User-Personalization>
-- recipe or the
-- <https://docs.aws.amazon.com/personalize/latest/dg/native-recipe-hrnn-coldstart.html HRNN-Coldstart>
-- recipe.
--
-- 'solutionArn', 'createSolutionVersion_solutionArn' - The Amazon Resource Name (ARN) of the solution containing the training
-- configuration information.
newCreateSolutionVersion ::
  -- | 'solutionArn'
  Prelude.Text ->
  CreateSolutionVersion
newCreateSolutionVersion :: Text -> CreateSolutionVersion
newCreateSolutionVersion Text
pSolutionArn_ =
  CreateSolutionVersion'
    { $sel:name:CreateSolutionVersion' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateSolutionVersion' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:trainingMode:CreateSolutionVersion' :: Maybe TrainingMode
trainingMode = forall a. Maybe a
Prelude.Nothing,
      $sel:solutionArn:CreateSolutionVersion' :: Text
solutionArn = Text
pSolutionArn_
    }

-- | The name of the solution version.
createSolutionVersion_name :: Lens.Lens' CreateSolutionVersion (Prelude.Maybe Prelude.Text)
createSolutionVersion_name :: Lens' CreateSolutionVersion (Maybe Text)
createSolutionVersion_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSolutionVersion' {Maybe Text
name :: Maybe Text
$sel:name:CreateSolutionVersion' :: CreateSolutionVersion -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateSolutionVersion
s@CreateSolutionVersion' {} Maybe Text
a -> CreateSolutionVersion
s {$sel:name:CreateSolutionVersion' :: Maybe Text
name = Maybe Text
a} :: CreateSolutionVersion)

-- | A list of
-- <https://docs.aws.amazon.com/personalize/latest/dev/tagging-resources.html tags>
-- to apply to the solution version.
createSolutionVersion_tags :: Lens.Lens' CreateSolutionVersion (Prelude.Maybe [Tag])
createSolutionVersion_tags :: Lens' CreateSolutionVersion (Maybe [Tag])
createSolutionVersion_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSolutionVersion' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateSolutionVersion' :: CreateSolutionVersion -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateSolutionVersion
s@CreateSolutionVersion' {} Maybe [Tag]
a -> CreateSolutionVersion
s {$sel:tags:CreateSolutionVersion' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateSolutionVersion) 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

-- | The scope of training to be performed when creating the solution
-- version. The @FULL@ option trains the solution version based on the
-- entirety of the input solution\'s training data, while the @UPDATE@
-- option processes only the data that has changed in comparison to the
-- input solution. Choose @UPDATE@ when you want to incrementally update
-- your solution version instead of creating an entirely new one.
--
-- The @UPDATE@ option can only be used when you already have an active
-- solution version created from the input solution using the @FULL@ option
-- and the input solution was trained with the
-- <https://docs.aws.amazon.com/personalize/latest/dg/native-recipe-new-item-USER_PERSONALIZATION.html User-Personalization>
-- recipe or the
-- <https://docs.aws.amazon.com/personalize/latest/dg/native-recipe-hrnn-coldstart.html HRNN-Coldstart>
-- recipe.
createSolutionVersion_trainingMode :: Lens.Lens' CreateSolutionVersion (Prelude.Maybe TrainingMode)
createSolutionVersion_trainingMode :: Lens' CreateSolutionVersion (Maybe TrainingMode)
createSolutionVersion_trainingMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSolutionVersion' {Maybe TrainingMode
trainingMode :: Maybe TrainingMode
$sel:trainingMode:CreateSolutionVersion' :: CreateSolutionVersion -> Maybe TrainingMode
trainingMode} -> Maybe TrainingMode
trainingMode) (\s :: CreateSolutionVersion
s@CreateSolutionVersion' {} Maybe TrainingMode
a -> CreateSolutionVersion
s {$sel:trainingMode:CreateSolutionVersion' :: Maybe TrainingMode
trainingMode = Maybe TrainingMode
a} :: CreateSolutionVersion)

-- | The Amazon Resource Name (ARN) of the solution containing the training
-- configuration information.
createSolutionVersion_solutionArn :: Lens.Lens' CreateSolutionVersion Prelude.Text
createSolutionVersion_solutionArn :: Lens' CreateSolutionVersion Text
createSolutionVersion_solutionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSolutionVersion' {Text
solutionArn :: Text
$sel:solutionArn:CreateSolutionVersion' :: CreateSolutionVersion -> Text
solutionArn} -> Text
solutionArn) (\s :: CreateSolutionVersion
s@CreateSolutionVersion' {} Text
a -> CreateSolutionVersion
s {$sel:solutionArn:CreateSolutionVersion' :: Text
solutionArn = Text
a} :: CreateSolutionVersion)

instance Core.AWSRequest CreateSolutionVersion where
  type
    AWSResponse CreateSolutionVersion =
      CreateSolutionVersionResponse
  request :: (Service -> Service)
-> CreateSolutionVersion -> Request CreateSolutionVersion
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 CreateSolutionVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateSolutionVersion)))
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 -> CreateSolutionVersionResponse
CreateSolutionVersionResponse'
            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
"solutionVersionArn")
            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 CreateSolutionVersion where
  hashWithSalt :: Int -> CreateSolutionVersion -> Int
hashWithSalt Int
_salt CreateSolutionVersion' {Maybe [Tag]
Maybe Text
Maybe TrainingMode
Text
solutionArn :: Text
trainingMode :: Maybe TrainingMode
tags :: Maybe [Tag]
name :: Maybe Text
$sel:solutionArn:CreateSolutionVersion' :: CreateSolutionVersion -> Text
$sel:trainingMode:CreateSolutionVersion' :: CreateSolutionVersion -> Maybe TrainingMode
$sel:tags:CreateSolutionVersion' :: CreateSolutionVersion -> Maybe [Tag]
$sel:name:CreateSolutionVersion' :: CreateSolutionVersion -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TrainingMode
trainingMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
solutionArn

instance Prelude.NFData CreateSolutionVersion where
  rnf :: CreateSolutionVersion -> ()
rnf CreateSolutionVersion' {Maybe [Tag]
Maybe Text
Maybe TrainingMode
Text
solutionArn :: Text
trainingMode :: Maybe TrainingMode
tags :: Maybe [Tag]
name :: Maybe Text
$sel:solutionArn:CreateSolutionVersion' :: CreateSolutionVersion -> Text
$sel:trainingMode:CreateSolutionVersion' :: CreateSolutionVersion -> Maybe TrainingMode
$sel:tags:CreateSolutionVersion' :: CreateSolutionVersion -> Maybe [Tag]
$sel:name:CreateSolutionVersion' :: CreateSolutionVersion -> Maybe Text
..} =
    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 Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TrainingMode
trainingMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
solutionArn

instance Data.ToHeaders CreateSolutionVersion where
  toHeaders :: CreateSolutionVersion -> 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
"AmazonPersonalize.CreateSolutionVersion" ::
                          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 CreateSolutionVersion where
  toJSON :: CreateSolutionVersion -> Value
toJSON CreateSolutionVersion' {Maybe [Tag]
Maybe Text
Maybe TrainingMode
Text
solutionArn :: Text
trainingMode :: Maybe TrainingMode
tags :: Maybe [Tag]
name :: Maybe Text
$sel:solutionArn:CreateSolutionVersion' :: CreateSolutionVersion -> Text
$sel:trainingMode:CreateSolutionVersion' :: CreateSolutionVersion -> Maybe TrainingMode
$sel:tags:CreateSolutionVersion' :: CreateSolutionVersion -> Maybe [Tag]
$sel:name:CreateSolutionVersion' :: CreateSolutionVersion -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            (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 [Tag]
tags,
            (Key
"trainingMode" 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 TrainingMode
trainingMode,
            forall a. a -> Maybe a
Prelude.Just (Key
"solutionArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
solutionArn)
          ]
      )

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

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

-- | /See:/ 'newCreateSolutionVersionResponse' smart constructor.
data CreateSolutionVersionResponse = CreateSolutionVersionResponse'
  { -- | The ARN of the new solution version.
    CreateSolutionVersionResponse -> Maybe Text
solutionVersionArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateSolutionVersionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateSolutionVersionResponse
-> CreateSolutionVersionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSolutionVersionResponse
-> CreateSolutionVersionResponse -> Bool
$c/= :: CreateSolutionVersionResponse
-> CreateSolutionVersionResponse -> Bool
== :: CreateSolutionVersionResponse
-> CreateSolutionVersionResponse -> Bool
$c== :: CreateSolutionVersionResponse
-> CreateSolutionVersionResponse -> Bool
Prelude.Eq, ReadPrec [CreateSolutionVersionResponse]
ReadPrec CreateSolutionVersionResponse
Int -> ReadS CreateSolutionVersionResponse
ReadS [CreateSolutionVersionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSolutionVersionResponse]
$creadListPrec :: ReadPrec [CreateSolutionVersionResponse]
readPrec :: ReadPrec CreateSolutionVersionResponse
$creadPrec :: ReadPrec CreateSolutionVersionResponse
readList :: ReadS [CreateSolutionVersionResponse]
$creadList :: ReadS [CreateSolutionVersionResponse]
readsPrec :: Int -> ReadS CreateSolutionVersionResponse
$creadsPrec :: Int -> ReadS CreateSolutionVersionResponse
Prelude.Read, Int -> CreateSolutionVersionResponse -> ShowS
[CreateSolutionVersionResponse] -> ShowS
CreateSolutionVersionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSolutionVersionResponse] -> ShowS
$cshowList :: [CreateSolutionVersionResponse] -> ShowS
show :: CreateSolutionVersionResponse -> String
$cshow :: CreateSolutionVersionResponse -> String
showsPrec :: Int -> CreateSolutionVersionResponse -> ShowS
$cshowsPrec :: Int -> CreateSolutionVersionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateSolutionVersionResponse x
-> CreateSolutionVersionResponse
forall x.
CreateSolutionVersionResponse
-> Rep CreateSolutionVersionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateSolutionVersionResponse x
-> CreateSolutionVersionResponse
$cfrom :: forall x.
CreateSolutionVersionResponse
-> Rep CreateSolutionVersionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSolutionVersionResponse' 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:
--
-- 'solutionVersionArn', 'createSolutionVersionResponse_solutionVersionArn' - The ARN of the new solution version.
--
-- 'httpStatus', 'createSolutionVersionResponse_httpStatus' - The response's http status code.
newCreateSolutionVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSolutionVersionResponse
newCreateSolutionVersionResponse :: Int -> CreateSolutionVersionResponse
newCreateSolutionVersionResponse Int
pHttpStatus_ =
  CreateSolutionVersionResponse'
    { $sel:solutionVersionArn:CreateSolutionVersionResponse' :: Maybe Text
solutionVersionArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSolutionVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the new solution version.
createSolutionVersionResponse_solutionVersionArn :: Lens.Lens' CreateSolutionVersionResponse (Prelude.Maybe Prelude.Text)
createSolutionVersionResponse_solutionVersionArn :: Lens' CreateSolutionVersionResponse (Maybe Text)
createSolutionVersionResponse_solutionVersionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSolutionVersionResponse' {Maybe Text
solutionVersionArn :: Maybe Text
$sel:solutionVersionArn:CreateSolutionVersionResponse' :: CreateSolutionVersionResponse -> Maybe Text
solutionVersionArn} -> Maybe Text
solutionVersionArn) (\s :: CreateSolutionVersionResponse
s@CreateSolutionVersionResponse' {} Maybe Text
a -> CreateSolutionVersionResponse
s {$sel:solutionVersionArn:CreateSolutionVersionResponse' :: Maybe Text
solutionVersionArn = Maybe Text
a} :: CreateSolutionVersionResponse)

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

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