{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- Module : Network.AWS.SWF.RegisterWorkflowType -- Copyright : (c) 2013-2014 Brendan Hay -- License : This Source Code Form is subject to the terms of -- the Mozilla Public License, v. 2.0. -- A copy of the MPL can be found in the LICENSE file or -- you can obtain it at http://mozilla.org/MPL/2.0/. -- Maintainer : Brendan Hay -- Stability : experimental -- Portability : non-portable (GHC extensions) -- | Registers a new workflow type and its configuration settings in the -- specified domain. The retention period for the workflow history is set by -- the RegisterDomain action. If the type already exists, then a -- TypeAlreadyExists fault is returned. You cannot change the configuration -- settings of a workflow type once it is registered 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 does not -- have sufficient permissions to invoke the action, or the parameter values -- fall outside the specified constraints, the action fails by throwing -- OperationNotPermitted. For details and example IAM policies, see Using IAM -- to Manage Access to Amazon SWF Workflows. -- -- module Network.AWS.SWF.RegisterWorkflowType ( -- * Request RegisterWorkflowType -- ** Request constructor , registerWorkflowType -- ** Request lenses , rwtDefaultChildPolicy , rwtDefaultExecutionStartToCloseTimeout , rwtDefaultTaskList , rwtDefaultTaskStartToCloseTimeout , rwtDescription , rwtDomain , rwtName , rwtVersion -- * Response , RegisterWorkflowTypeResponse -- ** Response constructor , registerWorkflowTypeResponse ) where import Network.AWS.Prelude import Network.AWS.Request.JSON import Network.AWS.SWF.Types import qualified GHC.Exts data RegisterWorkflowType = RegisterWorkflowType { _rwtDefaultChildPolicy :: Maybe ChildPolicy , _rwtDefaultExecutionStartToCloseTimeout :: Maybe Text , _rwtDefaultTaskList :: Maybe TaskList , _rwtDefaultTaskStartToCloseTimeout :: Maybe Text , _rwtDescription :: Maybe Text , _rwtDomain :: Text , _rwtName :: Text , _rwtVersion :: Text } deriving (Eq, Show) -- | 'RegisterWorkflowType' constructor. -- -- The fields accessible through corresponding lenses are: -- -- * 'rwtDefaultChildPolicy' @::@ 'Maybe' 'ChildPolicy' -- -- * 'rwtDefaultExecutionStartToCloseTimeout' @::@ 'Maybe' 'Text' -- -- * 'rwtDefaultTaskList' @::@ 'Maybe' 'TaskList' -- -- * 'rwtDefaultTaskStartToCloseTimeout' @::@ 'Maybe' 'Text' -- -- * 'rwtDescription' @::@ 'Maybe' 'Text' -- -- * 'rwtDomain' @::@ 'Text' -- -- * 'rwtName' @::@ 'Text' -- -- * 'rwtVersion' @::@ 'Text' -- registerWorkflowType :: Text -- ^ 'rwtDomain' -> Text -- ^ 'rwtName' -> Text -- ^ 'rwtVersion' -> RegisterWorkflowType registerWorkflowType p1 p2 p3 = RegisterWorkflowType { _rwtDomain = p1 , _rwtName = p2 , _rwtVersion = p3 , _rwtDescription = Nothing , _rwtDefaultTaskStartToCloseTimeout = Nothing , _rwtDefaultExecutionStartToCloseTimeout = Nothing , _rwtDefaultTaskList = Nothing , _rwtDefaultChildPolicy = Nothing } -- | If set, specifies the default policy to use for the child workflow -- executions when a workflow execution of this type is terminated, by -- calling the TerminateWorkflowExecution action explicitly or due to an -- expired timeout. This default can be overridden when starting a workflow -- execution using the StartWorkflowExecution action or the -- StartChildWorkflowExecution Decision. The supported child policies are: -- TERMINATE: the child executions will be terminated. REQUEST_CANCEL: a -- request to cancel will be attempted for each child execution by recording -- a WorkflowExecutionCancelRequested event in its history. It is up to the -- decider to take appropriate actions when it receives an execution history -- with this event. ABANDON: no action will be taken. The child executions -- will continue to run. rwtDefaultChildPolicy :: Lens' RegisterWorkflowType (Maybe ChildPolicy) rwtDefaultChildPolicy = lens _rwtDefaultChildPolicy (\s a -> s { _rwtDefaultChildPolicy = a }) -- | If set, specifies the default maximum duration for executions of this -- workflow type. You can override this default when starting an execution -- through the StartWorkflowExecution Action or StartChildWorkflowExecution -- Decision. The duration is specified in seconds. The valid values are -- integers greater than or equal to 0. Unlike some of the other timeout -- parameters in Amazon SWF, you cannot specify a value of "NONE" for -- defaultExecutionStartToCloseTimeout; there is a one-year max limit on the -- time that a workflow execution can run. Exceeding this limit will always -- cause the workflow execution to time out. rwtDefaultExecutionStartToCloseTimeout :: Lens' RegisterWorkflowType (Maybe Text) rwtDefaultExecutionStartToCloseTimeout = lens _rwtDefaultExecutionStartToCloseTimeout (\s a -> s { _rwtDefaultExecutionStartToCloseTimeout = a }) -- | If set, specifies the default task list to use for scheduling decision -- tasks for executions of this workflow type. This default is used only if -- a task list is not provided when starting the execution through the -- StartWorkflowExecution Action or StartChildWorkflowExecution Decision. rwtDefaultTaskList :: Lens' RegisterWorkflowType (Maybe TaskList) rwtDefaultTaskList = lens _rwtDefaultTaskList (\s a -> s { _rwtDefaultTaskList = a }) -- | If set, specifies the default maximum duration of decision tasks for this -- workflow type. This default can be overridden when starting a workflow -- execution using the StartWorkflowExecution action or the -- StartChildWorkflowExecution Decision. The valid values are integers -- greater than or equal to 0. An integer value can be used to specify the -- duration in seconds while NONE can be used to specify unlimited duration. rwtDefaultTaskStartToCloseTimeout :: Lens' RegisterWorkflowType (Maybe Text) rwtDefaultTaskStartToCloseTimeout = lens _rwtDefaultTaskStartToCloseTimeout (\s a -> s { _rwtDefaultTaskStartToCloseTimeout = a }) -- | Textual description of the workflow type. rwtDescription :: Lens' RegisterWorkflowType (Maybe Text) rwtDescription = lens _rwtDescription (\s a -> s { _rwtDescription = a }) -- | The name of the domain in which to register the workflow type. rwtDomain :: Lens' RegisterWorkflowType Text rwtDomain = lens _rwtDomain (\s a -> s { _rwtDomain = a }) -- | The name of the workflow type. 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 contain the literal string "arn". rwtName :: Lens' RegisterWorkflowType Text rwtName = lens _rwtName (\s a -> s { _rwtName = a }) -- | The version of the workflow type. 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 contain the literal string "arn". rwtVersion :: Lens' RegisterWorkflowType Text rwtVersion = lens _rwtVersion (\s a -> s { _rwtVersion = a }) data RegisterWorkflowTypeResponse = RegisterWorkflowTypeResponse deriving (Eq, Ord, Show, Generic) -- | 'RegisterWorkflowTypeResponse' constructor. registerWorkflowTypeResponse :: RegisterWorkflowTypeResponse registerWorkflowTypeResponse = RegisterWorkflowTypeResponse instance ToPath RegisterWorkflowType where toPath = const "/" instance ToQuery RegisterWorkflowType where toQuery = const mempty instance ToHeaders RegisterWorkflowType instance ToJSON RegisterWorkflowType where toJSON RegisterWorkflowType{..} = object [ "domain" .= _rwtDomain , "name" .= _rwtName , "version" .= _rwtVersion , "description" .= _rwtDescription , "defaultTaskStartToCloseTimeout" .= _rwtDefaultTaskStartToCloseTimeout , "defaultExecutionStartToCloseTimeout" .= _rwtDefaultExecutionStartToCloseTimeout , "defaultTaskList" .= _rwtDefaultTaskList , "defaultChildPolicy" .= _rwtDefaultChildPolicy ] instance AWSRequest RegisterWorkflowType where type Sv RegisterWorkflowType = SWF type Rs RegisterWorkflowType = RegisterWorkflowTypeResponse request = post "RegisterWorkflowType" response = nullResponse RegisterWorkflowTypeResponse