{-# 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.DataBrew.CreateRecipe
-- 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 a new DataBrew recipe.
module Amazonka.DataBrew.CreateRecipe
  ( -- * Creating a Request
    CreateRecipe (..),
    newCreateRecipe,

    -- * Request Lenses
    createRecipe_description,
    createRecipe_tags,
    createRecipe_name,
    createRecipe_steps,

    -- * Destructuring the Response
    CreateRecipeResponse (..),
    newCreateRecipeResponse,

    -- * Response Lenses
    createRecipeResponse_httpStatus,
    createRecipeResponse_name,
  )
where

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

-- | /See:/ 'newCreateRecipe' smart constructor.
data CreateRecipe = CreateRecipe'
  { -- | A description for the recipe.
    CreateRecipe -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Metadata tags to apply to this recipe.
    CreateRecipe -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A unique name for the recipe. Valid characters are alphanumeric (A-Z,
    -- a-z, 0-9), hyphen (-), period (.), and space.
    CreateRecipe -> Text
name :: Prelude.Text,
    -- | An array containing the steps to be performed by the recipe. Each recipe
    -- step consists of one recipe action and (optionally) an array of
    -- condition expressions.
    CreateRecipe -> [RecipeStep]
steps :: [RecipeStep]
  }
  deriving (CreateRecipe -> CreateRecipe -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateRecipe -> CreateRecipe -> Bool
$c/= :: CreateRecipe -> CreateRecipe -> Bool
== :: CreateRecipe -> CreateRecipe -> Bool
$c== :: CreateRecipe -> CreateRecipe -> Bool
Prelude.Eq, ReadPrec [CreateRecipe]
ReadPrec CreateRecipe
Int -> ReadS CreateRecipe
ReadS [CreateRecipe]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateRecipe]
$creadListPrec :: ReadPrec [CreateRecipe]
readPrec :: ReadPrec CreateRecipe
$creadPrec :: ReadPrec CreateRecipe
readList :: ReadS [CreateRecipe]
$creadList :: ReadS [CreateRecipe]
readsPrec :: Int -> ReadS CreateRecipe
$creadsPrec :: Int -> ReadS CreateRecipe
Prelude.Read, Int -> CreateRecipe -> ShowS
[CreateRecipe] -> ShowS
CreateRecipe -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateRecipe] -> ShowS
$cshowList :: [CreateRecipe] -> ShowS
show :: CreateRecipe -> String
$cshow :: CreateRecipe -> String
showsPrec :: Int -> CreateRecipe -> ShowS
$cshowsPrec :: Int -> CreateRecipe -> ShowS
Prelude.Show, forall x. Rep CreateRecipe x -> CreateRecipe
forall x. CreateRecipe -> Rep CreateRecipe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateRecipe x -> CreateRecipe
$cfrom :: forall x. CreateRecipe -> Rep CreateRecipe x
Prelude.Generic)

-- |
-- Create a value of 'CreateRecipe' 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:
--
-- 'description', 'createRecipe_description' - A description for the recipe.
--
-- 'tags', 'createRecipe_tags' - Metadata tags to apply to this recipe.
--
-- 'name', 'createRecipe_name' - A unique name for the recipe. Valid characters are alphanumeric (A-Z,
-- a-z, 0-9), hyphen (-), period (.), and space.
--
-- 'steps', 'createRecipe_steps' - An array containing the steps to be performed by the recipe. Each recipe
-- step consists of one recipe action and (optionally) an array of
-- condition expressions.
newCreateRecipe ::
  -- | 'name'
  Prelude.Text ->
  CreateRecipe
newCreateRecipe :: Text -> CreateRecipe
newCreateRecipe Text
pName_ =
  CreateRecipe'
    { $sel:description:CreateRecipe' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateRecipe' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateRecipe' :: Text
name = Text
pName_,
      $sel:steps:CreateRecipe' :: [RecipeStep]
steps = forall a. Monoid a => a
Prelude.mempty
    }

-- | A description for the recipe.
createRecipe_description :: Lens.Lens' CreateRecipe (Prelude.Maybe Prelude.Text)
createRecipe_description :: Lens' CreateRecipe (Maybe Text)
createRecipe_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRecipe' {Maybe Text
description :: Maybe Text
$sel:description:CreateRecipe' :: CreateRecipe -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateRecipe
s@CreateRecipe' {} Maybe Text
a -> CreateRecipe
s {$sel:description:CreateRecipe' :: Maybe Text
description = Maybe Text
a} :: CreateRecipe)

