{-# 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.ChimeSDKMessaging.ChannelFlowCallback
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Calls back Chime SDK Messaging with a processing response message. This
-- should be invoked from the processor Lambda. This is a developer API.
--
-- You can return one of the following processing responses:
--
-- -   Update message content or metadata
--
-- -   Deny a message
--
-- -   Make no changes to the message
module Amazonka.ChimeSDKMessaging.ChannelFlowCallback
  ( -- * Creating a Request
    ChannelFlowCallback (..),
    newChannelFlowCallback,

    -- * Request Lenses
    channelFlowCallback_deleteResource,
    channelFlowCallback_callbackId,
    channelFlowCallback_channelArn,
    channelFlowCallback_channelMessage,

    -- * Destructuring the Response
    ChannelFlowCallbackResponse (..),
    newChannelFlowCallbackResponse,

    -- * Response Lenses
    channelFlowCallbackResponse_callbackId,
    channelFlowCallbackResponse_channelArn,
    channelFlowCallbackResponse_httpStatus,
  )
where

import Amazonka.ChimeSDKMessaging.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:/ 'newChannelFlowCallback' smart constructor.
data ChannelFlowCallback = ChannelFlowCallback'
  { -- | When a processor determines that a message needs to be @DENIED@, pass
    -- this parameter with a value of true.
    ChannelFlowCallback -> Maybe Bool
deleteResource :: Prelude.Maybe Prelude.Bool,
    -- | The identifier passed to the processor by the service when invoked. Use
    -- the identifier to call back the service.
    ChannelFlowCallback -> Text
callbackId :: Prelude.Text,
    -- | The ARN of the channel.
    ChannelFlowCallback -> Text
channelArn :: Prelude.Text,
    -- | Stores information about the processed message.
    ChannelFlowCallback -> ChannelMessageCallback
channelMessage :: ChannelMessageCallback
  }
  deriving (ChannelFlowCallback -> ChannelFlowCallback -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelFlowCallback -> ChannelFlowCallback -> Bool
$c/= :: ChannelFlowCallback -> ChannelFlowCallback -> Bool
== :: ChannelFlowCallback -> ChannelFlowCallback -> Bool
$c== :: ChannelFlowCallback -> ChannelFlowCallback -> Bool
Prelude.Eq, Int -> ChannelFlowCallback -> ShowS
[ChannelFlowCallback] -> ShowS
ChannelFlowCallback -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelFlowCallback] -> ShowS
$cshowList :: [ChannelFlowCallback] -> ShowS
show :: ChannelFlowCallback -> String
$cshow :: ChannelFlowCallback -> String
showsPrec :: Int -> ChannelFlowCallback -> ShowS
$cshowsPrec :: Int -> ChannelFlowCallback -> ShowS
Prelude.Show, forall x. Rep ChannelFlowCallback x -> ChannelFlowCallback
forall x. ChannelFlowCallback -> Rep ChannelFlowCallback x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChannelFlowCallback x -> ChannelFlowCallback
$cfrom :: forall x. ChannelFlowCallback -> Rep ChannelFlowCallback x
Prelude.Generic)

-- |
-- Create a value of 'ChannelFlowCallback' 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:
--
-- 'deleteResource', 'channelFlowCallback_deleteResource' - When a processor determines that a message needs to be @DENIED@, pass
-- this parameter with a value of true.
--
-- 'callbackId', 'channelFlowCallback_callbackId' - The identifier passed to the processor by the service when invoked. Use
-- the identifier to call back the service.
--
-- 'channelArn', 'channelFlowCallback_channelArn' - The ARN of the channel.
--
-- 'channelMessage', 'channelFlowCallback_channelMessage' - Stores information about the processed message.
newChannelFlowCallback ::
  -- | 'callbackId'
  Prelude.Text ->
  -- | 'channelArn'
  Prelude.Text ->
  -- | 'channelMessage'
  ChannelMessageCallback ->
  ChannelFlowCallback
newChannelFlowCallback :: Text -> Text -> ChannelMessageCallback -> ChannelFlowCallback
newChannelFlowCallback
  Text
pCallbackId_
  Text
pChannelArn_
  ChannelMessageCallback
