{-# 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.SWF.RegisterActivityType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Registers a new /activity type/ along with its configuration settings in
-- the specified domain.
--
-- A @TypeAlreadyExists@ fault is returned if the type already exists in
-- the domain. You cannot change any configuration settings of the type
-- after its registration, and it must be registered as a new version.
--
-- __Access Control__
--
-- You can use IAM policies to control this action\'s access to Amazon SWF
-- resources as follows:
--
-- -   Use a @Resource@ element with the domain name to limit the action to
--     only specified domains.
--
-- -   Use an @Action@ element to allow or deny permission to call this
--     action.
--
-- -   Constrain the following parameters by using a @Condition@ element
--     with the appropriate keys.
--
--     -   @defaultTaskList.name@: String constraint. The key is
--         @swf:defaultTaskList.name@.
--
--     -   @name@: String constraint. The key is @swf:name@.
--
--     -   @version@: String constraint. The key is @swf:version@.
--
-- If the caller doesn\'t have sufficient permissions to invoke the action,
-- or the parameter values fall outside the specified constraints, the
-- action fails. The associated event attribute\'s @cause@ parameter is set
-- to @OPERATION_NOT_PERMITTED@. For details and example IAM policies, see
-- <https://docs.aws.amazon.com/amazonswf/latest/developerguide/swf-dev-iam.html Using IAM to Manage Access to Amazon SWF Workflows>
-- in the /Amazon SWF Developer Guide/.
module Amazonka.SWF.RegisterActivityType
  ( -- * Creating a Request
    RegisterActivityType (..),
    newRegisterActivityType,

    -- * Request Lenses
    registerActivityType_defaultTaskHeartbeatTimeout,
    registerActivityType_defaultTaskList,
    registerActivityType_defaultTaskPriority,
    registerActivityType_defaultTaskScheduleToCloseTimeout,
    registerActivityType_defaultTaskScheduleToStartTimeout,
    registerActivityType_defaultTaskStartToCloseTimeout,
    registerActivityType_description,
    registerActivityType_domain,
    registerActivityType_name,
    registerActivityType_version,

    -- * Destructuring the Response
    RegisterActivityTypeResponse (..),
    newRegisterActivityTypeResponse,
  )
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.SWF.Types

-- | /See:/ 'newRegisterActivityType' smart constructor.
data RegisterActivityType = RegisterActivityType'
  { -- | If set, specifies the default maximum time before which a worker
    -- processing a task of this type must report progress by calling
    -- RecordActivityTaskHeartbeat. If the timeout is exceeded, the activity
    -- task is automatically timed out. This default can be overridden when
    -- scheduling an activity task using the @ScheduleActivityTask@ Decision.
    -- If the activity worker subsequently attempts to record a heartbeat or
    -- returns a result, the activity worker receives an @UnknownResource@
    -- fault. In this case, Amazon SWF no longer considers the activity task to
    -- be valid; the activity worker should clean up the activity task.
    --
    -- The duration is specified in seconds, an integer greater than or equal
    -- to @0@. You can use @NONE@ to specify unlimited duration.
    RegisterActivityType -> Maybe Text
defaultTaskHeartbeatTimeout :: Prelude.Maybe Prelude.Text,
    -- | If set, specifies the default task list to use for scheduling tasks of
    -- this activity type. This default task list is used if a task list isn\'t
    -- provided when a task is scheduled through the @ScheduleActivityTask@
    -- Decision.
    RegisterActivityType -> Maybe TaskList
defaultTaskList :: Prelude.Maybe TaskList,
    -- | The default task priority to assign to the activity type. If not
    -- assigned, then @0@ is used. Valid values are integers that range from
    -- Java\'s @Integer.MIN_VALUE@ (-2147483648) to @Integer.MAX_VALUE@
    -- (2147483647). Higher numbers indicate higher priority.
    --
    -- For more information about setting task priority, see
    -- <https://docs.aws.amazon.com/amazonswf/latest/developerguide/programming-priority.html Setting Task Priority>
    -- in the /in the /Amazon SWF Developer Guide/./.
    RegisterActivityType -> Maybe Text
defaultTaskPriority :: Prelude.Maybe Prelude.Text,
    -- | If set, specifies the default maximum duration for a task of this
    -- activity type. This default can be overridden when scheduling an
    -- activity task using the @ScheduleActivityTask@ Decision.
    --
    -- The duration is specified in seconds, an integer greater than or equal
    -- to @0@. You can use @NONE@ to specify unlimited duration.
    RegisterActivityType -> Maybe Text
defaultTaskScheduleToCloseTimeout :: Prelude.Maybe Prelude.Text,
    -- | If set, specifies the default maximum duration that a task of this
    -- activity type can wait before being assigned to a worker. This default
    -- can be overridden when scheduling an activity task using the
    -- @ScheduleActivityTask@ Decision.
    --
    -- The duration is specified in seconds, an integer greater than or equal
    -- to @0@. You can use @NONE@ to specify unlimited duration.
    RegisterActivityType -> Maybe Text
defaultTaskScheduleToStartTimeout :: Prelude.Maybe Prelude.Text,
    -- | If set, specifies the default maximum duration that a worker can take to
    -- process tasks of this activity type. This default can be overridden when
    -- scheduling an activity task using the @ScheduleActivityTask@ Decision.
    --
    -- The duration is specified in seconds, an integer greater than or equal
    -- to @0@. You can use @NONE@ to specify unlimited duration.
    RegisterActivityType -> Maybe Text
defaultTaskStartToCloseTimeout :: Prelude.Maybe Prelude.Text,
    -- | A textual description of the activity type.
    RegisterActivityType -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The name of the domain in which this activity is to be registered.
    RegisterActivityType -> Text
domain :: Prelude.Text,
    -- | The name of the activity type within the domain.
    --
    -- The specified string must not start or end with whitespace. It must not
    -- contain a @:@ (colon), @\/@ (slash), @|@ (vertical bar), or any control
    -- characters (@\\u0000-\\u001f@ | @\\u007f-\\u009f@). Also, it must not
    -- /be/ the literal string @arn@.
    RegisterActivityType -> Text
name :: Prelude.Text,
    -- | The version of the activity type.
    --
    -- The activity type consists of the name and version, the combination of
    -- which must be unique within the domain.
    --
    -- The specified string must not start or end with whitespace. It must not
    -- contain a @:@ (colon), @\/@ (slash), @|@ (vertical bar), or any control
    -- characters (@\\u0000-\\u001f@ | @\\u007f-\\u009f@). Also, it must not
    -- /be/ the literal string @arn@.
    RegisterActivityType -> Text
version :: Prelude.Text
  }
  deriving (RegisterActivityType -> RegisterActivityType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterActivityType -> RegisterActivityType -> Bool
$c/= :: RegisterActivityType -> RegisterActivityType -> Bool
== :: RegisterActivityType -> RegisterActivityType -> Bool
$c== :: RegisterActivityType -> RegisterActivityType -> Bool
Prelude.Eq, ReadPrec [RegisterActivityType]
ReadPrec RegisterActivityType
Int -> ReadS RegisterActivityType
ReadS [RegisterActivityType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterActivityType]
$creadListPrec :: ReadPrec [RegisterActivityType]
readPrec :: ReadPrec RegisterActivityType
$creadPrec :: ReadPrec RegisterActivityType
readList :: ReadS [RegisterActivityType]
$creadList :: ReadS [RegisterActivityType]
readsPrec :: Int -> ReadS RegisterActivityType
$creadsPrec :: Int -> ReadS RegisterActivityType
Prelude.Read, Int -> RegisterActivityType -> ShowS
[RegisterActivityType] -> ShowS
RegisterActivityType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterActivityType] -> ShowS
$cshowList :: [RegisterActivityType] -> ShowS
show :: RegisterActivityType -> String
$cshow :: RegisterActivityType -> String
showsPrec :: Int -> RegisterActivityType -> ShowS
$cshowsPrec :: Int -> RegisterActivityType -> ShowS
Prelude.Show, forall x. Rep RegisterActivityType x -> RegisterActivityType
forall x. RegisterActivityType -> Rep RegisterActivityType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterActivityType x -> RegisterActivityType
$cfrom :: forall x. RegisterActivityType -> Rep RegisterActivityType x
Prelude.Generic)

-- |
-- Create a value of 'RegisterActivityType' 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:
--
-- 'defaultTaskHeartbeatTimeout', 'registerActivityType_defaultTaskHeartbeatTimeout' - If set, specifies the default maximum time before which a worker
-- processing a task of this type must report progress by calling
-- RecordActivityTaskHeartbeat. If the timeout is exceeded, the activity
-- task is automatically timed out. This default can be overridden when
-- scheduling an activity task using the @ScheduleActivityTask@ Decision.
-- If the activity worker subsequently attempts to record a heartbeat or
-- returns a result, the activity worker receives an @UnknownResource@
-- fault. In this case, Amazon SWF no longer considers the activity task to
-- be valid; the activity worker should clean up the activity task.
--
-- The duration is specified in seconds, an integer greater than or equal
-- to @0@. You can use @NONE@ to specify unlimited duration.
--
-- 'defaultTaskList', 'registerActivityType_defaultTaskList' - If set, specifies the default task list to use for scheduling tasks of
-- this activity type. This default task list is used if a task list isn\'t
-- provided when a task is scheduled through the @ScheduleActivityTask@
-- Decision.
--
-- 'defaultTaskPriority', 'registerActivityType_defaultTaskPriority' - The default task priority to assign to the activity type. If not
-- assigned, then @0@ is used. Valid values are integers that range from
-- Java\'s @Integer.MIN_VALUE@ (-2147483648) to @Integer.MAX_VALUE@
-- (2147483647). Higher numbers indicate higher priority.
--
-- For more information about setting task priority, see
-- <https://docs.aws.amazon.com/amazonswf/latest/developerguide/programming-priority.html Setting Task Priority>
-- in the /in the /Amazon SWF Developer Guide/./.
--
-- 'defaultTaskScheduleToCloseTimeout', 'registerActivityType_defaultTaskScheduleToCloseTimeout' - If set, specifies the default maximum duration for a task of this
-- activity type. This default can be overridden when scheduling an
-- activity task using the @ScheduleActivityTask@ Decision.
--
-- The duration is specified in seconds, an integer greater than or equal
-- to @0@. You can use @NONE@ to specify unlimited duration.
--
-- 'defaultTaskScheduleToStartTimeout', 'registerActivityType_defaultTaskScheduleToStartTimeout' - If set, specifies the default maximum duration that a task of this
-- activity type can wait before being assigned to a worker. This default
-- can be overridden when scheduling an activity task using the
-- @ScheduleActivityTask@ Decision.
--
-- The duration is specified in seconds, an integer greater than or equal
-- to @0@. You can use @NONE@ to specify unlimited duration.
--
-- 'defaultTaskStartToCloseTimeout', 'registerActivityType_defaultTaskStartToCloseTimeout' - If set, specifies the default maximum duration that a worker can take to
-- process tasks of this activity type. This default can be overridden when
-- scheduling an activity task using the @ScheduleActivityTask@ Decision.
--
-- The duration is specified in seconds, an integer greater than or equal
-- to @0@. You can use @NONE@ to specify unlimited duration.
--
-- 'description', 'registerActivityType_description' - A textual description of the activity type.
--
-- 'domain', 'registerActivityType_domain' - The name of the domain in which this activity is to be registered.
--
-- 'name', 'registerActivityType_name' - The name of the activity type within the domain.
--
-- The specified string must not start or end with whitespace. It must not
-- contain a @:@ (colon), @\/@ (slash), @|@ (vertical bar), or any control
-- characters (@\\u0000-\\u001f@ | @\\u007f-\\u009f@). Also, it must not
-- /be/ the literal string @arn@.
--
-- 'version', 'registerActivityType_version' - The version of the activity type.
--
-- The activity type consists of the name and version, the combination of
-- which must be unique within the domain.
--
-- The specified string must not start or end with whitespace. It must not
-- contain a @:@ (colon), @\/@ (slash), @|@ (vertical bar), or any control
-- characters (@\\u0000-\\u001f@ | @\\u007f-\\u009f@). Also, it must not
-- /be/ the literal string @arn@.
newRegisterActivityType ::
  -- | 'domain'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'version'
  Prelude.Text ->
  RegisterActivityType
newRegisterActivityType :: Text -> Text -> Text -> RegisterActivityType
newRegisterActivityType Text
pDomain_ Text
pName_ Text
pVersion_ =
  RegisterActivityType'
    { $sel:defaultTaskHeartbeatTimeout:RegisterActivityType' :: Maybe Text
defaultTaskHeartbeatTimeout =
        forall a. Maybe a
Prelude.Nothing,
      $sel:defaultTaskList:RegisterActivityType' :: Maybe TaskList
defaultTaskList = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultTaskPriority:RegisterActivityType' :: Maybe Text
defaultTaskPriority = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultTaskScheduleToCloseTimeout:RegisterActivityType' :: Maybe Text
defaultTaskScheduleToCloseTimeout = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultTaskScheduleToStartTimeout:RegisterActivityType' :: Maybe Text
defaultTaskScheduleToStartTimeout = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultTaskStartToCloseTimeout:RegisterActivityType' :: Maybe Text
defaultTaskStartToCloseTimeout = forall a. Maybe a
Prelude.Nothing,
      $sel:description:RegisterActivityType' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:domain:RegisterActivityType' :: Text
domain = Text
pDomain_,
      $sel:name:RegisterActivityType' :: Text
name = Text
pName_,
      $sel:version:RegisterActivityType' :: Text
version = Text
pVersion_
    }

-- | If set, specifies the default maximum time before which a worker
-- processing a task of this type must report progress by calling
-- RecordActivityTaskHeartbeat. If the timeout is exceeded, the activity
-- task is automatically timed out. This default can be overridden when
-- scheduling an activity task using the @ScheduleActivityTask@ Decision.
-- If the activity worker subsequently attempts to record a heartbeat or
-- returns a result, the activity worker receives an @UnknownResource@
-- fault. In this case, Amazon SWF no longer considers the activity task to
-- be valid; the activity worker should clean up the activity task.
--
-- The duration is specified in seconds, an integer greater than or equal
-- to @0@. You can use @NONE@ to specify unlimited duration.
registerActivityType_defaultTaskHeartbeatTimeout :: Lens.Lens' RegisterActivityType (Prelude.Maybe Prelude.Text)
registerActivityType_defaultTaskHeartbeatTimeout :: Lens' RegisterActivityType (Maybe Text)
registerActivityType_defaultTaskHeartbeatTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterActivityType' {Maybe Text
defaultTaskHeartbeatTimeout :: Maybe Text
$sel:defaultTaskHeartbeatTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
defaultTaskHeartbeatTimeout} -> Maybe Text
defaultTaskHeartbeatTimeout) (\s :: RegisterActivityType
s@RegisterActivityType' {} Maybe Text
a -> RegisterActivityType
s {$sel:defaultTaskHeartbeatTimeout:RegisterActivityType' :: Maybe Text
defaultTaskHeartbeatTimeout = Maybe Text
a} :: RegisterActivityType)

-- | If set, specifies the default task list to use for scheduling tasks of
-- this activity type. This default task list is used if a task list isn\'t
-- provided when a task is scheduled through the @ScheduleActivityTask@
-- Decision.
registerActivityType_defaultTaskList :: Lens.Lens' RegisterActivityType (Prelude.Maybe TaskList)
registerActivityType_defaultTaskList :: Lens' RegisterActivityType (Maybe TaskList)
registerActivityType_defaultTaskList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterActivityType' {Maybe TaskList
defaultTaskList :: Maybe TaskList
$sel:defaultTaskList:RegisterActivityType' :: RegisterActivityType -> Maybe TaskList
defaultTaskList} -> Maybe TaskList
defaultTaskList) (\s :: RegisterActivityType
s@RegisterActivityType' {} Maybe TaskList
a -> RegisterActivityType
s {$sel:defaultTaskList:RegisterActivityType' :: Maybe TaskList
defaultTaskList = Maybe TaskList
a} :: RegisterActivityType)

-- | The default task priority to assign to the activity type. If not
-- assigned, then @0@ is used. Valid values are integers that range from
-- Java\'s @Integer.MIN_VALUE@ (-2147483648) to @Integer.MAX_VALUE@
-- (2147483647). Higher numbers indicate higher priority.
--
-- For more information about setting task priority, see
-- <https://docs.aws.amazon.com/amazonswf/latest/developerguide/programming-priority.html Setting Task Priority>
-- in the /in the /Amazon SWF Developer Guide/./.
registerActivityType_defaultTaskPriority :: Lens.Lens' RegisterActivityType (Prelude.Maybe Prelude.Text)
registerActivityType_defaultTaskPriority :: Lens' RegisterActivityType (Maybe Text)
registerActivityType_defaultTaskPriority = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterActivityType' {Maybe Text
defaultTaskPriority :: Maybe Text
$sel:defaultTaskPriority:RegisterActivityType' :: RegisterActivityType -> Maybe Text
defaultTaskPriority} -> Maybe Text
defaultTaskPriority) (\s :: RegisterActivityType
s@RegisterActivityType' {} Maybe Text
a -> RegisterActivityType
s {$sel:defaultTaskPriority:RegisterActivityType' :: Maybe Text
defaultTaskPriority = Maybe Text
a} :: RegisterActivityType)

-- | If set, specifies the default maximum duration for a task of this
-- activity type. This default can be overridden when scheduling an
-- activity task using the @ScheduleActivityTask@ Decision.
--
-- The duration is specified in seconds, an integer greater than or equal
-- to @0@. You can use @NONE@ to specify unlimited duration.
registerActivityType_defaultTaskScheduleToCloseTimeout :: Lens.Lens' RegisterActivityType (Prelude.Maybe Prelude.Text)
registerActivityType_defaultTaskScheduleToCloseTimeout :: Lens' RegisterActivityType (Maybe Text)
registerActivityType_defaultTaskScheduleToCloseTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterActivityType' {Maybe Text
defaultTaskScheduleToCloseTimeout :: Maybe Text
$sel:defaultTaskScheduleToCloseTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
defaultTaskScheduleToCloseTimeout} -> Maybe Text
defaultTaskScheduleToCloseTimeout) (\s :: RegisterActivityType
s@RegisterActivityType' {} Maybe Text
a -> RegisterActivityType
s {$sel:defaultTaskScheduleToCloseTimeout:RegisterActivityType' :: Maybe Text
defaultTaskScheduleToCloseTimeout = Maybe Text
a} :: RegisterActivityType)

-- | If set, specifies the default maximum duration that a task of this
-- activity type can wait before being assigned to a worker. This default
-- can be overridden when scheduling an activity task using the
-- @ScheduleActivityTask@ Decision.
--
-- The duration is specified in seconds, an integer greater than or equal
-- to @0@. You can use @NONE@ to specify unlimited duration.
registerActivityType_defaultTaskScheduleToStartTimeout :: Lens.Lens' RegisterActivityType (Prelude.Maybe Prelude.Text)
registerActivityType_defaultTaskScheduleToStartTimeout :: Lens' RegisterActivityType (Maybe Text)
registerActivityType_defaultTaskScheduleToStartTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterActivityType' {Maybe Text
defaultTaskScheduleToStartTimeout :: Maybe Text
$sel:defaultTaskScheduleToStartTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
defaultTaskScheduleToStartTimeout} -> Maybe Text
defaultTaskScheduleToStartTimeout) (\s :: RegisterActivityType
s@RegisterActivityType' {} Maybe Text
a -> RegisterActivityType
s {$sel:defaultTaskScheduleToStartTimeout:RegisterActivityType' :: Maybe Text
defaultTaskScheduleToStartTimeout = Maybe Text
a} :: RegisterActivityType)

-- | If set, specifies the default maximum duration that a worker can take to
-- process tasks of this activity type. This default can be overridden when
-- scheduling an activity task using the @ScheduleActivityTask@ Decision.
--
-- The duration is specified in seconds, an integer greater than or equal
-- to @0@. You can use @NONE@ to specify unlimited duration.
registerActivityType_defaultTaskStartToCloseTimeout :: Lens.Lens' RegisterActivityType (Prelude.Maybe Prelude.Text)
registerActivityType_defaultTaskStartToCloseTimeout :: Lens' RegisterActivityType (Maybe Text)
registerActivityType_defaultTaskStartToCloseTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterActivityType' {Maybe Text
defaultTaskStartToCloseTimeout :: Maybe Text
$sel:defaultTaskStartToCloseTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
defaultTaskStartToCloseTimeout} -> Maybe Text
defaultTaskStartToCloseTimeout) (\s :: RegisterActivityType
s@RegisterActivityType' {} Maybe Text
a -> RegisterActivityType
s {$sel:defaultTaskStartToCloseTimeout:RegisterActivityType' :: Maybe Text
defaultTaskStartToCloseTimeout = Maybe Text
a} :: RegisterActivityType)

-- | A textual description of the activity type.
registerActivityType_description :: Lens.Lens' RegisterActivityType (Prelude.Maybe Prelude.Text)
registerActivityType_description :: Lens' RegisterActivityType (Maybe Text)
registerActivityType_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterActivityType' {Maybe Text
description :: Maybe Text
$sel:description:RegisterActivityType' :: RegisterActivityType -> Maybe Text
description} -> Maybe Text
description) (\s :: RegisterActivityType
s@RegisterActivityType' {} Maybe Text
a -> RegisterActivityType
s {$sel:description:RegisterActivityType' :: Maybe Text
description = Maybe Text
a} :: RegisterActivityType)

-- | The name of the domain in which this activity is to be registered.
registerActivityType_domain :: Lens.Lens' RegisterActivityType Prelude.Text
registerActivityType_domain :: Lens' RegisterActivityType Text
registerActivityType_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterActivityType' {Text
domain :: Text
$sel:domain:RegisterActivityType' :: RegisterActivityType -> Text
domain} -> Text
domain) (\s :: RegisterActivityType
s@RegisterActivityType' {} Text
a -> RegisterActivityType
s {$sel:domain:RegisterActivityType' :: Text
domain = Text
a} :: RegisterActivityType)

-- | The name of the activity type within the domain.
--
-- The specified string must not start or end with whitespace. It must not
-- contain a @:@ (colon), @\/@ (slash), @|@ (vertical bar), or any control
-- characters (@\\u0000-\\u001f@ | @\\u007f-\\u009f@). Also, it must not
-- /be/ the literal string @arn@.
registerActivityType_name :: Lens.Lens' RegisterActivityType Prelude.Text
registerActivityType_name :: Lens' RegisterActivityType Text
registerActivityType_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterActivityType' {Text
name :: Text
$sel:name:RegisterActivityType' :: RegisterActivityType -> Text
name} -> Text
name) (\s :: RegisterActivityType
s@RegisterActivityType' {} Text
a -> RegisterActivityType
s {$sel:name:RegisterActivityType' :: Text
name = Text
a} :: RegisterActivityType)

-- | The version of the activity type.
--
-- The activity type consists of the name and version, the combination of
-- which must be unique within the domain.
--
-- The specified string must not start or end with whitespace. It must not
-- contain a @:@ (colon), @\/@ (slash), @|@ (vertical bar), or any control
-- characters (@\\u0000-\\u001f@ | @\\u007f-\\u009f@). Also, it must not
-- /be/ the literal string @arn@.
registerActivityType_version :: Lens.Lens' RegisterActivityType Prelude.Text
registerActivityType_version :: Lens' RegisterActivityType Text
registerActivityType_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterActivityType' {Text
version :: Text
$sel:version:RegisterActivityType' :: RegisterActivityType -> Text
version} -> Text
version) (\s :: RegisterActivityType
s@RegisterActivityType' {} Text
a -> RegisterActivityType
s {$sel:version:RegisterActivityType' :: Text
version = Text
a} :: RegisterActivityType)

