{-# 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.LexModels.DeleteUtterances
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes stored utterances.
--
-- Amazon Lex stores the utterances that users send to your bot. Utterances
-- are stored for 15 days for use with the GetUtterancesView operation, and
-- then stored indefinitely for use in improving the ability of your bot to
-- respond to user input.
--
-- Use the @DeleteUtterances@ operation to manually delete stored
-- utterances for a specific user. When you use the @DeleteUtterances@
-- operation, utterances stored for improving your bot\'s ability to
-- respond to user input are deleted immediately. Utterances stored for use
-- with the @GetUtterancesView@ operation are deleted after 15 days.
--
-- This operation requires permissions for the @lex:DeleteUtterances@
-- action.
module Amazonka.LexModels.DeleteUtterances
  ( -- * Creating a Request
    DeleteUtterances (..),
    newDeleteUtterances,

    -- * Request Lenses
    deleteUtterances_botName,
    deleteUtterances_userId,

    -- * Destructuring the Response
    DeleteUtterancesResponse (..),
    newDeleteUtterancesResponse,
  )
where

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

-- | /See:/ 'newDeleteUtterances' smart constructor.
data DeleteUtterances = DeleteUtterances'
  { -- | The name of the bot that stored the utterances.
    DeleteUtterances -> Text
botName :: Prelude.Text,
    -- | The unique identifier for the user that made the utterances. This is the
    -- user ID that was sent in the
    -- <http://docs.aws.amazon.com/lex/latest/dg/API_runtime_PostContent.html PostContent>
    -- or
    -- <http://docs.aws.amazon.com/lex/latest/dg/API_runtime_PostText.html PostText>
    -- operation request that contained the utterance.
    DeleteUtterances -> Text
userId :: Prelude.Text
  }
  deriving (DeleteUtterances -> DeleteUtterances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteUtterances -> DeleteUtterances -> Bool
$c/= :: DeleteUtterances -> DeleteUtterances -> Bool
== :: DeleteUtterances -> DeleteUtterances -> Bool
$c== :: DeleteUtterances -> DeleteUtterances -> Bool
Prelude.Eq, ReadPrec [DeleteUtterances]
ReadPrec DeleteUtterances
Int -> ReadS DeleteUtterances
ReadS [DeleteUtterances]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteUtterances]
$creadListPrec :: ReadPrec [DeleteUtterances]
readPrec :: ReadPrec DeleteUtterances
$creadPrec :: ReadPrec DeleteUtterances
readList :: ReadS [DeleteUtterances]
$creadList :: ReadS [DeleteUtterances]
readsPrec :: Int -> ReadS DeleteUtterances
$creadsPrec :: Int -> ReadS DeleteUtterances
Prelude.Read, Int -> DeleteUtterances -> ShowS
[DeleteUtterances] -> ShowS
DeleteUtterances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteUtterances] -> ShowS
$cshowList :: [DeleteUtterances] -> ShowS
show :: DeleteUtterances -> String
$cshow :: DeleteUtterances -> String
showsPrec :: Int -> DeleteUtterances -> ShowS
$cshowsPrec :: Int -> DeleteUtterances -> ShowS
Prelude.Show, forall x. Rep DeleteUtterances x -> DeleteUtterances
forall x. DeleteUtterances -> Rep DeleteUtterances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteUtterances x -> DeleteUtterances
$cfrom :: forall x. DeleteUtterances -> Rep DeleteUtterances x
Prelude.Generic)

-- |
-- Create a value of 'DeleteUtterances' 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:
--
-- 'botName', 'deleteUtterances_botName' - The name of the bot that stored the utterances.
--
-- 'userId', 'deleteUtterances_userId' - The unique identifier for the user that made the utterances. This is the
-- user ID that was sent in the
-- <http://docs.aws.amazon.com/lex/latest/dg/API_runtime_PostContent.html PostContent>
-- or
-- <http://docs.aws.amazon.com/lex/latest/dg/API_runtime_PostText.html PostText>
-- operation request that contained the utterance.
newDeleteUtterances ::
  -- | 'botName'
  Prelude.Text ->
  -- | 'userId'
  Prelude.Text ->
  DeleteUtterances
