{-# 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.Connect.UpdateContactFlowModuleContent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates specified flow module for the specified Amazon Connect instance.
module Amazonka.Connect.UpdateContactFlowModuleContent
  ( -- * Creating a Request
    UpdateContactFlowModuleContent (..),
    newUpdateContactFlowModuleContent,

    -- * Request Lenses
    updateContactFlowModuleContent_instanceId,
    updateContactFlowModuleContent_contactFlowModuleId,
    updateContactFlowModuleContent_content,

    -- * Destructuring the Response
    UpdateContactFlowModuleContentResponse (..),
    newUpdateContactFlowModuleContentResponse,

    -- * Response Lenses
    updateContactFlowModuleContentResponse_httpStatus,
  )
where

import Amazonka.Connect.Types
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

-- | /See:/ 'newUpdateContactFlowModuleContent' smart constructor.
data UpdateContactFlowModuleContent = UpdateContactFlowModuleContent'
  { -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    UpdateContactFlowModuleContent -> Text
instanceId :: Prelude.Text,
    -- | The identifier of the flow module.
    UpdateContactFlowModuleContent -> Text
contactFlowModuleId :: Prelude.Text,
    -- | The content of the flow module.
    UpdateContactFlowModuleContent -> Text
content :: Prelude.Text
  }
  deriving (UpdateContactFlowModuleContent
-> UpdateContactFlowModuleContent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateContactFlowModuleContent
-> UpdateContactFlowModuleContent -> Bool
$c/= :: UpdateContactFlowModuleContent
-> UpdateContactFlowModuleContent -> Bool
== :: UpdateContactFlowModuleContent
-> UpdateContactFlowModuleContent -> Bool
$c== :: UpdateContactFlowModuleContent
-> UpdateContactFlowModuleContent -> Bool
Prelude.Eq, ReadPrec [UpdateContactFlowModuleContent]
ReadPrec UpdateContactFlowModuleContent
Int -> ReadS UpdateContactFlowModuleContent
ReadS [UpdateContactFlowModuleContent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateContactFlowModuleContent]
$creadListPrec :: ReadPrec [UpdateContactFlowModuleContent]
readPrec :: ReadPrec UpdateContactFlowModuleContent
$creadPrec :: ReadPrec UpdateContactFlowModuleContent
readList :: ReadS [UpdateContactFlowModuleContent]
$creadList :: ReadS [UpdateContactFlowModuleContent]
readsPrec :: Int -> ReadS UpdateContactFlowModuleContent
$creadsPrec :: Int -> ReadS UpdateContactFlowModuleContent
Prelude.Read, Int -> UpdateContactFlowModuleContent -> ShowS
[UpdateContactFlowModuleContent] -> ShowS
UpdateContactFlowModuleContent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateContactFlowModuleContent] -> ShowS
$cshowList :: [UpdateContactFlowModuleContent] -> ShowS
show :: UpdateContactFlowModuleContent -> String
$cshow :: UpdateContactFlowModuleContent -> String
showsPrec :: Int -> UpdateContactFlowModuleContent -> ShowS
$cshowsPrec :: Int -> UpdateContactFlowModuleContent -> ShowS
Prelude.Show, forall x.
Rep UpdateContactFlowModuleContent x
-> UpdateContactFlowModuleContent
forall x.
UpdateContactFlowModuleContent
-> Rep UpdateContactFlowModuleContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateContactFlowModuleContent x
-> UpdateContactFlowModuleContent
$cfrom :: forall x.
UpdateContactFlowModuleContent
-> Rep UpdateContactFlowModuleContent x
Prelude.Generic)

-- |
-- Create a value of 'UpdateContactFlowModuleContent' 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:
--
-- 'instanceId', 'updateContactFlowModuleContent_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
--
-- 'contactFlowModuleId', 'updateContactFlowModuleContent_contactFlowModuleId' - The identifier of the flow module.
--
-- 'content', 'updateContactFlowModuleContent_content' - The content of the flow module.
newUpdateContactFlowModuleContent ::
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'contactFlowModuleId'
  Prelude.Text ->
  -- | 'content'
  Prelude.Text ->
  UpdateContactFlowModuleContent
newUpdateContactFlowModuleContent :: Text -> Text -> Text -> UpdateContactFlowModuleContent
newUpdateContactFlowModuleContent
  Text
pInstanceId_
  Text
pContactFlowModuleId_
  Text
pContent_ =
    UpdateContactFlowModuleContent'
      { $sel:instanceId:UpdateContactFlowModuleContent' :: Text
instanceId =
          Text
pInstanceId_,
        $sel:contactFlowModuleId:UpdateContactFlowModuleContent' :: Text
contactFlowModuleId = Text
pContactFlowModuleId_,
        $sel:content:UpdateContactFlowModuleContent' :: Text
content = Text
pContent_
      }

-- | The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
updateContactFlowModuleContent_instanceId :: Lens.Lens' UpdateContactFlowModuleContent Prelude.Text
updateContactFlowModuleContent_instanceId :: Lens' UpdateContactFlowModuleContent Text
updateContactFlowModuleContent_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContactFlowModuleContent' {Text
instanceId :: Text
$sel:instanceId:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
instanceId} -> Text
instanceId) (\s :: UpdateContactFlowModuleContent
s@UpdateContactFlowModuleContent' {} Text
a -> UpdateContactFlowModuleContent
s {$sel:instanceId:UpdateContactFlowModuleContent' :: Text
instanceId = Text
a} :: UpdateContactFlowModuleContent)

-- | The identifier of the flow module.
updateContactFlowModuleContent_contactFlowModuleId :: Lens.Lens' UpdateContactFlowModuleContent Prelude.Text
updateContactFlowModuleContent_contactFlowModuleId :: Lens' UpdateContactFlowModuleContent Text
updateContactFlowModuleContent_contactFlowModuleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContactFlowModuleContent' {Text
contactFlowModuleId :: Text
$sel:contactFlowModuleId:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
contactFlowModuleId} -> Text
contactFlowModuleId) (\s :: UpdateContactFlowModuleContent
s@UpdateContactFlowModuleContent' {} Text
a -> UpdateContactFlowModuleContent
s {$sel:contactFlowModuleId:UpdateContactFlowModuleContent' :: Text
contactFlowModuleId = Text
a} :: UpdateContactFlowModuleContent)

-- | The content of the flow module.
updateContactFlowModuleContent_content :: Lens.Lens' UpdateContactFlowModuleContent Prelude.Text
updateContactFlowModuleContent_content :: Lens' UpdateContactFlowModuleContent Text
updateContactFlowModuleContent_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContactFlowModuleContent' {Text
content :: Text
$sel:content:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
content} -> Text
content) (\s :: UpdateContactFlowModuleContent
s@UpdateContactFlowModuleContent' {} Text
a -> UpdateContactFlowModuleContent
s {$sel:content:UpdateContactFlowModuleContent' :: Text
content = Text
a} :: UpdateContactFlowModuleContent)

instance
  Core.AWSRequest
    UpdateContactFlowModuleContent
  where
  type
    AWSResponse UpdateContactFlowModuleContent =
      UpdateContactFlowModuleContentResponse
  request :: (Service -> Service)
-> UpdateContactFlowModuleContent
-> Request UpdateContactFlowModuleContent
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 UpdateContactFlowModuleContent
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse UpdateContactFlowModuleContent)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateContactFlowModuleContentResponse
UpdateContactFlowModuleContentResponse'
            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))
      )

instance
  Prelude.Hashable
    UpdateContactFlowModuleContent
  where
  hashWithSalt :: Int -> UpdateContactFlowModuleContent -> Int
hashWithSalt
    Int
_salt
    UpdateContactFlowModuleContent' {Text
content :: Text
contactFlowModuleId :: Text
instanceId :: Text
$sel:content:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
$sel:contactFlowModuleId:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
$sel:instanceId:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contactFlowModuleId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
content

instance
  Prelude.NFData
    UpdateContactFlowModuleContent
  where
  rnf :: UpdateContactFlowModuleContent -> ()
rnf UpdateContactFlowModuleContent' {Text
content :: Text
contactFlowModuleId :: Text
instanceId :: Text
$sel:content:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
$sel:contactFlowModuleId:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
$sel:instanceId:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contactFlowModuleId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
content

instance
  Data.ToHeaders
    UpdateContactFlowModuleContent
  where
  toHeaders :: UpdateContactFlowModuleContent -> 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 UpdateContactFlowModuleContent where
  toJSON :: UpdateContactFlowModuleContent -> Value
toJSON UpdateContactFlowModuleContent' {Text
content :: Text
contactFlowModuleId :: Text
instanceId :: Text
$sel:content:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
$sel:contactFlowModuleId:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
$sel:instanceId:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Content" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
content)]
      )

instance Data.ToPath UpdateContactFlowModuleContent where
  toPath :: UpdateContactFlowModuleContent -> ByteString
toPath UpdateContactFlowModuleContent' {Text
content :: Text
contactFlowModuleId :: Text
instanceId :: Text
$sel:content:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
$sel:contactFlowModuleId:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
$sel:instanceId:UpdateContactFlowModuleContent' :: UpdateContactFlowModuleContent -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/contact-flow-modules/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
instanceId,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
contactFlowModuleId,
        ByteString
"/content"
      ]

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

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

-- |
-- Create a value of 'UpdateContactFlowModuleContentResponse' 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', 'updateContactFlowModuleContentResponse_httpStatus' - The response's http status code.
newUpdateContactFlowModuleContentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateContactFlowModuleContentResponse
newUpdateContactFlowModuleContentResponse :: Int -> UpdateContactFlowModuleContentResponse
newUpdateContactFlowModuleContentResponse
  Int
pHttpStatus_ =
    UpdateContactFlowModuleContentResponse'
      { $sel:httpStatus:UpdateContactFlowModuleContentResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

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

instance
  Prelude.NFData
    UpdateContactFlowModuleContentResponse
  where
  rnf :: UpdateContactFlowModuleContentResponse -> ()
rnf UpdateContactFlowModuleContentResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateContactFlowModuleContentResponse' :: UpdateContactFlowModuleContentResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus