{-# 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.Pinpoint.RemoveAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes one or more attributes, of the same attribute type, from all the
-- endpoints that are associated with an application.
module Amazonka.Pinpoint.RemoveAttributes
  ( -- * Creating a Request
    RemoveAttributes (..),
    newRemoveAttributes,

    -- * Request Lenses
    removeAttributes_attributeType,
    removeAttributes_applicationId,
    removeAttributes_updateAttributesRequest,

    -- * Destructuring the Response
    RemoveAttributesResponse (..),
    newRemoveAttributesResponse,

    -- * Response Lenses
    removeAttributesResponse_httpStatus,
    removeAttributesResponse_attributesResource,
  )
where

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

-- | /See:/ 'newRemoveAttributes' smart constructor.
data RemoveAttributes = RemoveAttributes'
  { -- | The type of attribute or attributes to remove. Valid values are:
    --
    -- -   endpoint-custom-attributes - Custom attributes that describe
    --     endpoints, such as the date when an associated user opted in or out
    --     of receiving communications from you through a specific type of
    --     channel.
    --
    -- -   endpoint-metric-attributes - Custom metrics that your app reports to
    --     Amazon Pinpoint for endpoints, such as the number of app sessions or
    --     the number of items left in a cart.
    --
    -- -   endpoint-user-attributes - Custom attributes that describe users,
    --     such as first name, last name, and age.
    RemoveAttributes -> Text
attributeType :: Prelude.Text,
    -- | The unique identifier for the application. This identifier is displayed
    -- as the __Project ID__ on the Amazon Pinpoint console.
    RemoveAttributes -> Text
applicationId :: Prelude.Text,
    RemoveAttributes -> UpdateAttributesRequest
updateAttributesRequest :: UpdateAttributesRequest
  }
  deriving (RemoveAttributes -> RemoveAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveAttributes -> RemoveAttributes -> Bool
$c/= :: RemoveAttributes -> RemoveAttributes -> Bool
== :: RemoveAttributes -> RemoveAttributes -> Bool
$c== :: RemoveAttributes -> RemoveAttributes -> Bool
Prelude.Eq, ReadPrec [RemoveAttributes]
ReadPrec RemoveAttributes
Int -> ReadS RemoveAttributes
ReadS [RemoveAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoveAttributes]
$creadListPrec :: ReadPrec [RemoveAttributes]
readPrec :: ReadPrec RemoveAttributes
$creadPrec :: ReadPrec RemoveAttributes
readList :: ReadS [RemoveAttributes]
$creadList :: ReadS [RemoveAttributes]
readsPrec :: Int -> ReadS RemoveAttributes
$creadsPrec :: Int -> ReadS RemoveAttributes
Prelude.Read, Int -> RemoveAttributes -> ShowS
[RemoveAttributes] -> ShowS
RemoveAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveAttributes] -> ShowS
$cshowList :: [RemoveAttributes] -> ShowS
show :: RemoveAttributes -> String
$cshow :: RemoveAttributes -> String
showsPrec :: Int -> RemoveAttributes -> ShowS
$cshowsPrec :: Int -> RemoveAttributes -> ShowS
Prelude.Show, forall x. Rep RemoveAttributes x -> RemoveAttributes
forall x. RemoveAttributes -> Rep RemoveAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoveAttributes x -> RemoveAttributes
$cfrom :: forall x. RemoveAttributes -> Rep RemoveAttributes x
Prelude.Generic)

-- |
-- Create a value of 'RemoveAttributes' 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:
--
-- 'attributeType', 'removeAttributes_attributeType' - The type of attribute or attributes to remove. Valid values are:
--
-- -   endpoint-custom-attributes - Custom attributes that describe
--     endpoints, such as the date when an associated user opted in or out
--     of receiving communications from you through a specific type of
--     channel.
--
-- -   endpoint-metric-attributes - Custom metrics that your app reports to
--     Amazon Pinpoint for endpoints, such as the number of app sessions or
--     the number of items left in a cart.
--
-- -   endpoint-user-attributes - Custom attributes that describe users,
--     such as first name, last name, and age.
--
-- 'applicationId', 'removeAttributes_applicationId' - The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
--
-- 'updateAttributesRequest', 'removeAttributes_updateAttributesRequest' - Undocumented member.
newRemoveAttributes ::
  -- | 'attributeType'
  Prelude.Text ->
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'updateAttributesRequest'
  UpdateAttributesRequest ->
  RemoveAttributes
newRemoveAttributes :: Text -> Text -> UpdateAttributesRequest -> RemoveAttributes
newRemoveAttributes
  Text
pAttributeType_
  Text
pApplicationId_
  UpdateAttributesRequest
pUpdateAttributesRequest_ =
    RemoveAttributes'
      { $sel:attributeType:RemoveAttributes' :: Text
attributeType = Text
pAttributeType_,
        $sel:applicationId:RemoveAttributes' :: Text
applicationId = Text
pApplicationId_,
        $sel:updateAttributesRequest:RemoveAttributes' :: UpdateAttributesRequest
updateAttributesRequest = UpdateAttributesRequest
pUpdateAttributesRequest_
      }

-- | The type of attribute or attributes to remove. Valid values are:
--
-- -   endpoint-custom-attributes - Custom attributes that describe
--     endpoints, such as the date when an associated user opted in or out
--     of receiving communications from you through a specific type of
--     channel.
--
-- -   endpoint-metric-attributes - Custom metrics that your app reports to
--     Amazon Pinpoint for endpoints, such as the number of app sessions or
--     the number of items left in a cart.
--
-- -   endpoint-user-attributes - Custom attributes that describe users,
--     such as first name, last name, and age.
removeAttributes_attributeType :: Lens.Lens' RemoveAttributes Prelude.Text
removeAttributes_attributeType :: Lens' RemoveAttributes Text
removeAttributes_attributeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveAttributes' {Text
attributeType :: Text
$sel:attributeType:RemoveAttributes' :: RemoveAttributes -> Text
attributeType} -> Text
attributeType) (\s :: RemoveAttributes
s@RemoveAttributes' {} Text
a -> RemoveAttributes
s {$sel:attributeType:RemoveAttributes' :: Text
attributeType = Text
a} :: RemoveAttributes)

-- | The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
removeAttributes_applicationId :: Lens.Lens' RemoveAttributes Prelude.Text
removeAttributes_applicationId :: Lens' RemoveAttributes Text
removeAttributes_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveAttributes' {Text
applicationId :: Text
$sel:applicationId:RemoveAttributes' :: RemoveAttributes -> Text
applicationId} -> Text
applicationId) (\s :: RemoveAttributes
s@RemoveAttributes' {} Text
a -> RemoveAttributes
s {$sel:applicationId:RemoveAttributes' :: Text
applicationId = Text
a} :: RemoveAttributes)

-- | Undocumented member.
removeAttributes_updateAttributesRequest :: Lens.Lens' RemoveAttributes UpdateAttributesRequest
removeAttributes_updateAttributesRequest :: Lens' RemoveAttributes UpdateAttributesRequest
removeAttributes_updateAttributesRequest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveAttributes' {UpdateAttributesRequest
updateAttributesRequest :: UpdateAttributesRequest
$sel:updateAttributesRequest:RemoveAttributes' :: RemoveAttributes -> UpdateAttributesRequest
updateAttributesRequest} -> UpdateAttributesRequest
updateAttributesRequest) (\s :: RemoveAttributes
s@RemoveAttributes' {} UpdateAttributesRequest
a -> RemoveAttributes
s {$sel:updateAttributesRequest:RemoveAttributes' :: UpdateAttributesRequest
updateAttributesRequest = UpdateAttributesRequest
a} :: RemoveAttributes)

instance Core.AWSRequest RemoveAttributes where
  type
    AWSResponse RemoveAttributes =
      RemoveAttributesResponse
  request :: (Service -> Service)
-> RemoveAttributes -> Request RemoveAttributes
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy RemoveAttributes
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RemoveAttributes)))
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 ->
          Int -> AttributesResource -> RemoveAttributesResponse
RemoveAttributesResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)
      )

instance Prelude.Hashable RemoveAttributes where
  hashWithSalt :: Int -> RemoveAttributes -> Int
hashWithSalt Int
_salt RemoveAttributes' {Text
UpdateAttributesRequest
updateAttributesRequest :: UpdateAttributesRequest
applicationId :: Text
attributeType :: Text
$sel:updateAttributesRequest:RemoveAttributes' :: RemoveAttributes -> UpdateAttributesRequest
$sel:applicationId:RemoveAttributes' :: RemoveAttributes -> Text
$sel:attributeType:RemoveAttributes' :: RemoveAttributes -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
attributeType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UpdateAttributesRequest
updateAttributesRequest

instance Prelude.NFData RemoveAttributes where
  rnf :: RemoveAttributes -> ()
rnf RemoveAttributes' {Text
UpdateAttributesRequest
updateAttributesRequest :: UpdateAttributesRequest
applicationId :: Text
attributeType :: Text
$sel:updateAttributesRequest:RemoveAttributes' :: RemoveAttributes -> UpdateAttributesRequest
$sel:applicationId:RemoveAttributes' :: RemoveAttributes -> Text
$sel:attributeType:RemoveAttributes' :: RemoveAttributes -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
attributeType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UpdateAttributesRequest
updateAttributesRequest

instance Data.ToHeaders RemoveAttributes where
  toHeaders :: RemoveAttributes -> 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.ToJSON RemoveAttributes where
  toJSON :: RemoveAttributes -> Value
toJSON RemoveAttributes' {Text
UpdateAttributesRequest
updateAttributesRequest :: UpdateAttributesRequest
applicationId :: Text
attributeType :: Text
$sel:updateAttributesRequest:RemoveAttributes' :: RemoveAttributes -> UpdateAttributesRequest
$sel:applicationId:RemoveAttributes' :: RemoveAttributes -> Text
$sel:attributeType:RemoveAttributes' :: RemoveAttributes -> Text
..} =
    forall a. ToJSON a => a -> Value
Data.toJSON UpdateAttributesRequest
updateAttributesRequest

instance Data.ToPath RemoveAttributes where
  toPath :: RemoveAttributes -> ByteString
toPath RemoveAttributes' {Text
UpdateAttributesRequest
updateAttributesRequest :: UpdateAttributesRequest
applicationId :: Text
attributeType :: Text
$sel:updateAttributesRequest:RemoveAttributes' :: RemoveAttributes -> UpdateAttributesRequest
$sel:applicationId:RemoveAttributes' :: RemoveAttributes -> Text
$sel:attributeType:RemoveAttributes' :: RemoveAttributes -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/apps/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/attributes/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
attributeType
      ]

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

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

-- |
-- Create a value of 'RemoveAttributesResponse' 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', 'removeAttributesResponse_httpStatus' - The response's http status code.
--
-- 'attributesResource', 'removeAttributesResponse_attributesResource' - Undocumented member.
newRemoveAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'attributesResource'
  AttributesResource ->
  RemoveAttributesResponse
newRemoveAttributesResponse :: Int -> AttributesResource -> RemoveAttributesResponse
newRemoveAttributesResponse
  Int
pHttpStatus_
  AttributesResource
pAttributesResource_ =
    RemoveAttributesResponse'
      { $sel:httpStatus:RemoveAttributesResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:attributesResource:RemoveAttributesResponse' :: AttributesResource
attributesResource = AttributesResource
pAttributesResource_
      }

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

-- | Undocumented member.
removeAttributesResponse_attributesResource :: Lens.Lens' RemoveAttributesResponse AttributesResource
removeAttributesResponse_attributesResource :: Lens' RemoveAttributesResponse AttributesResource
removeAttributesResponse_attributesResource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveAttributesResponse' {AttributesResource
attributesResource :: AttributesResource
$sel:attributesResource:RemoveAttributesResponse' :: RemoveAttributesResponse -> AttributesResource
attributesResource} -> AttributesResource
attributesResource) (\s :: RemoveAttributesResponse
s@RemoveAttributesResponse' {} AttributesResource
a -> RemoveAttributesResponse
s {$sel:attributesResource:RemoveAttributesResponse' :: AttributesResource
attributesResource = AttributesResource
a} :: RemoveAttributesResponse)

instance Prelude.NFData RemoveAttributesResponse where
  rnf :: RemoveAttributesResponse -> ()
rnf RemoveAttributesResponse' {Int
AttributesResource
attributesResource :: AttributesResource
httpStatus :: Int
$sel:attributesResource:RemoveAttributesResponse' :: RemoveAttributesResponse -> AttributesResource
$sel:httpStatus:RemoveAttributesResponse' :: RemoveAttributesResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AttributesResource
attributesResource