{-# 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.RedactRoomMessage
-- 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 the specified message from the specified Amazon Chime channel.
module Amazonka.Chime.RedactRoomMessage
  ( -- * Creating a Request
    RedactRoomMessage (..),
    newRedactRoomMessage,

    -- * Request Lenses
    redactRoomMessage_accountId,
    redactRoomMessage_roomId,
    redactRoomMessage_messageId,

    -- * Destructuring the Response
    RedactRoomMessageResponse (..),
    newRedactRoomMessageResponse,

    -- * Response Lenses
    redactRoomMessageResponse_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:/ 'newRedactRoomMessage' smart constructor.
data RedactRoomMessage = RedactRoomMessage'
  { -- | The Amazon Chime account ID.
    RedactRoomMessage -> Text
accountId :: Prelude.Text,
    -- | The room ID.
    RedactRoomMessage -> Text
roomId :: Prelude.Text,
    -- | The message ID.
    RedactRoomMessage -> Text
messageId :: Prelude.Text
  }
  deriving (RedactRoomMessage -> RedactRoomMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedactRoomMessage -> RedactRoomMessage -> Bool
$c/= :: RedactRoomMessage -> RedactRoomMessage -> Bool
== :: RedactRoomMessage -> RedactRoomMessage -> Bool
$c== :: RedactRoomMessage -> RedactRoomMessage -> Bool
Prelude.Eq, ReadPrec [RedactRoomMessage]
ReadPrec RedactRoomMessage
Int -> ReadS RedactRoomMessage
ReadS [RedactRoomMessage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RedactRoomMessage]
$creadListPrec :: ReadPrec [RedactRoomMessage]
readPrec :: ReadPrec RedactRoomMessage
$creadPrec :: ReadPrec RedactRoomMessage
readList :: ReadS [RedactRoomMessage]
$creadList :: ReadS [RedactRoomMessage]
readsPrec :: Int -> ReadS RedactRoomMessage
$creadsPrec :: Int -> ReadS RedactRoomMessage
Prelude.Read, Int -> RedactRoomMessage -> ShowS
[RedactRoomMessage] -> ShowS
RedactRoomMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedactRoomMessage] -> ShowS
$cshowList :: [RedactRoomMessage] -> ShowS
show :: RedactRoomMessage -> String
$cshow :: RedactRoomMessage -> String
showsPrec :: Int -> RedactRoomMessage -> ShowS
$cshowsPrec :: Int -> RedactRoomMessage -> ShowS
Prelude.Show, forall x. Rep RedactRoomMessage x -> RedactRoomMessage
forall x. RedactRoomMessage -> Rep RedactRoomMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RedactRoomMessage x -> RedactRoomMessage
$cfrom :: forall x. RedactRoomMessage -> Rep RedactRoomMessage x
Prelude.Generic)

-- |
-- Create a value of 'RedactRoomMessage' 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:
--
-- 'accountId', 'redactRoomMessage_accountId' - The Amazon Chime account ID.
--
-- 'roomId', 'redactRoomMessage_roomId' - The room ID.
--
-- 'messageId', 'redactRoomMessage_messageId' - The message ID.
newRedactRoomMessage ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'roomId'
  Prelude.Text ->
  -- | 'messageId'
  Prelude.Text ->
  RedactRoomMessage
newRedactRoomMessage :: Text -> Text -> Text -> RedactRoomMessage
newRedactRoomMessage Text
pAccountId_ Text
pRoomId_ Text
pMessageId_ =
  RedactRoomMessage'
    { $sel:accountId:RedactRoomMessage' :: Text
accountId = Text
pAccountId_,
      $sel:roomId:RedactRoomMessage' :: Text
roomId = Text
pRoomId_,
      $sel:messageId:RedactRoomMessage' :: Text
messageId = Text
pMessageId_
    }

-- | The Amazon Chime account ID.
redactRoomMessage_accountId :: Lens.Lens' RedactRoomMessage Prelude.Text
redactRoomMessage_accountId :: Lens' RedactRoomMessage Text
redactRoomMessage_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedactRoomMessage' {Text
accountId :: Text
$sel:accountId:RedactRoomMessage' :: RedactRoomMessage -> Text
accountId} -> Text
accountId) (\s :: RedactRoomMessage
s@RedactRoomMessage' {} Text
a -> RedactRoomMessage
s {$sel:accountId:RedactRoomMessage' :: Text
accountId = Text
a} :: RedactRoomMessage)

-- | The room ID.
redactRoomMessage_roomId :: Lens.Lens' RedactRoomMessage Prelude.Text
redactRoomMessage_roomId :: Lens' RedactRoomMessage Text
redactRoomMessage_roomId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedactRoomMessage' {Text
roomId :: Text
$sel:roomId:RedactRoomMessage' :: RedactRoomMessage -> Text
roomId} -> Text
roomId) (\s :: RedactRoomMessage
s@RedactRoomMessage' {} Text
a -> RedactRoomMessage
s {$sel:roomId:RedactRoomMessage' :: Text
roomId = Text
a} :: RedactRoomMessage)

-- | The message ID.
redactRoomMessage_messageId :: Lens.Lens' RedactRoomMessage Prelude.Text
redactRoomMessage_messageId :: Lens' RedactRoomMessage Text
redactRoomMessage_messageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedactRoomMessage' {Text
messageId :: Text
$sel:messageId:RedactRoomMessage' :: RedactRoomMessage -> Text
messageId} -> Text
messageId) (\s :: RedactRoomMessage
s@RedactRoomMessage' {} Text
a -> RedactRoomMessage
s {$sel:messageId:RedactRoomMessage' :: Text
messageId = Text
a} :: RedactRoomMessage)

instance Core.AWSRequest RedactRoomMessage where
  type
    AWSResponse RedactRoomMessage =
      RedactRoomMessageResponse
  request :: (Service -> Service)
-> RedactRoomMessage -> Request RedactRoomMessage
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 RedactRoomMessage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RedactRoomMessage)))
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 -> RedactRoomMessageResponse
RedactRoomMessageResponse'
            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 RedactRoomMessage where
  hashWithSalt :: Int -> RedactRoomMessage -> Int
hashWithSalt Int
_salt RedactRoomMessage' {Text
messageId :: Text
roomId :: Text
accountId :: Text
$sel:messageId:RedactRoomMessage' :: RedactRoomMessage -> Text
$sel:roomId:RedactRoomMessage' :: RedactRoomMessage -> Text
$sel:accountId:RedactRoomMessage' :: RedactRoomMessage -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roomId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
messageId

instance Prelude.NFData RedactRoomMessage where
  rnf :: RedactRoomMessage -> ()
rnf RedactRoomMessage' {Text
messageId :: Text
roomId :: Text
accountId :: Text
$sel:messageId:RedactRoomMessage' :: RedactRoomMessage -> Text
$sel:roomId:RedactRoomMessage' :: RedactRoomMessage -> Text
$sel:accountId:RedactRoomMessage' :: RedactRoomMessage -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roomId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
messageId

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

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

instance Data.ToPath RedactRoomMessage where
  toPath :: RedactRoomMessage -> ByteString
toPath RedactRoomMessage' {Text
messageId :: Text
roomId :: Text
accountId :: Text
$sel:messageId:RedactRoomMessage' :: RedactRoomMessage -> Text
$sel:roomId:RedactRoomMessage' :: RedactRoomMessage -> Text
$sel:accountId:RedactRoomMessage' :: RedactRoomMessage -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/accounts/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
accountId,
        ByteString
"/rooms/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
roomId,
        ByteString
"/messages/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
messageId
      ]

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

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

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

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

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