{-# 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.SageMakerA2IRuntime.StartHumanLoop
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts a human loop, provided that at least one activation condition is
-- met.
module Amazonka.SageMakerA2IRuntime.StartHumanLoop
  ( -- * Creating a Request
    StartHumanLoop (..),
    newStartHumanLoop,

    -- * Request Lenses
    startHumanLoop_dataAttributes,
    startHumanLoop_humanLoopName,
    startHumanLoop_flowDefinitionArn,
    startHumanLoop_humanLoopInput,

    -- * Destructuring the Response
    StartHumanLoopResponse (..),
    newStartHumanLoopResponse,

    -- * Response Lenses
    startHumanLoopResponse_humanLoopArn,
    startHumanLoopResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartHumanLoop' smart constructor.
data StartHumanLoop = StartHumanLoop'
  { -- | Attributes of the specified data. Use @DataAttributes@ to specify if
    -- your data is free of personally identifiable information and\/or free of
    -- adult content.
    StartHumanLoop -> Maybe HumanLoopDataAttributes
dataAttributes :: Prelude.Maybe HumanLoopDataAttributes,
    -- | The name of the human loop.
    StartHumanLoop -> Text
humanLoopName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the flow definition associated with
    -- this human loop.
    StartHumanLoop -> Text
flowDefinitionArn :: Prelude.Text,
    -- | An object that contains information about the human loop.
    StartHumanLoop -> HumanLoopInput
humanLoopInput :: HumanLoopInput
  }
  deriving (StartHumanLoop -> StartHumanLoop -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartHumanLoop -> StartHumanLoop -> Bool
$c/= :: StartHumanLoop -> StartHumanLoop -> Bool
== :: StartHumanLoop -> StartHumanLoop -> Bool
$c== :: StartHumanLoop -> StartHumanLoop -> Bool
Prelude.Eq, ReadPrec [StartHumanLoop]
ReadPrec StartHumanLoop
Int -> ReadS StartHumanLoop
ReadS [StartHumanLoop]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartHumanLoop]
$creadListPrec :: ReadPrec [StartHumanLoop]
readPrec :: ReadPrec StartHumanLoop
$creadPrec :: ReadPrec StartHumanLoop
readList :: ReadS [StartHumanLoop]
$creadList :: ReadS [StartHumanLoop]
readsPrec :: Int -> ReadS StartHumanLoop
$creadsPrec :: Int -> ReadS StartHumanLoop
Prelude.Read, Int -> StartHumanLoop -> ShowS
[StartHumanLoop] -> ShowS
StartHumanLoop -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartHumanLoop] -> ShowS
$cshowList :: [StartHumanLoop] -> ShowS
show :: StartHumanLoop -> String
$cshow :: StartHumanLoop -> String
showsPrec :: Int -> StartHumanLoop -> ShowS
$cshowsPrec :: Int -> StartHumanLoop -> ShowS
Prelude.Show, forall x. Rep StartHumanLoop x -> StartHumanLoop
forall x. StartHumanLoop -> Rep StartHumanLoop x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartHumanLoop x -> StartHumanLoop
$cfrom :: forall x. StartHumanLoop -> Rep StartHumanLoop x
Prelude.Generic)

-- |
-- Create a value of 'StartHumanLoop' 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:
--
-- 'dataAttributes', 'startHumanLoop_dataAttributes' - Attributes of the specified data. Use @DataAttributes@ to specify if
-- your data is free of personally identifiable information and\/or free of
-- adult content.
--
-- 'humanLoopName', 'startHumanLoop_humanLoopName' - The name of the human loop.
--
-- 'flowDefinitionArn', 'startHumanLoop_flowDefinitionArn' - The Amazon Resource Name (ARN) of the flow definition associated with
-- this human loop.
--
-- 'humanLoopInput', 'startHumanLoop_humanLoopInput' - An object that contains information about the human loop.
newStartHumanLoop ::
  -- | 'humanLoopName'
  Prelude.Text ->
  -- | 'flowDefinitionArn'
  Prelude.Text ->
  -- | 'humanLoopInput'
  HumanLoopInput ->
  StartHumanLoop
newStartHumanLoop :: Text -> Text -> HumanLoopInput -> StartHumanLoop
newStartHumanLoop
  Text
pHumanLoopName_
  Text
pFlowDefinitionArn_
  HumanLoopInput
pHumanLoopInput_ =
    StartHumanLoop'
      { $sel:dataAttributes:StartHumanLoop' :: Maybe HumanLoopDataAttributes
dataAttributes = forall a. Maybe a
Prelude.Nothing,
        $sel:humanLoopName:StartHumanLoop' :: Text
humanLoopName = Text
pHumanLoopName_,
        $sel:flowDefinitionArn:StartHumanLoop' :: Text
flowDefinitionArn = Text
pFlowDefinitionArn_,
        $sel:humanLoopInput:StartHumanLoop' :: HumanLoopInput
humanLoopInput = HumanLoopInput
pHumanLoopInput_
      }

-- | Attributes of the specified data. Use @DataAttributes@ to specify if
-- your data is free of personally identifiable information and\/or free of
-- adult content.
startHumanLoop_dataAttributes :: Lens.Lens' StartHumanLoop (Prelude.Maybe HumanLoopDataAttributes)
startHumanLoop_dataAttributes :: Lens' StartHumanLoop (Maybe HumanLoopDataAttributes)
startHumanLoop_dataAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartHumanLoop' {Maybe HumanLoopDataAttributes
dataAttributes :: Maybe HumanLoopDataAttributes
$sel:dataAttributes:StartHumanLoop' :: StartHumanLoop -> Maybe HumanLoopDataAttributes
dataAttributes} -> Maybe HumanLoopDataAttributes
dataAttributes) (\s :: StartHumanLoop
s@StartHumanLoop' {} Maybe HumanLoopDataAttributes
a -> StartHumanLoop
s {$sel:dataAttributes:StartHumanLoop' :: Maybe HumanLoopDataAttributes
dataAttributes = Maybe HumanLoopDataAttributes
a} :: StartHumanLoop)

-- | The name of the human loop.
startHumanLoop_humanLoopName :: Lens.Lens' StartHumanLoop Prelude.Text
startHumanLoop_humanLoopName :: Lens' StartHumanLoop Text
startHumanLoop_humanLoopName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartHumanLoop' {Text
humanLoopName :: Text
$sel:humanLoopName:StartHumanLoop' :: StartHumanLoop -> Text
humanLoopName} -> Text
humanLoopName) (\s :: StartHumanLoop
s@StartHumanLoop' {} Text
a -> StartHumanLoop
s {$sel:humanLoopName:StartHumanLoop' :: Text
humanLoopName = Text
a} :: StartHumanLoop)

-- | The Amazon Resource Name (ARN) of the flow definition associated with
-- this human loop.
startHumanLoop_flowDefinitionArn :: Lens.Lens' StartHumanLoop Prelude.Text
startHumanLoop_flowDefinitionArn :: Lens' StartHumanLoop Text
startHumanLoop_flowDefinitionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartHumanLoop' {Text
flowDefinitionArn :: Text
$sel:flowDefinitionArn:StartHumanLoop' :: StartHumanLoop -> Text
flowDefinitionArn} -> Text
flowDefinitionArn) (\s :: StartHumanLoop
s@StartHumanLoop' {} Text
a -> StartHumanLoop
s {$sel:flowDefinitionArn:StartHumanLoop' :: Text
flowDefinitionArn = Text
a} :: StartHumanLoop)

-- | An object that contains information about the human loop.
startHumanLoop_humanLoopInput :: Lens.Lens' StartHumanLoop HumanLoopInput
startHumanLoop_humanLoopInput :: Lens' StartHumanLoop HumanLoopInput
startHumanLoop_humanLoopInput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartHumanLoop' {HumanLoopInput
humanLoopInput :: HumanLoopInput
$sel:humanLoopInput:StartHumanLoop' :: StartHumanLoop -> HumanLoopInput
humanLoopInput} -> HumanLoopInput
humanLoopInput) (\s :: StartHumanLoop
s@StartHumanLoop' {} HumanLoopInput
a -> StartHumanLoop
s {$sel:humanLoopInput:StartHumanLoop' :: HumanLoopInput
humanLoopInput = HumanLoopInput
a} :: StartHumanLoop)

instance Core.AWSRequest StartHumanLoop where
  type
    AWSResponse StartHumanLoop =
      StartHumanLoopResponse
  request :: (Service -> Service) -> StartHumanLoop -> Request StartHumanLoop
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 StartHumanLoop
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartHumanLoop)))
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 -> StartHumanLoopResponse
StartHumanLoopResponse'
            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
"HumanLoopArn")
            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 StartHumanLoop where
  hashWithSalt :: Int -> StartHumanLoop -> Int
hashWithSalt Int
_salt StartHumanLoop' {Maybe HumanLoopDataAttributes
Text
HumanLoopInput
humanLoopInput :: HumanLoopInput
flowDefinitionArn :: Text
humanLoopName :: Text
dataAttributes :: Maybe HumanLoopDataAttributes
$sel:humanLoopInput:StartHumanLoop' :: StartHumanLoop -> HumanLoopInput
$sel:flowDefinitionArn:StartHumanLoop' :: StartHumanLoop -> Text
$sel:humanLoopName:StartHumanLoop' :: StartHumanLoop -> Text
$sel:dataAttributes:StartHumanLoop' :: StartHumanLoop -> Maybe HumanLoopDataAttributes
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HumanLoopDataAttributes
dataAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
humanLoopName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
flowDefinitionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HumanLoopInput
humanLoopInput

instance Prelude.NFData StartHumanLoop where
  rnf :: StartHumanLoop -> ()
rnf StartHumanLoop' {Maybe HumanLoopDataAttributes
Text
HumanLoopInput
humanLoopInput :: HumanLoopInput
flowDefinitionArn :: Text
humanLoopName :: Text
dataAttributes :: Maybe HumanLoopDataAttributes
$sel:humanLoopInput:StartHumanLoop' :: StartHumanLoop -> HumanLoopInput
$sel:flowDefinitionArn:StartHumanLoop' :: StartHumanLoop -> Text
$sel:humanLoopName:StartHumanLoop' :: StartHumanLoop -> Text
$sel:dataAttributes:StartHumanLoop' :: StartHumanLoop -> Maybe HumanLoopDataAttributes
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe HumanLoopDataAttributes
dataAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
humanLoopName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
flowDefinitionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HumanLoopInput
humanLoopInput

instance Data.ToHeaders StartHumanLoop where
  toHeaders :: StartHumanLoop -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON StartHumanLoop where
  toJSON :: StartHumanLoop -> Value
toJSON StartHumanLoop' {Maybe HumanLoopDataAttributes
Text
HumanLoopInput
humanLoopInput :: HumanLoopInput
flowDefinitionArn :: Text
humanLoopName :: Text
dataAttributes :: Maybe HumanLoopDataAttributes
$sel:humanLoopInput:StartHumanLoop' :: StartHumanLoop -> HumanLoopInput
$sel:flowDefinitionArn:StartHumanLoop' :: StartHumanLoop -> Text
$sel:humanLoopName:StartHumanLoop' :: StartHumanLoop -> Text
$sel:dataAttributes:StartHumanLoop' :: StartHumanLoop -> Maybe HumanLoopDataAttributes
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DataAttributes" 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 HumanLoopDataAttributes
dataAttributes,
            forall a. a -> Maybe a
Prelude.Just (Key
"HumanLoopName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
humanLoopName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"FlowDefinitionArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
flowDefinitionArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"HumanLoopInput" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HumanLoopInput
humanLoopInput)
          ]
      )

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

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

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

-- |
-- Create a value of 'StartHumanLoopResponse' 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:
--
-- 'humanLoopArn', 'startHumanLoopResponse_humanLoopArn' - The Amazon Resource Name (ARN) of the human loop.
--
-- 'httpStatus', 'startHumanLoopResponse_httpStatus' - The response's http status code.
newStartHumanLoopResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartHumanLoopResponse
newStartHumanLoopResponse :: Int -> StartHumanLoopResponse
newStartHumanLoopResponse Int
pHttpStatus_ =
  StartHumanLoopResponse'
    { $sel:humanLoopArn:StartHumanLoopResponse' :: Maybe Text
humanLoopArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartHumanLoopResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the human loop.
startHumanLoopResponse_humanLoopArn :: Lens.Lens' StartHumanLoopResponse (Prelude.Maybe Prelude.Text)
startHumanLoopResponse_humanLoopArn :: Lens' StartHumanLoopResponse (Maybe Text)
startHumanLoopResponse_humanLoopArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartHumanLoopResponse' {Maybe Text
humanLoopArn :: Maybe Text
$sel:humanLoopArn:StartHumanLoopResponse' :: StartHumanLoopResponse -> Maybe Text
humanLoopArn} -> Maybe Text
humanLoopArn) (\s :: StartHumanLoopResponse
s@StartHumanLoopResponse' {} Maybe Text
a -> StartHumanLoopResponse
s {$sel:humanLoopArn:StartHumanLoopResponse' :: Maybe Text
humanLoopArn = Maybe Text
a} :: StartHumanLoopResponse)

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

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