{-# 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.Chime.RedactChannelMessage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Redacts message content, but not metadata. The message exists in the
-- back end, but the action returns null content, and the state shows as
-- redacted.
--
-- The @x-amz-chime-bearer@ request header is mandatory. Use the
-- @AppInstanceUserArn@ of the user that makes the API call as the value in
-- the header.
module Amazonka.Chime.RedactChannelMessage
  ( -- * Creating a Request
    RedactChannelMessage (..),
    newRedactChannelMessage,

    -- * Request Lenses
    redactChannelMessage_chimeBearer,
    redactChannelMessage_channelArn,
    redactChannelMessage_messageId,

    -- * Destructuring the Response
    RedactChannelMessageResponse (..),
    newRedactChannelMessageResponse,

    -- * Response Lenses
    redactChannelMessageResponse_channelArn,
    redactChannelMessageResponse_messageId,
    redactChannelMessageResponse_httpStatus,
  )
where

import Amazonka.Chime.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:/ 'newRedactChannelMessage' smart constructor.
data RedactChannelMessage = RedactChannelMessage'
  { -- | The @AppInstanceUserArn@ of the user that makes the API call.
    RedactChannelMessage -> Maybe Text
chimeBearer :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the channel containing the messages that you want to redact.
    RedactChannelMessage -> Text
channelArn :: Prelude.Text,
    -- | The ID of the message being redacted.
    RedactChannelMessage -> Text
messageId :: Prelude.Text
  }
  deriving (RedactChannelMessage -> RedactChannelMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedactChannelMessage -> RedactChannelMessage -> Bool
$c/= :: RedactChannelMessage -> RedactChannelMessage -> Bool
== :: RedactChannelMessage -> RedactChannelMessage -> Bool
$c== :: RedactChannelMessage -> RedactChannelMessage -> Bool
Prelude.Eq, ReadPrec [RedactChannelMessage]
ReadPrec RedactChannelMessage
Int -> ReadS RedactChannelMessage
ReadS [RedactChannelMessage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RedactChannelMessage]
$creadListPrec :: ReadPrec [RedactChannelMessage]
readPrec :: ReadPrec RedactChannelMessage
$creadPrec :: ReadPrec RedactChannelMessage
readList :: ReadS [RedactChannelMessage]
$creadList :: ReadS [RedactChannelMessage]
readsPrec :: Int -> ReadS RedactChannelMessage
$creadsPrec :: Int -> ReadS RedactChannelMessage
Prelude.Read, Int -> RedactChannelMessage -> ShowS
[RedactChannelMessage] -> ShowS
RedactChannelMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedactChannelMessage] -> ShowS
$cshowList :: [RedactChannelMessage] -> ShowS
show :: RedactChannelMessage -> String
$cshow :: RedactChannelMessage -> String
showsPrec :: Int -> RedactChannelMessage -> ShowS
$cshowsPrec :: Int -> RedactChannelMessage -> ShowS
Prelude.Show, forall x. Rep RedactChannelMessage x -> RedactChannelMessage
forall x. RedactChannelMessage -> Rep RedactChannelMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RedactChannelMessage x -> RedactChannelMessage
$cfrom :: forall x. RedactChannelMessage -> Rep RedactChannelMessage x
Prelude.Generic)

-- |
-- Create a value of 'RedactChannelMessage' 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:
--
-- 'chimeBearer', 'redactChannelMessage_chimeBearer' - The @AppInstanceUserArn@ of the user that makes the API call.
--
-- 'channelArn', 'redactChannelMessage_channelArn' - The ARN of the channel containing the messages that you want to redact.
--
-- 'messageId', 'redactChannelMessage_messageId' - The ID of the message being redacted.
newRedactChannelMessage ::
  -- | 'channelArn'
  Prelude.Text ->
  -- | 'messageId'
  Prelude.Text ->
  RedactChannelMessage
newRedactChannelMessage :: Text -> Text -> RedactChannelMessage
newRedactChannelMessage Text
pChannelArn_ Text
pMessageId_ =
  RedactChannelMessage'
    { $sel:chimeBearer:RedactChannelMessage' :: Maybe Text
chimeBearer =
        forall a. Maybe a
Prelude.Nothing,
      $sel:channelArn:RedactChannelMessage' :: Text
channelArn = Text
pChannelArn_,
      $sel:messageId:RedactChannelMessage' :: Text
messageId = Text
pMessageId_
    }

-- | The @AppInstanceUserArn@ of the user that makes the API call.
redactChannelMessage_chimeBearer :: Lens.Lens' RedactChannelMessage (Prelude.Maybe Prelude.Text)
redactChannelMessage_chimeBearer :: Lens' RedactChannelMessage (Maybe Text)
redactChannelMessage_chimeBearer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedactChannelMessage' {Maybe Text
chimeBearer :: Maybe Text
$sel:chimeBearer:RedactChannelMessage' :: RedactChannelMessage -> Maybe Text
chimeBearer} -> Maybe Text
chimeBearer) (\s :: RedactChannelMessage
s@RedactChannelMessage' {} Maybe Text
a -> RedactChannelMessage
s {$sel:chimeBearer:RedactChannelMessage' :: Maybe Text
chimeBearer = Maybe Text
a} :: RedactChannelMessage)