newDeleteUtterances :: Text -> Text -> DeleteUtterances
newDeleteUtterances Text
pBotName_ Text
pUserId_ =
  DeleteUtterances'
    { $sel:botName:DeleteUtterances' :: Text
botName = Text
pBotName_,
      $sel:userId:DeleteUtterances' :: Text
userId = Text
pUserId_
    }

-- | The name of the bot that stored the utterances.
deleteUtterances_botName :: Lens.Lens' DeleteUtterances Prelude.Text
deleteUtterances_botName :: Lens' DeleteUtterances Text
deleteUtterances_botName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteUtterances' {Text
botName :: Text
$sel:botName:DeleteUtterances' :: DeleteUtterances -> Text
botName} -> Text
botName) (\s :: DeleteUtterances
s@DeleteUtterances' {} Text
a -> DeleteUtterances
s {$sel:botName:DeleteUtterances' :: Text
botName = Text
a} :: DeleteUtterances)

-- | The unique identifier for the user that made the utterances. This is the
-- user ID that was sent in the
-- <http://docs.aws.amazon.com/lex/latest/dg/API_runtime_PostContent.html PostContent>
-- or
-- <http://docs.aws.amazon.com/lex/latest/dg/API_runtime_PostText.html PostText>
-- operation request that contained the utterance.
deleteUtterances_userId :: Lens.Lens' DeleteUtterances Prelude.Text
deleteUtterances_userId :: Lens' DeleteUtterances Text
deleteUtterances_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteUtterances' {Text
userId :: Text
$sel:userId:DeleteUtterances' :: DeleteUtterances -> Text
userId} -> Text
userId) (\s :: DeleteUtterances
s@DeleteUtterances' {} Text
a -> DeleteUtterances
s {$sel:userId:DeleteUtterances' :: Text
userId = Text
a} :: DeleteUtterances)

instance Core.AWSRequest DeleteUtterances where
  type
    AWSResponse DeleteUtterances =
      DeleteUtterancesResponse
  request :: (Service -> Service)
-> DeleteUtterances -> Request DeleteUtterances
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteUtterances
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteUtterances)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteUtterancesResponse
DeleteUtterancesResponse'

instance Prelude.Hashable DeleteUtterances where
  hashWithSalt :: Int -> DeleteUtterances -> Int
hashWithSalt Int
_salt DeleteUtterances' {Text
userId :: Text
botName :: Text
$sel:userId:DeleteUtterances' :: DeleteUtterances -> Text
$sel:botName:DeleteUtterances' :: DeleteUtterances -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userId

instance Prelude.NFData DeleteUtterances where
  rnf :: DeleteUtterances -> ()
rnf DeleteUtterances' {Text
userId :: Text
botName :: Text
$sel:userId:DeleteUtterances' :: DeleteUtterances -> Text
$sel:botName:DeleteUtterances' :: DeleteUtterances -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
botName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userId

instance Data.ToHeaders DeleteUtterances where
  toHeaders :: DeleteUtterances -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DeleteUtterances where
  toPath :: DeleteUtterances -> ByteString
toPath DeleteUtterances' {Text
userId :: Text
botName :: Text
$sel:userId:DeleteUtterances' :: DeleteUtterances -> Text
$sel:botName:DeleteUtterances' :: DeleteUtterances -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/bots/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botName,
        ByteString
"/utterances/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
userId
      ]

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

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

-- |
-- Create a value of 'DeleteUtterancesResponse' 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.
newDeleteUtterancesResponse ::
  DeleteUtterancesResponse
newDeleteUtterancesResponse :: DeleteUtterancesResponse
newDeleteUtterancesResponse =
  DeleteUtterancesResponse
DeleteUtterancesResponse'

instance Prelude.NFData DeleteUtterancesResponse where
  rnf :: DeleteUtterancesResponse -> ()
rnf DeleteUtterancesResponse
_ = ()