{-# 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.LexV2Models.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
-- <https://docs.aws.amazon.com/lexv2/latest/dg/API_ListAggregatedUtterances.html ListAggregatedUtterances>
-- 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 utterances for a
-- specific session. 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
-- @ListAggregatedUtterances@ operation are deleted after 15 days.
module Amazonka.LexV2Models.DeleteUtterances
  ( -- * Creating a Request
    DeleteUtterances (..),
    newDeleteUtterances,

    -- * Request Lenses
    deleteUtterances_localeId,
    deleteUtterances_sessionId,
    deleteUtterances_botId,

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

    -- * Response Lenses
    deleteUtterancesResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.LexV2Models.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 identifier of the language and locale where the utterances were
    -- collected. The string must match one of the supported locales. For more
    -- information, see
    -- <https://docs.aws.amazon.com/lexv2/latest/dg/how-languages.html Supported languages>.
    DeleteUtterances -> Maybe Text
localeId :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the session with the user. The ID is returned
    -- in the response from the
    -- <https://docs.aws.amazon.com/lexv2/latest/dg/API_runtime_RecognizeText.html RecognizeText>
    -- and
    -- <https://docs.aws.amazon.com/lexv2/latest/dg/API_runtime_RecognizeUtterance.html RecognizeUtterance>
    -- operations.
    DeleteUtterances -> Maybe Text
sessionId :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the bot that contains the utterances.
    DeleteUtterances -> Text
botId :: 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:
--
-- 'localeId', 'deleteUtterances_localeId' - The identifier of the language and locale where the utterances were
-- collected. The string must match one of the supported locales. For more
-- information, see
-- <https://docs.aws.amazon.com/lexv2/latest/dg/how-languages.html Supported languages>.
--
-- 'sessionId', 'deleteUtterances_sessionId' - The unique identifier of the session with the user. The ID is returned
-- in the response from the
-- <https://docs.aws.amazon.com/lexv2/latest/dg/API_runtime_RecognizeText.html RecognizeText>
-- and
-- <https://docs.aws.amazon.com/lexv2/latest/dg/API_runtime_RecognizeUtterance.html RecognizeUtterance>
-- operations.
--
-- 'botId', 'deleteUtterances_botId' - The unique identifier of the bot that contains the utterances.
newDeleteUtterances ::
  -- | 'botId'
  Prelude.Text ->
  DeleteUtterances
newDeleteUtterances :: Text -> DeleteUtterances
newDeleteUtterances Text
pBotId_ =
  DeleteUtterances'
    { $sel:localeId:DeleteUtterances' :: Maybe Text
localeId = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionId:DeleteUtterances' :: Maybe Text
sessionId = forall a. Maybe a
Prelude.Nothing,
      $sel:botId:DeleteUtterances' :: Text
botId = Text
pBotId_
    }

-- | The identifier of the language and locale where the utterances were
-- collected. The string must match one of the supported locales. For more
-- information, see
-- <https://docs.aws.amazon.com/lexv2/latest/dg/how-languages.html Supported languages>.
deleteUtterances_localeId :: Lens.Lens' DeleteUtterances (Prelude.Maybe Prelude.Text)
deleteUtterances_localeId :: Lens' DeleteUtterances (Maybe Text)
deleteUtterances_localeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteUtterances' {Maybe Text
localeId :: Maybe Text
$sel:localeId:DeleteUtterances' :: DeleteUtterances -> Maybe Text
localeId} -> Maybe Text
localeId) (\s :: DeleteUtterances
s@DeleteUtterances' {} Maybe Text
a -> DeleteUtterances
s {$sel:localeId:DeleteUtterances' :: Maybe Text
localeId = Maybe Text
a} :: DeleteUtterances)