-- | The ARN of the channel containing the messages that you want to redact.
redactChannelMessage_channelArn :: Lens.Lens' RedactChannelMessage Prelude.Text
redactChannelMessage_channelArn :: Lens' RedactChannelMessage Text
redactChannelMessage_channelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedactChannelMessage' {Text
channelArn :: Text
$sel:channelArn:RedactChannelMessage' :: RedactChannelMessage -> Text
channelArn} -> Text
channelArn) (\s :: RedactChannelMessage
s@RedactChannelMessage' {} Text
a -> RedactChannelMessage
s {$sel:channelArn:RedactChannelMessage' :: Text
channelArn = Text
a} :: RedactChannelMessage)

-- | The ID of the message being redacted.
redactChannelMessage_messageId :: Lens.Lens' RedactChannelMessage Prelude.Text
redactChannelMessage_messageId :: Lens' RedactChannelMessage Text
redactChannelMessage_messageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedactChannelMessage' {Text
messageId :: Text
$sel:messageId:RedactChannelMessage' :: RedactChannelMessage -> Text
messageId} -> Text
messageId) (\s :: RedactChannelMessage
s@RedactChannelMessage' {} Text
a -> RedactChannelMessage
s {$sel:messageId:RedactChannelMessage' :: Text
messageId = Text
a} :: RedactChannelMessage)

instance Core.AWSRequest RedactChannelMessage where
  type
    AWSResponse RedactChannelMessage =
      RedactChannelMessageResponse
  request :: (Service -> Service)
-> RedactChannelMessage -> Request RedactChannelMessage
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 RedactChannelMessage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RedactChannelMessage)))
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 -> RedactChannelMessageResponse
RedactChannelMessageResponse'
            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
"ChannelArn")
            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
"MessageId")
            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 RedactChannelMessage where
  hashWithSalt :: Int -> RedactChannelMessage -> Int
hashWithSalt Int
_salt RedactChannelMessage' {Maybe Text
Text
messageId :: Text
channelArn :: Text
chimeBearer :: Maybe Text
$sel:messageId:RedactChannelMessage' :: RedactChannelMessage -> Text
$sel:channelArn:RedactChannelMessage' :: RedactChannelMessage -> Text
$sel:chimeBearer:RedactChannelMessage' :: RedactChannelMessage -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
chimeBearer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
messageId

instance Prelude.NFData RedactChannelMessage where
  rnf :: RedactChannelMessage -> ()
rnf RedactChannelMessage' {Maybe Text
Text
messageId :: Text
channelArn :: Text
chimeBearer :: Maybe Text
$sel:messageId:RedactChannelMessage' :: RedactChannelMessage -> Text
$sel:channelArn:RedactChannelMessage' :: RedactChannelMessage -> Text
$sel:chimeBearer:RedactChannelMessage' :: RedactChannelMessage -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
chimeBearer
      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 Text
messageId

instance Data.ToHeaders RedactChannelMessage where
  toHeaders :: RedactChannelMessage -> ResponseHeaders
toHeaders RedactChannelMessage' {Maybe Text
Text
messageId :: Text
channelArn :: Text
chimeBearer :: Maybe Text
$sel:messageId:RedactChannelMessage' :: RedactChannelMessage -> Text
$sel:channelArn:RedactChannelMessage' :: RedactChannelMessage -> Text
$sel:chimeBearer:RedactChannelMessage' :: RedactChannelMessage -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [HeaderName
"x-amz-chime-bearer" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
chimeBearer]

instance Data.ToJSON RedactChannelMessage where
  toJSON :: RedactChannelMessage -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath RedactChannelMessage where
  toPath :: RedactChannelMessage -> ByteString
toPath RedactChannelMessage' {Maybe Text
Text
messageId :: Text
channelArn :: Text
chimeBearer :: Maybe Text
$sel:messageId:RedactChannelMessage' :: RedactChannelMessage -> Text
$sel:channelArn:RedactChannelMessage' :: RedactChannelMessage -> Text
$sel:chimeBearer:RedactChannelMessage' :: RedactChannelMessage -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/channels/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
channelArn,
        ByteString
"/messages/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
messageId
      ]

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

