{-# 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.CustomerProfiles.CreateIntegrationWorkflow
-- 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 an integration workflow. An integration workflow is an async
-- process which ingests historic data and sets up an integration for
-- ongoing updates. The supported Amazon AppFlow sources are Salesforce,
-- ServiceNow, and Marketo.
module Amazonka.CustomerProfiles.CreateIntegrationWorkflow
  ( -- * Creating a Request
    CreateIntegrationWorkflow (..),
    newCreateIntegrationWorkflow,

    -- * Request Lenses
    createIntegrationWorkflow_tags,
    createIntegrationWorkflow_domainName,
    createIntegrationWorkflow_workflowType,
    createIntegrationWorkflow_integrationConfig,
    createIntegrationWorkflow_objectTypeName,
    createIntegrationWorkflow_roleArn,

    -- * Destructuring the Response
    CreateIntegrationWorkflowResponse (..),
    newCreateIntegrationWorkflowResponse,

    -- * Response Lenses
    createIntegrationWorkflowResponse_httpStatus,
    createIntegrationWorkflowResponse_workflowId,
    createIntegrationWorkflowResponse_message,
  )
where

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

-- | /See:/ 'newCreateIntegrationWorkflow' smart constructor.
data CreateIntegrationWorkflow = CreateIntegrationWorkflow'
  { -- | The tags used to organize, track, or control access for this resource.
    CreateIntegrationWorkflow -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The unique name of the domain.
    CreateIntegrationWorkflow -> Text
domainName :: Prelude.Text,
    -- | The type of workflow. The only supported value is APPFLOW_INTEGRATION.
    CreateIntegrationWorkflow -> WorkflowType
workflowType :: WorkflowType,
    -- | Configuration data for integration workflow.
    CreateIntegrationWorkflow -> IntegrationConfig
integrationConfig :: IntegrationConfig,
    -- | The name of the profile object type.
    CreateIntegrationWorkflow -> Text
objectTypeName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the IAM role. Customer Profiles
    -- assumes this role to create resources on your behalf as part of workflow
    -- execution.
    CreateIntegrationWorkflow -> Text
roleArn :: Prelude.Text
  }
  deriving (CreateIntegrationWorkflow -> CreateIntegrationWorkflow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIntegrationWorkflow -> CreateIntegrationWorkflow -> Bool
$c/= :: CreateIntegrationWorkflow -> CreateIntegrationWorkflow -> Bool
== :: CreateIntegrationWorkflow -> CreateIntegrationWorkflow -> Bool
$c== :: CreateIntegrationWorkflow -> CreateIntegrationWorkflow -> Bool
Prelude.Eq, ReadPrec [CreateIntegrationWorkflow]
ReadPrec CreateIntegrationWorkflow
Int -> ReadS CreateIntegrationWorkflow
ReadS [CreateIntegrationWorkflow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateIntegrationWorkflow]
$creadListPrec :: ReadPrec [CreateIntegrationWorkflow]
readPrec :: ReadPrec CreateIntegrationWorkflow
$creadPrec :: ReadPrec CreateIntegrationWorkflow
readList :: ReadS [CreateIntegrationWorkflow]
$creadList :: ReadS [CreateIntegrationWorkflow]
readsPrec :: Int -> ReadS CreateIntegrationWorkflow
$creadsPrec :: Int -> ReadS CreateIntegrationWorkflow
Prelude.Read, Int -> CreateIntegrationWorkflow -> ShowS
[CreateIntegrationWorkflow] -> ShowS
CreateIntegrationWorkflow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIntegrationWorkflow] -> ShowS
$cshowList :: [CreateIntegrationWorkflow] -> ShowS
show :: CreateIntegrationWorkflow -> String
$cshow :: CreateIntegrationWorkflow -> String
showsPrec :: Int -> CreateIntegrationWorkflow -> ShowS
$cshowsPrec :: Int -> CreateIntegrationWorkflow -> ShowS
Prelude.Show, forall x.
Rep CreateIntegrationWorkflow x -> CreateIntegrationWorkflow
forall x.
CreateIntegrationWorkflow -> Rep CreateIntegrationWorkflow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateIntegrationWorkflow x -> CreateIntegrationWorkflow
$cfrom :: forall x.
CreateIntegrationWorkflow -> Rep CreateIntegrationWorkflow x
Prelude.Generic)

-- |
-- Create a value of 'CreateIntegrationWorkflow' 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:
--
-- 'tags', 'createIntegrationWorkflow_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'domainName', 'createIntegrationWorkflow_domainName' - The unique name of the domain.
--
-- 'workflowType', 'createIntegrationWorkflow_workflowType' - The type of workflow. The only supported value is APPFLOW_INTEGRATION.
--
-- 'integrationConfig', 'createIntegrationWorkflow_integrationConfig' - Configuration data for integration workflow.
--
-- 'objectTypeName', 'createIntegrationWorkflow_objectTypeName' - The name of the profile object type.
--
-- 'roleArn', 'createIntegrationWorkflow_roleArn' - The Amazon Resource Name (ARN) of the IAM role. Customer Profiles
-- assumes this role to create resources on your behalf as part of workflow
-- execution.
newCreateIntegrationWorkflow ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'workflowType'
  WorkflowType ->
  -- | 'integrationConfig'
  IntegrationConfig ->
  -- | 'objectTypeName'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  CreateIntegrationWorkflow
newCreateIntegrationWorkflow :: Text
-> WorkflowType
-> IntegrationConfig
-> Text
-> Text
-> CreateIntegrationWorkflow
newCreateIntegrationWorkflow
  Text
pDomainName_
  WorkflowType
pWorkflowType_
  IntegrationConfig
pIntegrationConfig_
  Text
pObjectTypeName_
  Text
pRoleArn_ =
    CreateIntegrationWorkflow'
      { $sel:tags:CreateIntegrationWorkflow' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:domainName:CreateIntegrationWorkflow' :: Text
domainName = Text
pDomainName_,
        $sel:workflowType:CreateIntegrationWorkflow' :: WorkflowType
workflowType = WorkflowType
pWorkflowType_,
        $sel:integrationConfig:CreateIntegrationWorkflow' :: IntegrationConfig
integrationConfig = IntegrationConfig
pIntegrationConfig_,
        $sel:objectTypeName:CreateIntegrationWorkflow' :: Text
objectTypeName = Text
pObjectTypeName_,
        $sel:roleArn:CreateIntegrationWorkflow' :: Text
roleArn = Text
pRoleArn_
      }

-- | The tags used to organize, track, or control access for this resource.
createIntegrationWorkflow_tags :: Lens.Lens' CreateIntegrationWorkflow (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createIntegrationWorkflow_tags :: Lens' CreateIntegrationWorkflow (Maybe (HashMap Text Text))
createIntegrationWorkflow_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntegrationWorkflow' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateIntegrationWorkflow
s@CreateIntegrationWorkflow' {} Maybe (HashMap Text Text)
a -> CreateIntegrationWorkflow
s {$sel:tags:CreateIntegrationWorkflow' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateIntegrationWorkflow) 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

-- | The unique name of the domain.
createIntegrationWorkflow_domainName :: Lens.Lens' CreateIntegrationWorkflow Prelude.Text
createIntegrationWorkflow_domainName :: Lens' CreateIntegrationWorkflow Text
createIntegrationWorkflow_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntegrationWorkflow' {Text
domainName :: Text
$sel:domainName:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
domainName} -> Text
domainName) (\s :: CreateIntegrationWorkflow
s@CreateIntegrationWorkflow' {} Text
a -> CreateIntegrationWorkflow
s {$sel:domainName:CreateIntegrationWorkflow' :: Text
domainName = Text
a} :: CreateIntegrationWorkflow)

-- | The type of workflow. The only supported value is APPFLOW_INTEGRATION.
createIntegrationWorkflow_workflowType :: Lens.Lens' CreateIntegrationWorkflow WorkflowType
createIntegrationWorkflow_workflowType :: Lens' CreateIntegrationWorkflow WorkflowType
createIntegrationWorkflow_workflowType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntegrationWorkflow' {WorkflowType
workflowType :: WorkflowType
$sel:workflowType:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> WorkflowType
workflowType} -> WorkflowType
workflowType) (\s :: CreateIntegrationWorkflow
s@CreateIntegrationWorkflow' {} WorkflowType
a -> CreateIntegrationWorkflow
s {$sel:workflowType:CreateIntegrationWorkflow' :: WorkflowType
workflowType = WorkflowType
a} :: CreateIntegrationWorkflow)