-- | The unique identifier of the session with the user. The ID is returned
-- in the response from the
-- <https://docs.aws.amazon.com/lexv2/latest/dg/API_runtime_RecognizeText.html RecognizeText>
-- and
-- <https://docs.aws.amazon.com/lexv2/latest/dg/API_runtime_RecognizeUtterance.html RecognizeUtterance>
-- operations.
deleteUtterances_sessionId :: Lens.Lens' DeleteUtterances (Prelude.Maybe Prelude.Text)
deleteUtterances_sessionId :: Lens' DeleteUtterances (Maybe Text)
deleteUtterances_sessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteUtterances' {Maybe Text
sessionId :: Maybe Text
$sel:sessionId:DeleteUtterances' :: DeleteUtterances -> Maybe Text
sessionId} -> Maybe Text
sessionId) (\s :: DeleteUtterances
s@DeleteUtterances' {} Maybe Text
a -> DeleteUtterances
s {$sel:sessionId:DeleteUtterances' :: Maybe Text
sessionId = Maybe Text
a} :: DeleteUtterances)

-- | The unique identifier of the bot that contains the utterances.
deleteUtterances_botId :: Lens.Lens' DeleteUtterances Prelude.Text
deleteUtterances_botId :: Lens' DeleteUtterances Text
deleteUtterances_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteUtterances' {Text
botId :: Text
$sel:botId:DeleteUtterances' :: DeleteUtterances -> Text
botId} -> Text
botId) (\s :: DeleteUtterances
s@DeleteUtterances' {} Text
a -> DeleteUtterances
s {$sel:botId:DeleteUtterances' :: Text
botId = 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 =>
(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 -> DeleteUtterancesResponse
DeleteUtterancesResponse'
            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 DeleteUtterances where
  hashWithSalt :: Int -> DeleteUtterances -> Int
hashWithSalt Int
_salt DeleteUtterances' {Maybe Text
Text
botId :: Text
sessionId :: Maybe Text
localeId :: Maybe Text
$sel:botId:DeleteUtterances' :: DeleteUtterances -> Text
$sel:sessionId:DeleteUtterances' :: DeleteUtterances -> Maybe Text
$sel:localeId:DeleteUtterances' :: DeleteUtterances -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
localeId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sessionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botId

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

instance Data.ToHeaders DeleteUtterances where
  toHeaders :: DeleteUtterances -> 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.ToPath DeleteUtterances where
  toPath :: DeleteUtterances -> ByteString
toPath DeleteUtterances' {Maybe Text
Text
botId :: Text
sessionId :: Maybe Text
localeId :: Maybe Text
$sel:botId:DeleteUtterances' :: DeleteUtterances -> Text
$sel:sessionId:DeleteUtterances' :: DeleteUtterances -> Maybe Text
$sel:localeId:DeleteUtterances' :: DeleteUtterances -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/bots/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
botId, ByteString
"/utterances/"]

instance Data.ToQuery DeleteUtterances where
  toQuery :: DeleteUtterances -> QueryString
toQuery DeleteUtterances' {Maybe Text
Text
botId :: Text
sessionId :: Maybe Text
localeId :: Maybe Text
$sel:botId:DeleteUtterances' :: DeleteUtterances -> Text
$sel:sessionId:DeleteUtterances' :: DeleteUtterances -> Maybe Text
$sel:localeId:DeleteUtterances' :: DeleteUtterances -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"localeId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
localeId,
        ByteString
"sessionId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
sessionId
      ]

-- | /See:/ 'newDeleteUtterancesResponse' smart constructor.
data DeleteUtterancesResponse = DeleteUtterancesResponse'
  { -- | The response's http status code.
    DeleteUtterancesResponse -> Int
httpStatus :: Prelude.Int
  }
  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.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'deleteUtterancesResponse_httpStatus' - The response's http status code.
newDeleteUtterancesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteUtterancesResponse
newDeleteUtterancesResponse :: Int -> DeleteUtterancesResponse
newDeleteUtterancesResponse Int
pHttpStatus_ =
  DeleteUtterancesResponse'
    { $sel:httpStatus:DeleteUtterancesResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

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