-- | /See:/ 'newRedactChannelMessageResponse' smart constructor.
data RedactChannelMessageResponse = RedactChannelMessageResponse'
  { -- | The ARN of the channel containing the messages that you want to redact.
    RedactChannelMessageResponse -> Maybe Text
channelArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the message being redacted.
    RedactChannelMessageResponse -> Maybe Text
messageId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RedactChannelMessageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RedactChannelMessageResponse
-> RedactChannelMessageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedactChannelMessageResponse
-> RedactChannelMessageResponse -> Bool
$c/= :: RedactChannelMessageResponse
-> RedactChannelMessageResponse -> Bool
== :: RedactChannelMessageResponse
-> RedactChannelMessageResponse -> Bool
$c== :: RedactChannelMessageResponse
-> RedactChannelMessageResponse -> Bool
Prelude.Eq, ReadPrec [RedactChannelMessageResponse]
ReadPrec RedactChannelMessageResponse
Int -> ReadS RedactChannelMessageResponse
ReadS [RedactChannelMessageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RedactChannelMessageResponse]
$creadListPrec :: ReadPrec [RedactChannelMessageResponse]
readPrec :: ReadPrec RedactChannelMessageResponse
$creadPrec :: ReadPrec RedactChannelMessageResponse
readList :: ReadS [RedactChannelMessageResponse]
$creadList :: ReadS [RedactChannelMessageResponse]
readsPrec :: Int -> ReadS RedactChannelMessageResponse
$creadsPrec :: Int -> ReadS RedactChannelMessageResponse
Prelude.Read, Int -> RedactChannelMessageResponse -> ShowS
[RedactChannelMessageResponse] -> ShowS
RedactChannelMessageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedactChannelMessageResponse] -> ShowS
$cshowList :: [RedactChannelMessageResponse] -> ShowS
show :: RedactChannelMessageResponse -> String
$cshow :: RedactChannelMessageResponse -> String
showsPrec :: Int -> RedactChannelMessageResponse -> ShowS
$cshowsPrec :: Int -> RedactChannelMessageResponse -> ShowS
Prelude.Show, forall x.
Rep RedactChannelMessageResponse x -> RedactChannelMessageResponse
forall x.
RedactChannelMessageResponse -> Rep RedactChannelMessageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RedactChannelMessageResponse x -> RedactChannelMessageResponse
$cfrom :: forall x.
RedactChannelMessageResponse -> Rep RedactChannelMessageResponse x
Prelude.Generic)

-- |
-- Create a value of 'RedactChannelMessageResponse' 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:
--
-- 'channelArn', 'redactChannelMessageResponse_channelArn' - The ARN of the channel containing the messages that you want to redact.
--
-- 'messageId', 'redactChannelMessageResponse_messageId' - The ID of the message being redacted.
--
-- 'httpStatus', 'redactChannelMessageResponse_httpStatus' - The response's http status code.
newRedactChannelMessageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RedactChannelMessageResponse
newRedactChannelMessageResponse :: Int -> RedactChannelMessageResponse
newRedactChannelMessageResponse Int
pHttpStatus_ =
  RedactChannelMessageResponse'
    { $sel:channelArn:RedactChannelMessageResponse' :: Maybe Text
channelArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:messageId:RedactChannelMessageResponse' :: Maybe Text
messageId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RedactChannelMessageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the channel containing the messages that you want to redact.
redactChannelMessageResponse_channelArn :: Lens.Lens' RedactChannelMessageResponse (Prelude.Maybe Prelude.Text)
redactChannelMessageResponse_channelArn :: Lens' RedactChannelMessageResponse (Maybe Text)
redactChannelMessageResponse_channelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedactChannelMessageResponse' {Maybe Text
channelArn :: Maybe Text
$sel:channelArn:RedactChannelMessageResponse' :: RedactChannelMessageResponse -> Maybe Text
channelArn} -> Maybe Text
channelArn) (\s :: RedactChannelMessageResponse
s@RedactChannelMessageResponse' {} Maybe Text
a -> RedactChannelMessageResponse
s {$sel:channelArn:RedactChannelMessageResponse' :: Maybe Text
channelArn = Maybe Text
a} :: RedactChannelMessageResponse)

-- | The ID of the message being redacted.
redactChannelMessageResponse_messageId :: Lens.Lens' RedactChannelMessageResponse (Prelude.Maybe Prelude.Text)
redactChannelMessageResponse_messageId :: Lens' RedactChannelMessageResponse (Maybe Text)
redactChannelMessageResponse_messageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedactChannelMessageResponse' {Maybe Text
messageId :: Maybe Text
$sel:messageId:RedactChannelMessageResponse' :: RedactChannelMessageResponse -> Maybe Text
messageId} -> Maybe Text
messageId) (\s :: RedactChannelMessageResponse
s@RedactChannelMessageResponse' {} Maybe Text
a -> RedactChannelMessageResponse
s {$sel:messageId:RedactChannelMessageResponse' :: Maybe Text
messageId = Maybe Text
a} :: RedactChannelMessageResponse)

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

instance Prelude.NFData RedactChannelMessageResponse where
  rnf :: RedactChannelMessageResponse -> ()
rnf RedactChannelMessageResponse' {Int
Maybe Text
httpStatus :: Int
messageId :: Maybe Text
channelArn :: Maybe Text
$sel:httpStatus:RedactChannelMessageResponse' :: RedactChannelMessageResponse -> Int
$sel:messageId:RedactChannelMessageResponse' :: RedactChannelMessageResponse -> Maybe Text
$sel:channelArn:RedactChannelMessageResponse' :: RedactChannelMessageResponse -> Maybe Text
..} =
    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 Maybe Text
messageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus