{-# 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.DescribeRecipe
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes a recipe.
--
-- A recipe contains three items:
--
-- -   An algorithm that trains a model.
--
-- -   Hyperparameters that govern the training.
--
-- -   Feature transformation information for modifying the input data
--     before training.
--
-- Amazon Personalize provides a set of predefined recipes. You specify a
-- recipe when you create a solution with the
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_CreateSolution.html CreateSolution>
-- API. @CreateSolution@ trains a model by using the algorithm in the
-- specified recipe and a training dataset. The solution, when deployed as
-- a campaign, can provide recommendations using the
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_RS_GetRecommendations.html GetRecommendations>
-- API.
module Amazonka.Personalize.DescribeRecipe
  ( -- * Creating a Request
    DescribeRecipe (..),
    newDescribeRecipe,

    -- * Request Lenses
    describeRecipe_recipeArn,

    -- * Destructuring the Response
    DescribeRecipeResponse (..),
    newDescribeRecipeResponse,

    -- * Response Lenses
    describeRecipeResponse_recipe,
    describeRecipeResponse_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:/ 'newDescribeRecipe' smart constructor.
data DescribeRecipe = DescribeRecipe'
  { -- | The Amazon Resource Name (ARN) of the recipe to describe.
    DescribeRecipe -> Text
recipeArn :: Prelude.Text
  }
  deriving (DescribeRecipe -> DescribeRecipe -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeRecipe -> DescribeRecipe -> Bool
$c/= :: DescribeRecipe -> DescribeRecipe -> Bool
== :: DescribeRecipe -> DescribeRecipe -> Bool
$c== :: DescribeRecipe -> DescribeRecipe -> Bool
Prelude.Eq, ReadPrec [DescribeRecipe]
ReadPrec DescribeRecipe
Int -> ReadS DescribeRecipe
ReadS [DescribeRecipe]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeRecipe]
$creadListPrec :: ReadPrec [DescribeRecipe]
readPrec :: ReadPrec DescribeRecipe
$creadPrec :: ReadPrec DescribeRecipe
readList :: ReadS [DescribeRecipe]
$creadList :: ReadS [DescribeRecipe]
readsPrec :: Int -> ReadS DescribeRecipe
$creadsPrec :: Int -> ReadS DescribeRecipe
Prelude.Read, Int -> DescribeRecipe -> ShowS
[DescribeRecipe] -> ShowS
DescribeRecipe -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeRecipe] -> ShowS
$cshowList :: [DescribeRecipe] -> ShowS
show :: DescribeRecipe -> String
$cshow :: DescribeRecipe -> String
showsPrec :: Int -> DescribeRecipe -> ShowS
$cshowsPrec :: Int -> DescribeRecipe -> ShowS
Prelude.Show, forall x. Rep DescribeRecipe x -> DescribeRecipe
forall x. DescribeRecipe -> Rep DescribeRecipe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeRecipe x -> DescribeRecipe
$cfrom :: forall x. DescribeRecipe -> Rep DescribeRecipe x
Prelude.Generic)

-- |
-- Create a value of 'DescribeRecipe' 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:
--
-- 'recipeArn', 'describeRecipe_recipeArn' - The Amazon Resource Name (ARN) of the recipe to describe.
newDescribeRecipe ::
  -- | 'recipeArn'
  Prelude.Text ->
  DescribeRecipe
newDescribeRecipe :: Text -> DescribeRecipe
newDescribeRecipe Text
pRecipeArn_ =
  DescribeRecipe' {$sel:recipeArn:DescribeRecipe' :: Text
recipeArn = Text
pRecipeArn_}

-- | The Amazon Resource Name (ARN) of the recipe to describe.
describeRecipe_recipeArn :: Lens.Lens' DescribeRecipe Prelude.Text
describeRecipe_recipeArn :: Lens' DescribeRecipe Text
describeRecipe_recipeArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecipe' {Text
recipeArn :: Text
$sel:recipeArn:DescribeRecipe' :: DescribeRecipe -> Text
recipeArn} -> Text
recipeArn) (\s :: DescribeRecipe
s@DescribeRecipe' {} Text
a -> DescribeRecipe
s {$sel:recipeArn:DescribeRecipe' :: Text
recipeArn = Text
a} :: DescribeRecipe)

instance Core.AWSRequest DescribeRecipe where
  type
    AWSResponse DescribeRecipe =
      DescribeRecipeResponse
  request :: (Service -> Service) -> DescribeRecipe -> Request DescribeRecipe
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 DescribeRecipe
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeRecipe)))
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 Recipe -> Int -> DescribeRecipeResponse
DescribeRecipeResponse'
            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
"recipe")
            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 DescribeRecipe where
  hashWithSalt :: Int -> DescribeRecipe -> Int
hashWithSalt Int
_salt DescribeRecipe' {Text
recipeArn :: Text
$sel:recipeArn:DescribeRecipe' :: DescribeRecipe -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
recipeArn

instance Prelude.NFData DescribeRecipe where
  rnf :: DescribeRecipe -> ()
rnf DescribeRecipe' {Text
recipeArn :: Text
$sel:recipeArn:DescribeRecipe' :: DescribeRecipe -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
recipeArn

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

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

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

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

-- |
-- Create a value of 'DescribeRecipeResponse' 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:
--
-- 'recipe', 'describeRecipeResponse_recipe' - An object that describes the recipe.
--
-- 'httpStatus', 'describeRecipeResponse_httpStatus' - The response's http status code.
newDescribeRecipeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeRecipeResponse
newDescribeRecipeResponse :: Int -> DescribeRecipeResponse
newDescribeRecipeResponse Int
pHttpStatus_ =
  DescribeRecipeResponse'
    { $sel:recipe:DescribeRecipeResponse' :: Maybe Recipe
recipe = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeRecipeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that describes the recipe.
describeRecipeResponse_recipe :: Lens.Lens' DescribeRecipeResponse (Prelude.Maybe Recipe)
describeRecipeResponse_recipe :: Lens' DescribeRecipeResponse (Maybe Recipe)
describeRecipeResponse_recipe = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecipeResponse' {Maybe Recipe
recipe :: Maybe Recipe
$sel:recipe:DescribeRecipeResponse' :: DescribeRecipeResponse -> Maybe Recipe
recipe} -> Maybe Recipe
recipe) (\s :: DescribeRecipeResponse
s@DescribeRecipeResponse' {} Maybe Recipe
a -> DescribeRecipeResponse
s {$sel:recipe:DescribeRecipeResponse' :: Maybe Recipe
recipe = Maybe Recipe
a} :: DescribeRecipeResponse)

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

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