instance Core.AWSRequest RegisterActivityType where
  type
    AWSResponse RegisterActivityType =
      RegisterActivityTypeResponse
  request :: (Service -> Service)
-> RegisterActivityType -> Request RegisterActivityType
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 RegisterActivityType
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RegisterActivityType)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull RegisterActivityTypeResponse
RegisterActivityTypeResponse'

instance Prelude.Hashable RegisterActivityType where
  hashWithSalt :: Int -> RegisterActivityType -> Int
hashWithSalt Int
_salt RegisterActivityType' {Maybe Text
Maybe TaskList
Text
version :: Text
name :: Text
domain :: Text
description :: Maybe Text
defaultTaskStartToCloseTimeout :: Maybe Text
defaultTaskScheduleToStartTimeout :: Maybe Text
defaultTaskScheduleToCloseTimeout :: Maybe Text
defaultTaskPriority :: Maybe Text
defaultTaskList :: Maybe TaskList
defaultTaskHeartbeatTimeout :: Maybe Text
$sel:version:RegisterActivityType' :: RegisterActivityType -> Text
$sel:name:RegisterActivityType' :: RegisterActivityType -> Text
$sel:domain:RegisterActivityType' :: RegisterActivityType -> Text
$sel:description:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskStartToCloseTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskScheduleToStartTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskScheduleToCloseTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskPriority:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskList:RegisterActivityType' :: RegisterActivityType -> Maybe TaskList
$sel:defaultTaskHeartbeatTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
defaultTaskHeartbeatTimeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TaskList
defaultTaskList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
defaultTaskPriority
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
defaultTaskScheduleToCloseTimeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
defaultTaskScheduleToStartTimeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
defaultTaskStartToCloseTimeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
version

instance Prelude.NFData RegisterActivityType where
  rnf :: RegisterActivityType -> ()
rnf RegisterActivityType' {Maybe Text
Maybe TaskList
Text
version :: Text
name :: Text
domain :: Text
description :: Maybe Text
defaultTaskStartToCloseTimeout :: Maybe Text
defaultTaskScheduleToStartTimeout :: Maybe Text
defaultTaskScheduleToCloseTimeout :: Maybe Text
defaultTaskPriority :: Maybe Text
defaultTaskList :: Maybe TaskList
defaultTaskHeartbeatTimeout :: Maybe Text
$sel:version:RegisterActivityType' :: RegisterActivityType -> Text
$sel:name:RegisterActivityType' :: RegisterActivityType -> Text
$sel:domain:RegisterActivityType' :: RegisterActivityType -> Text
$sel:description:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskStartToCloseTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskScheduleToStartTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskScheduleToCloseTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskPriority:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskList:RegisterActivityType' :: RegisterActivityType -> Maybe TaskList
$sel:defaultTaskHeartbeatTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
defaultTaskHeartbeatTimeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TaskList
defaultTaskList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
defaultTaskPriority
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
defaultTaskScheduleToCloseTimeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
defaultTaskScheduleToStartTimeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
defaultTaskStartToCloseTimeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
domain
      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
version

instance Data.ToHeaders RegisterActivityType where
  toHeaders :: RegisterActivityType -> [Header]
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 -> [Header]
Data.=# ( ByteString
"SimpleWorkflowService.RegisterActivityType" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON RegisterActivityType where
  toJSON :: RegisterActivityType -> Value
toJSON RegisterActivityType' {Maybe Text
Maybe TaskList
Text
version :: Text
name :: Text
domain :: Text
description :: Maybe Text
defaultTaskStartToCloseTimeout :: Maybe Text
defaultTaskScheduleToStartTimeout :: Maybe Text
defaultTaskScheduleToCloseTimeout :: Maybe Text
defaultTaskPriority :: Maybe Text
defaultTaskList :: Maybe TaskList
defaultTaskHeartbeatTimeout :: Maybe Text
$sel:version:RegisterActivityType' :: RegisterActivityType -> Text
$sel:name:RegisterActivityType' :: RegisterActivityType -> Text
$sel:domain:RegisterActivityType' :: RegisterActivityType -> Text
$sel:description:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskStartToCloseTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskScheduleToStartTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskScheduleToCloseTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskPriority:RegisterActivityType' :: RegisterActivityType -> Maybe Text
$sel:defaultTaskList:RegisterActivityType' :: RegisterActivityType -> Maybe TaskList
$sel:defaultTaskHeartbeatTimeout:RegisterActivityType' :: RegisterActivityType -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"defaultTaskHeartbeatTimeout" 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
defaultTaskHeartbeatTimeout,
            (Key
"defaultTaskList" 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 TaskList
defaultTaskList,
            (Key
"defaultTaskPriority" 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
defaultTaskPriority,
            (Key
"defaultTaskScheduleToCloseTimeout" 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
defaultTaskScheduleToCloseTimeout,
            (Key
"defaultTaskScheduleToStartTimeout" 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
defaultTaskScheduleToStartTimeout,
            (Key
"defaultTaskStartToCloseTimeout" 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
defaultTaskStartToCloseTimeout,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"domain" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domain),
            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
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
version)
          ]
      )

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

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

-- | /See:/ 'newRegisterActivityTypeResponse' smart constructor.
data RegisterActivityTypeResponse = RegisterActivityTypeResponse'
  {
  }
  deriving (RegisterActivityTypeResponse
-> RegisterActivityTypeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterActivityTypeResponse
-> RegisterActivityTypeResponse -> Bool
$c/= :: RegisterActivityTypeResponse
-> RegisterActivityTypeResponse -> Bool
== :: RegisterActivityTypeResponse
-> RegisterActivityTypeResponse -> Bool
$c== :: RegisterActivityTypeResponse
-> RegisterActivityTypeResponse -> Bool
Prelude.Eq, ReadPrec [RegisterActivityTypeResponse]
ReadPrec RegisterActivityTypeResponse
Int -> ReadS RegisterActivityTypeResponse
ReadS [RegisterActivityTypeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterActivityTypeResponse]
$creadListPrec :: ReadPrec [RegisterActivityTypeResponse]
readPrec :: ReadPrec RegisterActivityTypeResponse
$creadPrec :: ReadPrec RegisterActivityTypeResponse
readList :: ReadS [RegisterActivityTypeResponse]
$creadList :: ReadS [RegisterActivityTypeResponse]
readsPrec :: Int -> ReadS RegisterActivityTypeResponse
$creadsPrec :: Int -> ReadS RegisterActivityTypeResponse
Prelude.Read, Int -> RegisterActivityTypeResponse -> ShowS
[RegisterActivityTypeResponse] -> ShowS
RegisterActivityTypeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterActivityTypeResponse] -> ShowS
$cshowList :: [RegisterActivityTypeResponse] -> ShowS
show :: RegisterActivityTypeResponse -> String
$cshow :: RegisterActivityTypeResponse -> String
showsPrec :: Int -> RegisterActivityTypeResponse -> ShowS
$cshowsPrec :: Int -> RegisterActivityTypeResponse -> ShowS
Prelude.Show, forall x.
Rep RegisterActivityTypeResponse x -> RegisterActivityTypeResponse
forall x.
RegisterActivityTypeResponse -> Rep RegisterActivityTypeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterActivityTypeResponse x -> RegisterActivityTypeResponse
$cfrom :: forall x.
RegisterActivityTypeResponse -> Rep RegisterActivityTypeResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterActivityTypeResponse' 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.
newRegisterActivityTypeResponse ::
  RegisterActivityTypeResponse
newRegisterActivityTypeResponse :: RegisterActivityTypeResponse
newRegisterActivityTypeResponse =
  RegisterActivityTypeResponse
RegisterActivityTypeResponse'

instance Prelude.NFData RegisterActivityTypeResponse where
  rnf :: RegisterActivityTypeResponse -> ()
rnf RegisterActivityTypeResponse
_ = ()