-- | Configuration data for integration workflow.
createIntegrationWorkflow_integrationConfig :: Lens.Lens' CreateIntegrationWorkflow IntegrationConfig
createIntegrationWorkflow_integrationConfig :: Lens' CreateIntegrationWorkflow IntegrationConfig
createIntegrationWorkflow_integrationConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntegrationWorkflow' {IntegrationConfig
integrationConfig :: IntegrationConfig
$sel:integrationConfig:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> IntegrationConfig
integrationConfig} -> IntegrationConfig
integrationConfig) (\s :: CreateIntegrationWorkflow
s@CreateIntegrationWorkflow' {} IntegrationConfig
a -> CreateIntegrationWorkflow
s {$sel:integrationConfig:CreateIntegrationWorkflow' :: IntegrationConfig
integrationConfig = IntegrationConfig
a} :: CreateIntegrationWorkflow)

-- | The name of the profile object type.
createIntegrationWorkflow_objectTypeName :: Lens.Lens' CreateIntegrationWorkflow Prelude.Text
createIntegrationWorkflow_objectTypeName :: Lens' CreateIntegrationWorkflow Text
createIntegrationWorkflow_objectTypeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntegrationWorkflow' {Text
objectTypeName :: Text
$sel:objectTypeName:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
objectTypeName} -> Text
objectTypeName) (\s :: CreateIntegrationWorkflow
s@CreateIntegrationWorkflow' {} Text
a -> CreateIntegrationWorkflow
s {$sel:objectTypeName:CreateIntegrationWorkflow' :: Text
objectTypeName = Text
a} :: CreateIntegrationWorkflow)

-- | The Amazon Resource Name (ARN) of the IAM role. Customer Profiles
-- assumes this role to create resources on your behalf as part of workflow
-- execution.
createIntegrationWorkflow_roleArn :: Lens.Lens' CreateIntegrationWorkflow Prelude.Text
createIntegrationWorkflow_roleArn :: Lens' CreateIntegrationWorkflow Text
createIntegrationWorkflow_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntegrationWorkflow' {Text
roleArn :: Text
$sel:roleArn:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
roleArn} -> Text
roleArn) (\s :: CreateIntegrationWorkflow
s@CreateIntegrationWorkflow' {} Text
a -> CreateIntegrationWorkflow
s {$sel:roleArn:CreateIntegrationWorkflow' :: Text
roleArn = Text
a} :: CreateIntegrationWorkflow)

instance Core.AWSRequest CreateIntegrationWorkflow where
  type
    AWSResponse CreateIntegrationWorkflow =
      CreateIntegrationWorkflowResponse
  request :: (Service -> Service)
-> CreateIntegrationWorkflow -> Request CreateIntegrationWorkflow
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 CreateIntegrationWorkflow
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateIntegrationWorkflow)))
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 -> Text -> CreateIntegrationWorkflowResponse
CreateIntegrationWorkflowResponse'
            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
"WorkflowId")
            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
"Message")
      )

instance Prelude.Hashable CreateIntegrationWorkflow where
  hashWithSalt :: Int -> CreateIntegrationWorkflow -> Int
hashWithSalt Int
_salt CreateIntegrationWorkflow' {Maybe (HashMap Text Text)
Text
WorkflowType
IntegrationConfig
roleArn :: Text
objectTypeName :: Text
integrationConfig :: IntegrationConfig
workflowType :: WorkflowType
domainName :: Text
tags :: Maybe (HashMap Text Text)
$sel:roleArn:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
$sel:objectTypeName:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
$sel:integrationConfig:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> IntegrationConfig
$sel:workflowType:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> WorkflowType
$sel:domainName:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
$sel:tags:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` WorkflowType
workflowType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` IntegrationConfig
integrationConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
objectTypeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData CreateIntegrationWorkflow where
  rnf :: CreateIntegrationWorkflow -> ()
rnf CreateIntegrationWorkflow' {Maybe (HashMap Text Text)
Text
WorkflowType
IntegrationConfig
roleArn :: Text
objectTypeName :: Text
integrationConfig :: IntegrationConfig
workflowType :: WorkflowType
domainName :: Text
tags :: Maybe (HashMap Text Text)
$sel:roleArn:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
$sel:objectTypeName:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
$sel:integrationConfig:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> IntegrationConfig
$sel:workflowType:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> WorkflowType
$sel:domainName:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
$sel:tags:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Maybe (HashMap Text Text)
..} =
    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
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf WorkflowType
workflowType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf IntegrationConfig
integrationConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
objectTypeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