pChannelMessage_ =
    ChannelFlowCallback'
      { $sel:deleteResource:ChannelFlowCallback' :: Maybe Bool
deleteResource =
          forall a. Maybe a
Prelude.Nothing,
        $sel:callbackId:ChannelFlowCallback' :: Text
callbackId = Text
pCallbackId_,
        $sel:channelArn:ChannelFlowCallback' :: Text
channelArn = Text
pChannelArn_,
        $sel:channelMessage:ChannelFlowCallback' :: ChannelMessageCallback
channelMessage = ChannelMessageCallback
pChannelMessage_
      }

-- | When a processor determines that a message needs to be @DENIED@, pass
-- this parameter with a value of true.
channelFlowCallback_deleteResource :: Lens.Lens' ChannelFlowCallback (Prelude.Maybe Prelude.Bool)
channelFlowCallback_deleteResource :: Lens' ChannelFlowCallback (Maybe Bool)
channelFlowCallback_deleteResource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChannelFlowCallback' {Maybe Bool
deleteResource :: Maybe Bool
$sel:deleteResource:ChannelFlowCallback' :: ChannelFlowCallback -> Maybe Bool
deleteResource} -> Maybe Bool
deleteResource) (\s :: ChannelFlowCallback
s@ChannelFlowCallback' {} Maybe Bool
a -> ChannelFlowCallback
s {$sel:deleteResource:ChannelFlowCallback' :: Maybe Bool
deleteResource = Maybe Bool
a} :: ChannelFlowCallback)

-- | The identifier passed to the processor by the service when invoked. Use
-- the identifier to call back the service.
channelFlowCallback_callbackId :: Lens.Lens' ChannelFlowCallback Prelude.Text
channelFlowCallback_callbackId :: Lens' ChannelFlowCallback Text
channelFlowCallback_callbackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChannelFlowCallback' {Text
callbackId :: Text
$sel:callbackId:ChannelFlowCallback' :: ChannelFlowCallback -> Text
callbackId} -> Text
callbackId) (\s :: ChannelFlowCallback
s@ChannelFlowCallback' {} Text
a -> ChannelFlowCallback
s {$sel:callbackId:ChannelFlowCallback' :: Text
callbackId = Text
a} :: ChannelFlowCallback)

-- | The ARN of the channel.
channelFlowCallback_channelArn :: Lens.Lens' ChannelFlowCallback Prelude.Text
channelFlowCallback_channelArn :: Lens' ChannelFlowCallback Text
channelFlowCallback_channelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChannelFlowCallback' {Text
channelArn :: Text
$sel:channelArn:ChannelFlowCallback' :: ChannelFlowCallback -> Text
channelArn} -> Text
channelArn) (\s :: ChannelFlowCallback
s@ChannelFlowCallback' {} Text
a -> ChannelFlowCallback
s {$sel:channelArn:ChannelFlowCallback' :: Text
channelArn = Text
a} :: ChannelFlowCallback)

-- | Stores information about the processed message.
channelFlowCallback_channelMessage :: Lens.Lens' ChannelFlowCallback ChannelMessageCallback
channelFlowCallback_channelMessage :: Lens' ChannelFlowCallback ChannelMessageCallback
channelFlowCallback_channelMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChannelFlowCallback' {ChannelMessageCallback
channelMessage :: ChannelMessageCallback
$sel:channelMessage:ChannelFlowCallback' :: ChannelFlowCallback -> ChannelMessageCallback
channelMessage} -> ChannelMessageCallback
channelMessage) (\s :: ChannelFlowCallback
s@ChannelFlowCallback' {} ChannelMessageCallback
a -> ChannelFlowCallback
s {$sel:channelMessage:ChannelFlowCallback' :: ChannelMessageCallback
channelMessage = ChannelMessageCallback
a} :: ChannelFlowCallback)

instance Core.AWSRequest ChannelFlowCallback where
  type
    AWSResponse ChannelFlowCallback =
      ChannelFlowCallbackResponse
  request :: (Service -> Service)
-> ChannelFlowCallback -> Request ChannelFlowCallback
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 ChannelFlowCallback
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ChannelFlowCallback)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Maybe Text -> Int -> ChannelFlowCallbackResponse
ChannelFlowCallbackResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CallbackId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ChannelArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ChannelFlowCallback where
  hashWithSalt :: Int -> ChannelFlowCallback -> Int
hashWithSalt Int
_salt ChannelFlowCallback' {Maybe Bool
Text
ChannelMessageCallback
channelMessage :: ChannelMessageCallback
channelArn :: Text
callbackId :: Text
deleteResource :: Maybe Bool
$sel:channelMessage:ChannelFlowCallback' :: ChannelFlowCallback -> ChannelMessageCallback
$sel:channelArn:ChannelFlowCallback' :: ChannelFlowCallback -> Text
$sel:callbackId:ChannelFlowCallback' :: ChannelFlowCallback -> Text
$sel:deleteResource:ChannelFlowCallback' :: ChannelFlowCallback -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deleteResource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
callbackId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ChannelMessageCallback
channelMessage

instance Prelude.NFData ChannelFlowCallback where
  rnf :: ChannelFlowCallback -> ()
rnf ChannelFlowCallback' {Maybe Bool
Text
ChannelMessageCallback
channelMessage :: ChannelMessageCallback
channelArn :: Text
callbackId :: Text
deleteResource :: Maybe Bool
$sel:channelMessage:ChannelFlowCallback' :: ChannelFlowCallback -> ChannelMessageCallback
$sel:channelArn:ChannelFlowCallback' :: ChannelFlowCallback -> Text
$sel:callbackId:ChannelFlowCallback' :: ChannelFlowCallback -> Text
$sel:deleteResource:ChannelFlowCallback' :: ChannelFlowCallback -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deleteResource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
callbackId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
channelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ChannelMessageCallback
channelMessage

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

instance Data.ToJSON ChannelFlowCallback where
  toJSON :: ChannelFlowCallback -> Value
toJSON ChannelFlowCallback' {Maybe Bool
Text
ChannelMessageCallback
channelMessage :: ChannelMessageCallback
channelArn :: Text
callbackId :: Text
deleteResource :: Maybe Bool
$sel:channelMessage:ChannelFlowCallback' :: ChannelFlowCallback -> ChannelMessageCallback
$sel:channelArn:ChannelFlowCallback' :: ChannelFlowCallback -> Text
$sel:callbackId:ChannelFlowCallback' :: ChannelFlowCallback -> Text
$sel:deleteResource:ChannelFlowCallback' :: ChannelFlowCallback -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DeleteResource" 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 Bool
deleteResource,
            forall a. a -> Maybe a
Prelude.Just (Key
"CallbackId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
callbackId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ChannelMessage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ChannelMessageCallback
channelMessage)
          ]
      )

instance Data.ToPath ChannelFlowCallback where
  toPath :: ChannelFlowCallback -> ByteString
toPath ChannelFlowCallback' {Maybe Bool
Text
ChannelMessageCallback
channelMessage :: ChannelMessageCallback
channelArn :: Text
callbackId :: Text
deleteResource :: Maybe Bool
$sel:channelMessage:ChannelFlowCallback' :: ChannelFlowCallback -> ChannelMessageCallback
$sel:channelArn:ChannelFlowCallback' :: ChannelFlowCallback -> Text
$sel:callbackId:ChannelFlowCallback' :: ChannelFlowCallback -> Text
$sel:deleteResource:ChannelFlowCallback' :: ChannelFlowCallback -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/channels/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
channelArn]

instance Data.ToQuery ChannelFlowCallback where
  toQuery :: ChannelFlowCallback -> QueryString
toQuery =
    forall a b. a -> b -> a
Prelude.const
      (forall a. Monoid a => [a] -> a
Prelude.mconcat [QueryString
"operation=channel-flow-callback"])

-- | /See:/ 'newChannelFlowCallbackResponse' smart constructor.
data ChannelFlowCallbackResponse = ChannelFlowCallbackResponse'
  { -- | The call back ID passed in the request.
    ChannelFlowCallbackResponse -> Maybe Text
callbackId :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the channel.
    ChannelFlowCallbackResponse -> Maybe Text
channelArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ChannelFlowCallbackResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ChannelFlowCallbackResponse -> ChannelFlowCallbackResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelFlowCallbackResponse -> ChannelFlowCallbackResponse -> Bool
$c/= :: ChannelFlowCallbackResponse -> ChannelFlowCallbackResponse -> Bool
== :: ChannelFlowCallbackResponse -> ChannelFlowCallbackResponse -> Bool
$c== :: ChannelFlowCallbackResponse -> ChannelFlowCallbackResponse -> Bool
Prelude.Eq, ReadPrec [ChannelFlowCallbackResponse]
ReadPrec ChannelFlowCallbackResponse
Int -> ReadS ChannelFlowCallbackResponse
ReadS [ChannelFlowCallbackResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelFlowCallbackResponse]
$creadListPrec :: ReadPrec [ChannelFlowCallbackResponse]
readPrec :: ReadPrec ChannelFlowCallbackResponse
$creadPrec :: ReadPrec ChannelFlowCallbackResponse
readList :: ReadS [ChannelFlowCallbackResponse]
$creadList :: ReadS [ChannelFlowCallbackResponse]
readsPrec :: Int -> ReadS ChannelFlowCallbackResponse
$creadsPrec :: Int -> ReadS ChannelFlowCallbackResponse
Prelude.Read, Int -> ChannelFlowCallbackResponse -> ShowS
[ChannelFlowCallbackResponse] -> ShowS
ChannelFlowCallbackResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelFlowCallbackResponse] -> ShowS
$cshowList :: [ChannelFlowCallbackResponse] -> ShowS
show :: ChannelFlowCallbackResponse -> String
$cshow :: ChannelFlowCallbackResponse -> String
showsPrec :: Int -> ChannelFlowCallbackResponse -> ShowS
$cshowsPrec :: Int -> ChannelFlowCallbackResponse -> ShowS
Prelude.Show, forall x.
Rep ChannelFlowCallbackResponse x -> ChannelFlowCallbackResponse
forall x.
ChannelFlowCallbackResponse -> Rep ChannelFlowCallbackResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ChannelFlowCallbackResponse x -> ChannelFlowCallbackResponse
$cfrom :: forall x.
ChannelFlowCallbackResponse -> Rep ChannelFlowCallbackResponse x
Prelude.Generic)

-- |
-- Create a value of 'ChannelFlowCallbackResponse' 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:
--
-- 'callbackId', 'channelFlowCallbackResponse_callbackId' - The call back ID passed in the request.
--
-- 'channelArn', 'channelFlowCallbackResponse_channelArn' - The ARN of the channel.
--
-- 'httpStatus', 'channelFlowCallbackResponse_httpStatus' - The response's http status code.
newChannelFlowCallbackResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ChannelFlowCallbackResponse
newChannelFlowCallbackResponse :: Int -> ChannelFlowCallbackResponse
newChannelFlowCallbackResponse Int
pHttpStatus_ =
  ChannelFlowCallbackResponse'
    { $sel:callbackId:ChannelFlowCallbackResponse' :: Maybe Text
callbackId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:channelArn:ChannelFlowCallbackResponse' :: Maybe Text
channelArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ChannelFlowCallbackResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The call back ID passed in the request.
channelFlowCallbackResponse_callbackId :: Lens.Lens' ChannelFlowCallbackResponse (Prelude.Maybe Prelude.Text)
channelFlowCallbackResponse_callbackId :: Lens' ChannelFlowCallbackResponse (Maybe Text)
channelFlowCallbackResponse_callbackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChannelFlowCallbackResponse' {Maybe Text
callbackId :: Maybe Text
$sel:callbackId:ChannelFlowCallbackResponse' :: ChannelFlowCallbackResponse -> Maybe Text
callbackId} -> Maybe Text
callbackId) (\s :: ChannelFlowCallbackResponse
s@ChannelFlowCallbackResponse' {} Maybe Text
a -> ChannelFlowCallbackResponse
s {$sel:callbackId:ChannelFlowCallbackResponse' :: Maybe Text
callbackId = Maybe Text
a} :: ChannelFlowCallbackResponse)

-- | The ARN of the channel.
channelFlowCallbackResponse_channelArn :: Lens.Lens' ChannelFlowCallbackResponse (Prelude.Maybe Prelude.Text)
channelFlowCallbackResponse_channelArn :: Lens' ChannelFlowCallbackResponse (Maybe Text)
channelFlowCallbackResponse_channelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChannelFlowCallbackResponse' {Maybe Text
channelArn :: Maybe Text
$sel:channelArn:ChannelFlowCallbackResponse' :: ChannelFlowCallbackResponse -> Maybe Text
channelArn} -> Maybe Text
channelArn) (\s :: ChannelFlowCallbackResponse
s@ChannelFlowCallbackResponse' {} Maybe Text
a -> ChannelFlowCallbackResponse
s {$sel:channelArn:ChannelFlowCallbackResponse' :: Maybe Text
channelArn = Maybe Text
a} :: ChannelFlowCallbackResponse)

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

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