{-# 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.CreateSolution
-- 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 the configuration for training a model. A trained model is known
-- as a solution. After the configuration is created, you train the model
-- (create a solution) by calling the
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_CreateSolutionVersion.html CreateSolutionVersion>
-- operation. Every time you call @CreateSolutionVersion@, a new version of
-- the solution is created.
--
-- After creating a solution version, you check its accuracy by calling
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_GetSolutionMetrics.html GetSolutionMetrics>.
-- When you are satisfied with the version, you deploy it using
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_CreateCampaign.html CreateCampaign>.
-- The campaign provides recommendations to a client through the
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_RS_GetRecommendations.html GetRecommendations>
-- API.
--
-- To train a model, Amazon Personalize requires training data and a
-- recipe. The training data comes from the dataset group that you provide
-- in the request. A recipe specifies the training algorithm and a feature
-- transformation. You can specify one of the predefined recipes provided
-- by Amazon Personalize. Alternatively, you can specify @performAutoML@
-- and Amazon Personalize will analyze your data and select the optimum
-- USER_PERSONALIZATION recipe for you.
--
-- Amazon Personalize doesn\'t support configuring the @hpoObjective@ for
-- solution hyperparameter optimization at this time.
--
-- __Status__
--
-- A solution can be in one of the following states:
--
-- -   CREATE PENDING > CREATE IN_PROGRESS > ACTIVE -or- CREATE FAILED
--
-- -   DELETE PENDING > DELETE IN_PROGRESS
--
-- To get the status of the solution, call
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_DescribeSolution.html DescribeSolution>.
-- Wait until the status shows as ACTIVE before calling
-- @CreateSolutionVersion@.
--
-- __Related APIs__
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_ListSolutions.html ListSolutions>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_CreateSolutionVersion.html CreateSolutionVersion>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_DescribeSolution.html DescribeSolution>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_DeleteSolution.html DeleteSolution>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_ListSolutionVersions.html ListSolutionVersions>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_DescribeSolutionVersion.html DescribeSolutionVersion>
module Amazonka.Personalize.CreateSolution
  ( -- * Creating a Request
    CreateSolution (..),
    newCreateSolution,

    -- * Request Lenses
    createSolution_eventType,
    createSolution_performAutoML,
    createSolution_performHPO,
    createSolution_recipeArn,
    createSolution_solutionConfig,
    createSolution_tags,
    createSolution_name,
    createSolution_datasetGroupArn,

    -- * Destructuring the Response
    CreateSolutionResponse (..),
    newCreateSolutionResponse,

    -- * Response Lenses
    createSolutionResponse_solutionArn,
    createSolutionResponse_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:/ 'newCreateSolution' smart constructor.
data CreateSolution = CreateSolution'
  { -- | When your have multiple event types (using an @EVENT_TYPE@ schema
    -- field), this parameter specifies which event type (for example,
    -- \'click\' or \'like\') is used for training the model.
    --
    -- If you do not provide an @eventType@, Amazon Personalize will use all
    -- interactions for training with equal weight regardless of type.
    CreateSolution -> Maybe Text
eventType :: Prelude.Maybe Prelude.Text,
    -- | Whether to perform automated machine learning (AutoML). The default is
    -- @false@. For this case, you must specify @recipeArn@.
    --
    -- When set to @true@, Amazon Personalize analyzes your training data and
    -- selects the optimal USER_PERSONALIZATION recipe and hyperparameters. In
    -- this case, you must omit @recipeArn@. Amazon Personalize determines the
    -- optimal recipe by running tests with different values for the
    -- hyperparameters. AutoML lengthens the training process as compared to
    -- selecting a specific recipe.
    CreateSolution -> Maybe Bool
performAutoML :: Prelude.Maybe Prelude.Bool,
    -- | Whether to perform hyperparameter optimization (HPO) on the specified or
    -- selected recipe. The default is @false@.
    --
    -- When performing AutoML, this parameter is always @true@ and you should
    -- not set it to @false@.
    CreateSolution -> Maybe Bool
performHPO :: Prelude.Maybe Prelude.Bool,
    -- | The ARN of the recipe to use for model training. Only specified when
    -- @performAutoML@ is false.
    CreateSolution -> Maybe Text
recipeArn :: Prelude.Maybe Prelude.Text,
    -- | The configuration to use with the solution. When @performAutoML@ is set
    -- to true, Amazon Personalize only evaluates the @autoMLConfig@ section of
    -- the solution configuration.
    --
    -- Amazon Personalize doesn\'t support configuring the @hpoObjective@ at
    -- this time.
    CreateSolution -> Maybe SolutionConfig
solutionConfig :: Prelude.Maybe SolutionConfig,
    -- | A list of
    -- <https://docs.aws.amazon.com/personalize/latest/dev/tagging-resources.html tags>
    -- to apply to the solution.
    CreateSolution -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name for the solution.
    CreateSolution -> Text
name :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the dataset group that provides the
    -- training data.
    CreateSolution -> Text
datasetGroupArn :: Prelude.Text
  }
  deriving (CreateSolution -> CreateSolution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSolution -> CreateSolution -> Bool
$c/= :: CreateSolution -> CreateSolution -> Bool
== :: CreateSolution -> CreateSolution -> Bool
$c== :: CreateSolution -> CreateSolution -> Bool
Prelude.Eq, ReadPrec [CreateSolution]
ReadPrec CreateSolution
Int -> ReadS CreateSolution
ReadS [CreateSolution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSolution]
$creadListPrec :: ReadPrec [CreateSolution]
readPrec :: ReadPrec CreateSolution
$creadPrec :: ReadPrec CreateSolution
readList :: ReadS [CreateSolution]
$creadList :: ReadS [CreateSolution]
readsPrec :: Int -> ReadS CreateSolution
$creadsPrec :: Int -> ReadS CreateSolution
Prelude.Read, Int -> CreateSolution -> ShowS
[CreateSolution] -> ShowS
CreateSolution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSolution] -> ShowS
$cshowList :: [CreateSolution] -> ShowS
show :: CreateSolution -> String
$cshow :: CreateSolution -> String
showsPrec :: Int -> CreateSolution -> ShowS
$cshowsPrec :: Int -> CreateSolution -> ShowS
Prelude.Show, forall x. Rep CreateSolution x -> CreateSolution
forall x. CreateSolution -> Rep CreateSolution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSolution x -> CreateSolution
$cfrom :: forall x. CreateSolution -> Rep CreateSolution x
Prelude.Generic)

-- |
-- Create a value of 'CreateSolution' 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:
--
-- 'eventType', 'createSolution_eventType' - When your have multiple event types (using an @EVENT_TYPE@ schema
-- field), this parameter specifies which event type (for example,
-- \'click\' or \'like\') is used for training the model.
--
-- If you do not provide an @eventType@, Amazon Personalize will use all
-- interactions for training with equal weight regardless of type.
--
-- 'performAutoML', 'createSolution_performAutoML' - Whether to perform automated machine learning (AutoML). The default is
-- @false@. For this case, you must specify @recipeArn@.
--
-- When set to @true@, Amazon Personalize analyzes your training data and
-- selects the optimal USER_PERSONALIZATION recipe and hyperparameters. In
-- this case, you must omit @recipeArn@. Amazon Personalize determines the
-- optimal recipe by running tests with different values for the
-- hyperparameters. AutoML lengthens the training process as compared to
-- selecting a specific recipe.
--
-- 'performHPO', 'createSolution_performHPO' - Whether to perform hyperparameter optimization (HPO) on the specified or
-- selected recipe. The default is @false@.
--
-- When performing AutoML, this parameter is always @true@ and you should
-- not set it to @false@.
--
-- 'recipeArn', 'createSolution_recipeArn' - The ARN of the recipe to use for model training. Only specified when
-- @performAutoML@ is false.
--
-- 'solutionConfig', 'createSolution_solutionConfig' - The configuration to use with the solution. When @performAutoML@ is set
-- to true, Amazon Personalize only evaluates the @autoMLConfig@ section of
-- the solution configuration.
--
-- Amazon Personalize doesn\'t support configuring the @hpoObjective@ at
-- this time.
--
-- 'tags', 'createSolution_tags' - A list of
-- <https://docs.aws.amazon.com/personalize/latest/dev/tagging-resources.html tags>
-- to apply to the solution.
--
-- 'name', 'createSolution_name' - The name for the solution.
--
-- 'datasetGroupArn', 'createSolution_datasetGroupArn' - The Amazon Resource Name (ARN) of the dataset group that provides the
-- training data.
newCreateSolution ::
  -- | 'name'
  Prelude.Text ->
  -- | 'datasetGroupArn'
  Prelude.Text ->
  CreateSolution
newCreateSolution :: Text -> Text -> CreateSolution
newCreateSolution Text
pName_ Text
pDatasetGroupArn_ =
  CreateSolution'
    { $sel:eventType:CreateSolution' :: Maybe Text
eventType = forall a. Maybe a
Prelude.Nothing,
      $sel:performAutoML:CreateSolution' :: Maybe Bool
performAutoML = forall a. Maybe a
Prelude.Nothing,
      $sel:performHPO:CreateSolution' :: Maybe Bool
performHPO = forall a. Maybe a
Prelude.Nothing,
      $sel:recipeArn:CreateSolution' :: Maybe Text
recipeArn = forall a. Maybe a
Prelude.Nothing,
      $sel:solutionConfig:CreateSolution' :: Maybe SolutionConfig
solutionConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateSolution' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateSolution' :: Text
name = Text
pName_,
      $sel:datasetGroupArn:CreateSolution' :: Text
datasetGroupArn = Text
pDatasetGroupArn_
    }

-- | When your have multiple event types (using an @EVENT_TYPE@ schema
-- field), this parameter specifies which event type (for example,
-- \'click\' or \'like\') is used for training the model.
--
-- If you do not provide an @eventType@, Amazon Personalize will use all
-- interactions for training with equal weight regardless of type.
createSolution_eventType :: Lens.Lens' CreateSolution (Prelude.Maybe Prelude.Text)
createSolution_eventType :: Lens' CreateSolution (Maybe Text)
createSolution_eventType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSolution' {Maybe Text
eventType :: Maybe Text
$sel:eventType:CreateSolution' :: CreateSolution -> Maybe Text
eventType} -> Maybe Text
eventType) (\s :: CreateSolution
s@CreateSolution' {} Maybe Text
a -> CreateSolution
s {$sel:eventType:CreateSolution' :: Maybe Text
eventType = Maybe Text
a} :: CreateSolution)

-- | Whether to perform automated machine learning (AutoML). The default is
-- @false@. For this case, you must specify @recipeArn@.
--
-- When set to @true@, Amazon Personalize analyzes your training data and
-- selects the optimal USER_PERSONALIZATION recipe and hyperparameters. In
-- this case, you must omit @recipeArn@. Amazon Personalize determines the
-- optimal recipe by running tests with different values for the
-- hyperparameters. AutoML lengthens the training process as compared to
-- selecting a specific recipe.
createSolution_performAutoML :: Lens.Lens' CreateSolution (Prelude.Maybe Prelude.Bool)
createSolution_performAutoML :: Lens' CreateSolution (Maybe Bool)
createSolution_performAutoML = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSolution' {Maybe Bool
performAutoML :: Maybe Bool
$sel:performAutoML:CreateSolution' :: CreateSolution -> Maybe Bool
performAutoML} -> Maybe Bool
performAutoML) (\s :: CreateSolution
s@CreateSolution' {} Maybe Bool
a -> CreateSolution
s {$sel:performAutoML:CreateSolution' :: Maybe Bool
performAutoML = Maybe Bool
a} :: CreateSolution)

-- | Whether to perform hyperparameter optimization (HPO) on the specified or
-- selected recipe. The default is @false@.
--
-- When performing AutoML, this parameter is always @true@ and you should
-- not set it to @false@.
createSolution_performHPO :: Lens.Lens' CreateSolution (Prelude.Maybe Prelude.Bool)
createSolution_performHPO :: Lens' CreateSolution (Maybe Bool)
createSolution_performHPO = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSolution' {Maybe Bool
performHPO :: Maybe Bool
$sel:performHPO:CreateSolution' :: CreateSolution -> Maybe Bool
performHPO} -> Maybe Bool
performHPO) (\s :: CreateSolution
s@CreateSolution' {} Maybe Bool
a -> CreateSolution
s {$sel:performHPO:CreateSolution' :: Maybe Bool
performHPO = Maybe Bool
a} :: CreateSolution)

-- | The ARN of the recipe to use for model training. Only specified when
-- @performAutoML@ is false.
createSolution_recipeArn :: Lens.Lens' CreateSolution (Prelude.Maybe Prelude.Text)
createSolution_recipeArn :: Lens' CreateSolution (Maybe Text)
createSolution_recipeArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSolution' {Maybe Text
recipeArn :: Maybe Text
$sel:recipeArn:CreateSolution' :: CreateSolution -> Maybe Text
recipeArn} -> Maybe Text
recipeArn) (\s :: CreateSolution
s@CreateSolution' {} Maybe Text
a -> CreateSolution
s {$sel:recipeArn:CreateSolution' :: Maybe Text
recipeArn = Maybe Text
a} :: CreateSolution)

-- | The configuration to use with the solution. When @performAutoML@ is set
-- to true, Amazon Personalize only evaluates the @autoMLConfig@ section of
-- the solution configuration.
--
-- Amazon Personalize doesn\'t support configuring the @hpoObjective@ at
-- this time.
createSolution_solutionConfig :: Lens.Lens' CreateSolution (Prelude.Maybe SolutionConfig)
createSolution_solutionConfig :: Lens' CreateSolution (Maybe SolutionConfig)
createSolution_solutionConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSolution' {Maybe SolutionConfig
solutionConfig :: Maybe SolutionConfig
$sel:solutionConfig:CreateSolution' :: CreateSolution -> Maybe SolutionConfig
solutionConfig} -> Maybe SolutionConfig
solutionConfig) (\s :: CreateSolution
s@CreateSolution' {} Maybe SolutionConfig
a -> CreateSolution
s {$sel:solutionConfig:CreateSolution' :: Maybe SolutionConfig
solutionConfig = Maybe SolutionConfig
a} :: CreateSolution)

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

-- | The Amazon Resource Name (ARN) of the dataset group that provides the
-- training data.
createSolution_datasetGroupArn :: Lens.Lens' CreateSolution Prelude.Text
createSolution_datasetGroupArn :: Lens' CreateSolution Text
createSolution_datasetGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSolution' {Text
datasetGroupArn :: Text
$sel:datasetGroupArn:CreateSolution' :: CreateSolution -> Text
datasetGroupArn} -> Text
datasetGroupArn) (\s :: CreateSolution
s@CreateSolution' {} Text
a -> CreateSolution
s {$sel:datasetGroupArn:CreateSolution' :: Text
datasetGroupArn = Text
a} :: CreateSolution)

instance Core.AWSRequest CreateSolution where
  type
    AWSResponse CreateSolution =
      CreateSolutionResponse
  request :: (Service -> Service) -> CreateSolution -> Request CreateSolution
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 CreateSolution
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateSolution)))
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 -> CreateSolutionResponse
CreateSolutionResponse'
            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
"solutionArn")
            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 CreateSolution where
  hashWithSalt :: Int -> CreateSolution -> Int
hashWithSalt Int
_salt CreateSolution' {Maybe Bool
Maybe [Tag]
Maybe Text
Maybe SolutionConfig
Text
datasetGroupArn :: Text
name :: Text
tags :: Maybe [Tag]
solutionConfig :: Maybe SolutionConfig
recipeArn :: Maybe Text
performHPO :: Maybe Bool
performAutoML :: Maybe Bool
eventType :: Maybe Text
$sel:datasetGroupArn:CreateSolution' :: CreateSolution -> Text
$sel:name:CreateSolution' :: CreateSolution -> Text
$sel:tags:CreateSolution' :: CreateSolution -> Maybe [Tag]
$sel:solutionConfig:CreateSolution' :: CreateSolution -> Maybe SolutionConfig
$sel:recipeArn:CreateSolution' :: CreateSolution -> Maybe Text
$sel:performHPO:CreateSolution' :: CreateSolution -> Maybe Bool
$sel:performAutoML:CreateSolution' :: CreateSolution -> Maybe Bool
$sel:eventType:CreateSolution' :: CreateSolution -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
eventType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
performAutoML
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
performHPO
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
recipeArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SolutionConfig
solutionConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
datasetGroupArn

instance Prelude.NFData CreateSolution where
  rnf :: CreateSolution -> ()
rnf CreateSolution' {Maybe Bool
Maybe [Tag]
Maybe Text
Maybe SolutionConfig
Text
datasetGroupArn :: Text
name :: Text
tags :: Maybe [Tag]
solutionConfig :: Maybe SolutionConfig
recipeArn :: Maybe Text
performHPO :: Maybe Bool
performAutoML :: Maybe Bool
eventType :: Maybe Text
$sel:datasetGroupArn:CreateSolution' :: CreateSolution -> Text
$sel:name:CreateSolution' :: CreateSolution -> Text
$sel:tags:CreateSolution' :: CreateSolution -> Maybe [Tag]
$sel:solutionConfig:CreateSolution' :: CreateSolution -> Maybe SolutionConfig
$sel:recipeArn:CreateSolution' :: CreateSolution -> Maybe Text
$sel:performHPO:CreateSolution' :: CreateSolution -> Maybe Bool
$sel:performAutoML:CreateSolution' :: CreateSolution -> Maybe Bool
$sel:eventType:CreateSolution' :: CreateSolution -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eventType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
performAutoML
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
performHPO
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
recipeArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SolutionConfig
solutionConfig
      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 Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
datasetGroupArn

instance Data.ToHeaders CreateSolution where
  toHeaders :: CreateSolution -> 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.CreateSolution" ::
                          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 CreateSolution where
  toJSON :: CreateSolution -> Value
toJSON CreateSolution' {Maybe Bool
Maybe [Tag]
Maybe Text
Maybe SolutionConfig
Text
datasetGroupArn :: Text
name :: Text
tags :: Maybe [Tag]
solutionConfig :: Maybe SolutionConfig
recipeArn :: Maybe Text
performHPO :: Maybe Bool
performAutoML :: Maybe Bool
eventType :: Maybe Text
$sel:datasetGroupArn:CreateSolution' :: CreateSolution -> Text
$sel:name:CreateSolution' :: CreateSolution -> Text
$sel:tags:CreateSolution' :: CreateSolution -> Maybe [Tag]
$sel:solutionConfig:CreateSolution' :: CreateSolution -> Maybe SolutionConfig
$sel:recipeArn:CreateSolution' :: CreateSolution -> Maybe Text
$sel:performHPO:CreateSolution' :: CreateSolution -> Maybe Bool
$sel:performAutoML:CreateSolution' :: CreateSolution -> Maybe Bool
$sel:eventType:CreateSolution' :: CreateSolution -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"eventType" 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
eventType,
            (Key
"performAutoML" 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
performAutoML,
            (Key
"performHPO" 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
performHPO,
            (Key
"recipeArn" 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
recipeArn,
            (Key
"solutionConfig" 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 SolutionConfig
solutionConfig,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"datasetGroupArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
datasetGroupArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateSolutionResponse' 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:
--
-- 'solutionArn', 'createSolutionResponse_solutionArn' - The ARN of the solution.
--
-- 'httpStatus', 'createSolutionResponse_httpStatus' - The response's http status code.
newCreateSolutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSolutionResponse
newCreateSolutionResponse :: Int -> CreateSolutionResponse
newCreateSolutionResponse Int
pHttpStatus_ =
  CreateSolutionResponse'
    { $sel:solutionArn:CreateSolutionResponse' :: Maybe Text
solutionArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSolutionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the solution.
createSolutionResponse_solutionArn :: Lens.Lens' CreateSolutionResponse (Prelude.Maybe Prelude.Text)
createSolutionResponse_solutionArn :: Lens' CreateSolutionResponse (Maybe Text)
createSolutionResponse_solutionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSolutionResponse' {Maybe Text
solutionArn :: Maybe Text
$sel:solutionArn:CreateSolutionResponse' :: CreateSolutionResponse -> Maybe Text
solutionArn} -> Maybe Text
solutionArn) (\s :: CreateSolutionResponse
s@CreateSolutionResponse' {} Maybe Text
a -> CreateSolutionResponse
s {$sel:solutionArn:CreateSolutionResponse' :: Maybe Text
solutionArn = Maybe Text
a} :: CreateSolutionResponse)

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

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