instance Data.ToHeaders CreateIntegrationWorkflow where
  toHeaders :: CreateIntegrationWorkflow -> 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 CreateIntegrationWorkflow where
  toJSON :: CreateIntegrationWorkflow -> Value
toJSON CreateIntegrationWorkflow' {Maybe (HashMap Text Text)
Text
WorkflowType
IntegrationConfig
roleArn :: Text
objectTypeName :: Text
integrationConfig :: IntegrationConfig
workflowType :: WorkflowType
domainName :: Text
tags :: Maybe (HashMap Text Text)
$sel:roleArn:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
$sel:objectTypeName:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
$sel:integrationConfig:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> IntegrationConfig
$sel:workflowType:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> WorkflowType
$sel:domainName:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
$sel:tags:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"WorkflowType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= WorkflowType
workflowType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"IntegrationConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= IntegrationConfig
integrationConfig),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ObjectTypeName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
objectTypeName),
            forall a. a -> Maybe a
Prelude.Just (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn)
          ]
      )

instance Data.ToPath CreateIntegrationWorkflow where
  toPath :: CreateIntegrationWorkflow -> ByteString
toPath CreateIntegrationWorkflow' {Maybe (HashMap Text Text)
Text
WorkflowType
IntegrationConfig
roleArn :: Text
objectTypeName :: Text
integrationConfig :: IntegrationConfig
workflowType :: WorkflowType
domainName :: Text
tags :: Maybe (HashMap Text Text)
$sel:roleArn:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
$sel:objectTypeName:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
$sel:integrationConfig:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> IntegrationConfig
$sel:workflowType:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> WorkflowType
$sel:domainName:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Text
$sel:tags:CreateIntegrationWorkflow' :: CreateIntegrationWorkflow -> Maybe (HashMap Text Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domains/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName,
        ByteString
"/workflows/integrations"
      ]

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

-- | /See:/ 'newCreateIntegrationWorkflowResponse' smart constructor.
data CreateIntegrationWorkflowResponse = CreateIntegrationWorkflowResponse'
  { -- | The response's http status code.
    CreateIntegrationWorkflowResponse -> Int
httpStatus :: Prelude.Int,
    -- | Unique identifier for the workflow.
    CreateIntegrationWorkflowResponse -> Text
workflowId :: Prelude.Text,
    -- | A message indicating create request was received.
    CreateIntegrationWorkflowResponse -> Text
message :: Prelude.Text
  }
  deriving (CreateIntegrationWorkflowResponse
-> CreateIntegrationWorkflowResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIntegrationWorkflowResponse
-> CreateIntegrationWorkflowResponse -> Bool
$c/= :: CreateIntegrationWorkflowResponse
-> CreateIntegrationWorkflowResponse -> Bool
== :: CreateIntegrationWorkflowResponse
-> CreateIntegrationWorkflowResponse -> Bool
$c== :: CreateIntegrationWorkflowResponse
-> CreateIntegrationWorkflowResponse -> Bool
Prelude.Eq, ReadPrec [CreateIntegrationWorkflowResponse]
ReadPrec CreateIntegrationWorkflowResponse
Int -> ReadS CreateIntegrationWorkflowResponse
ReadS [CreateIntegrationWorkflowResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateIntegrationWorkflowResponse]
$creadListPrec :: ReadPrec [CreateIntegrationWorkflowResponse]
readPrec :: ReadPrec CreateIntegrationWorkflowResponse
$creadPrec :: ReadPrec CreateIntegrationWorkflowResponse
readList :: ReadS [CreateIntegrationWorkflowResponse]
$creadList :: ReadS [CreateIntegrationWorkflowResponse]
readsPrec :: Int -> ReadS CreateIntegrationWorkflowResponse
$creadsPrec :: Int -> ReadS CreateIntegrationWorkflowResponse
Prelude.Read, Int -> CreateIntegrationWorkflowResponse -> ShowS
[CreateIntegrationWorkflowResponse] -> ShowS
CreateIntegrationWorkflowResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIntegrationWorkflowResponse] -> ShowS
$cshowList :: [CreateIntegrationWorkflowResponse] -> ShowS
show :: CreateIntegrationWorkflowResponse -> String
$cshow :: CreateIntegrationWorkflowResponse -> String
showsPrec :: Int -> CreateIntegrationWorkflowResponse -> ShowS
$cshowsPrec :: Int -> CreateIntegrationWorkflowResponse -> ShowS
Prelude.Show, forall x.
Rep CreateIntegrationWorkflowResponse x
-> CreateIntegrationWorkflowResponse
forall x.
CreateIntegrationWorkflowResponse
-> Rep CreateIntegrationWorkflowResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateIntegrationWorkflowResponse x
-> CreateIntegrationWorkflowResponse
$cfrom :: forall x.
CreateIntegrationWorkflowResponse
-> Rep CreateIntegrationWorkflowResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateIntegrationWorkflowResponse' 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', 'createIntegrationWorkflowResponse_httpStatus' - The response's http status code.
--
-- 'workflowId', 'createIntegrationWorkflowResponse_workflowId' - Unique identifier for the workflow.
--
-- 'message', 'createIntegrationWorkflowResponse_message' - A message indicating create request was received.
newCreateIntegrationWorkflowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'workflowId'
  Prelude.Text ->
  -- | 'message'
  Prelude.Text ->
  CreateIntegrationWorkflowResponse
newCreateIntegrationWorkflowResponse :: Int -> Text -> Text -> CreateIntegrationWorkflowResponse
newCreateIntegrationWorkflowResponse
  Int
pHttpStatus_
  Text
pWorkflowId_
  Text
pMessage_ =
    CreateIntegrationWorkflowResponse'
      { $sel:httpStatus:CreateIntegrationWorkflowResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:workflowId:CreateIntegrationWorkflowResponse' :: Text
workflowId = Text
pWorkflowId_,
        $sel:message:CreateIntegrationWorkflowResponse' :: Text
message = Text
pMessage_
      }

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

-- | Unique identifier for the workflow.
createIntegrationWorkflowResponse_workflowId :: Lens.Lens' CreateIntegrationWorkflowResponse Prelude.Text
createIntegrationWorkflowResponse_workflowId :: Lens' CreateIntegrationWorkflowResponse Text
createIntegrationWorkflowResponse_workflowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntegrationWorkflowResponse' {Text
workflowId :: Text
$sel:workflowId:CreateIntegrationWorkflowResponse' :: CreateIntegrationWorkflowResponse -> Text
workflowId} -> Text
workflowId) (\s :: CreateIntegrationWorkflowResponse
s@CreateIntegrationWorkflowResponse' {} Text
a -> CreateIntegrationWorkflowResponse
s {$sel:workflowId:CreateIntegrationWorkflowResponse' :: Text
workflowId = Text
a} :: CreateIntegrationWorkflowResponse)

-- | A message indicating create request was received.
createIntegrationWorkflowResponse_message :: Lens.Lens' CreateIntegrationWorkflowResponse Prelude.Text
createIntegrationWorkflowResponse_message :: Lens' CreateIntegrationWorkflowResponse Text
createIntegrationWorkflowResponse_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntegrationWorkflowResponse' {Text
message :: Text
$sel:message:CreateIntegrationWorkflowResponse' :: CreateIntegrationWorkflowResponse -> Text
message} -> Text
message) (\s :: CreateIntegrationWorkflowResponse
s@CreateIntegrationWorkflowResponse' {} Text
a -> CreateIntegrationWorkflowResponse
s {$sel:message:CreateIntegrationWorkflowResponse' :: Text
message = Text
a} :: CreateIntegrationWorkflowResponse)

instance
  Prelude.NFData
    CreateIntegrationWorkflowResponse
  where
  rnf :: CreateIntegrationWorkflowResponse -> ()
rnf CreateIntegrationWorkflowResponse' {Int
Text
message :: Text
workflowId :: Text
httpStatus :: Int
$sel:message:CreateIntegrationWorkflowResponse' :: CreateIntegrationWorkflowResponse -> Text
$sel:workflowId:CreateIntegrationWorkflowResponse' :: CreateIntegrationWorkflowResponse -> Text
$sel:httpStatus:CreateIntegrationWorkflowResponse' :: CreateIntegrationWorkflowResponse -> 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
workflowId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
message