-- | Metadata tags to apply to this recipe.
createRecipe_tags :: Lens.Lens' CreateRecipe (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createRecipe_tags :: Lens' CreateRecipe (Maybe (HashMap Text Text))
createRecipe_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRecipe' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateRecipe' :: CreateRecipe -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateRecipe
s@CreateRecipe' {} Maybe (HashMap Text Text)
a -> CreateRecipe
s {$sel:tags:CreateRecipe' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateRecipe) 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

-- | A unique name for the recipe. Valid characters are alphanumeric (A-Z,
-- a-z, 0-9), hyphen (-), period (.), and space.
createRecipe_name :: Lens.Lens' CreateRecipe Prelude.Text
createRecipe_name :: Lens' CreateRecipe Text
createRecipe_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRecipe' {Text
name :: Text
$sel:name:CreateRecipe' :: CreateRecipe -> Text
name} -> Text
name) (\s :: CreateRecipe
s@CreateRecipe' {} Text
a -> CreateRecipe
s {$sel:name:CreateRecipe' :: Text
name = Text
a} :: CreateRecipe)

-- | An array containing the steps to be performed by the recipe. Each recipe
-- step consists of one recipe action and (optionally) an array of
-- condition expressions.
createRecipe_steps :: Lens.Lens' CreateRecipe [RecipeStep]
createRecipe_steps :: Lens' CreateRecipe [RecipeStep]
createRecipe_steps = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRecipe' {[RecipeStep]
steps :: [RecipeStep]
$sel:steps:CreateRecipe' :: CreateRecipe -> [RecipeStep]
steps} -> [RecipeStep]
steps) (\s :: CreateRecipe
s@CreateRecipe' {} [RecipeStep]
a -> CreateRecipe
s {$sel:steps:CreateRecipe' :: [RecipeStep]
steps = [RecipeStep]
a} :: CreateRecipe) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateRecipe where
  type AWSResponse CreateRecipe = CreateRecipeResponse
  request :: (Service -> Service) -> CreateRecipe -> Request CreateRecipe
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 CreateRecipe
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateRecipe)))
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 ->
          Int -> Text -> CreateRecipeResponse
CreateRecipeResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Name")
      )

instance Prelude.Hashable CreateRecipe where
  hashWithSalt :: Int -> CreateRecipe -> Int
hashWithSalt Int
_salt CreateRecipe' {[RecipeStep]
Maybe Text
Maybe (HashMap Text Text)
Text
steps :: [RecipeStep]
name :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
$sel:steps:CreateRecipe' :: CreateRecipe -> [RecipeStep]
$sel:name:CreateRecipe' :: CreateRecipe -> Text
$sel:tags:CreateRecipe' :: CreateRecipe -> Maybe (HashMap Text Text)
$sel:description:CreateRecipe' :: CreateRecipe -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [RecipeStep]
steps

instance Prelude.NFData CreateRecipe where
  rnf :: CreateRecipe -> ()
rnf CreateRecipe' {[RecipeStep]
Maybe Text
Maybe (HashMap Text Text)
Text
steps :: [RecipeStep]
name :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
$sel:steps:CreateRecipe' :: CreateRecipe -> [RecipeStep]
$sel:name:CreateRecipe' :: CreateRecipe -> Text
$sel:tags:CreateRecipe' :: CreateRecipe -> Maybe (HashMap Text Text)
$sel:description:CreateRecipe' :: CreateRecipe -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
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 [RecipeStep]
steps

instance Data.ToHeaders CreateRecipe where
  toHeaders :: CreateRecipe -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateRecipe where
  toJSON :: CreateRecipe -> Value
toJSON CreateRecipe' {[RecipeStep]
Maybe Text
Maybe (HashMap Text Text)
Text
steps :: [RecipeStep]
name :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
$sel:steps:CreateRecipe' :: CreateRecipe -> [RecipeStep]
$sel:name:CreateRecipe' :: CreateRecipe -> Text
$sel:tags:CreateRecipe' :: CreateRecipe -> Maybe (HashMap Text Text)
$sel:description:CreateRecipe' :: CreateRecipe -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (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 (HashMap Text Text)
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
"Steps" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [RecipeStep]
steps)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateRecipeResponse' 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:
--
-- 'httpStatus', 'createRecipeResponse_httpStatus' - The response's http status code.
--
-- 'name', 'createRecipeResponse_name' - The name of the recipe that you created.
newCreateRecipeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'name'
  Prelude.Text ->
  CreateRecipeResponse
newCreateRecipeResponse :: Int -> Text -> CreateRecipeResponse
newCreateRecipeResponse Int
pHttpStatus_ Text
pName_ =
  CreateRecipeResponse'
    { $sel:httpStatus:CreateRecipeResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:name:CreateRecipeResponse' :: Text
name = Text
pName_
    }

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

-- | The name of the recipe that you created.
createRecipeResponse_name :: Lens.Lens' CreateRecipeResponse Prelude.Text
createRecipeResponse_name :: Lens' CreateRecipeResponse Text
createRecipeResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRecipeResponse' {Text
name :: Text
$sel:name:CreateRecipeResponse' :: CreateRecipeResponse -> Text
name} -> Text
name) (\s :: CreateRecipeResponse
s@CreateRecipeResponse' {} Text
a -> CreateRecipeResponse
s {$sel:name:CreateRecipeResponse' :: Text
name = Text
a} :: CreateRecipeResponse)

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