{-# 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.SNS.GetEndpointAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the endpoint attributes for a device on one of the supported
-- push notification services, such as GCM (Firebase Cloud Messaging) and
-- APNS. For more information, see
-- <https://docs.aws.amazon.com/sns/latest/dg/SNSMobilePush.html Using Amazon SNS Mobile Push Notifications>.
module Amazonka.SNS.GetEndpointAttributes
  ( -- * Creating a Request
    GetEndpointAttributes (..),
    newGetEndpointAttributes,

    -- * Request Lenses
    getEndpointAttributes_endpointArn,

    -- * Destructuring the Response
    GetEndpointAttributesResponse (..),
    newGetEndpointAttributesResponse,

    -- * Response Lenses
    getEndpointAttributesResponse_attributes,
    getEndpointAttributesResponse_httpStatus,
  )
where

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
import Amazonka.SNS.Types

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

-- |
-- Create a value of 'GetEndpointAttributes' 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:
--
-- 'endpointArn', 'getEndpointAttributes_endpointArn' - EndpointArn for GetEndpointAttributes input.
newGetEndpointAttributes ::
  -- | 'endpointArn'
  Prelude.Text ->
  GetEndpointAttributes
newGetEndpointAttributes :: Text -> GetEndpointAttributes
newGetEndpointAttributes Text
pEndpointArn_ =
  GetEndpointAttributes' {$sel:endpointArn:GetEndpointAttributes' :: Text
endpointArn = Text
pEndpointArn_}

-- | EndpointArn for GetEndpointAttributes input.
getEndpointAttributes_endpointArn :: Lens.Lens' GetEndpointAttributes Prelude.Text
getEndpointAttributes_endpointArn :: Lens' GetEndpointAttributes Text
getEndpointAttributes_endpointArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEndpointAttributes' {Text
endpointArn :: Text
$sel:endpointArn:GetEndpointAttributes' :: GetEndpointAttributes -> Text
endpointArn} -> Text
endpointArn) (\s :: GetEndpointAttributes
s@GetEndpointAttributes' {} Text
a -> GetEndpointAttributes
s {$sel:endpointArn:GetEndpointAttributes' :: Text
endpointArn = Text
a} :: GetEndpointAttributes)

instance Core.AWSRequest GetEndpointAttributes where
  type
    AWSResponse GetEndpointAttributes =
      GetEndpointAttributesResponse
  request :: (Service -> Service)
-> GetEndpointAttributes -> Request GetEndpointAttributes
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetEndpointAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetEndpointAttributes)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetEndpointAttributesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe (HashMap Text Text) -> Int -> GetEndpointAttributesResponse
GetEndpointAttributesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Attributes"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall k v.
(Eq k, Hashable k, FromText k, FromXML v) =>
Text -> Text -> Text -> [Node] -> Either String (HashMap k v)
Data.parseXMLMap Text
"entry" Text
"key" Text
"value")
                        )
            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 GetEndpointAttributes where
  hashWithSalt :: Int -> GetEndpointAttributes -> Int
hashWithSalt Int
_salt GetEndpointAttributes' {Text
endpointArn :: Text
$sel:endpointArn:GetEndpointAttributes' :: GetEndpointAttributes -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointArn

instance Prelude.NFData GetEndpointAttributes where
  rnf :: GetEndpointAttributes -> ()
rnf GetEndpointAttributes' {Text
endpointArn :: Text
$sel:endpointArn:GetEndpointAttributes' :: GetEndpointAttributes -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
endpointArn

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

instance Data.ToPath GetEndpointAttributes where
  toPath :: GetEndpointAttributes -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery GetEndpointAttributes where
  toQuery :: GetEndpointAttributes -> QueryString
toQuery GetEndpointAttributes' {Text
endpointArn :: Text
$sel:endpointArn:GetEndpointAttributes' :: GetEndpointAttributes -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetEndpointAttributes" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-03-31" :: Prelude.ByteString),
        ByteString
"EndpointArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
endpointArn
      ]

-- | Response from GetEndpointAttributes of the EndpointArn.
--
-- /See:/ 'newGetEndpointAttributesResponse' smart constructor.
data GetEndpointAttributesResponse = GetEndpointAttributesResponse'
  { -- | Attributes include the following:
    --
    -- -   @CustomUserData@ – arbitrary user data to associate with the
    --     endpoint. Amazon SNS does not use this data. The data must be in
    --     UTF-8 format and less than 2KB.
    --
    -- -   @Enabled@ – flag that enables\/disables delivery to the endpoint.
    --     Amazon SNS will set this to false when a notification service
    --     indicates to Amazon SNS that the endpoint is invalid. Users can set
    --     it back to true, typically after updating Token.
    --
    -- -   @Token@ – device token, also referred to as a registration id, for
    --     an app and mobile device. This is returned from the notification
    --     service when an app and mobile device are registered with the
    --     notification service.
    --
    --     The device token for the iOS platform is returned in lowercase.
    GetEndpointAttributesResponse -> Maybe (HashMap Text Text)
attributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetEndpointAttributesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetEndpointAttributesResponse
-> GetEndpointAttributesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetEndpointAttributesResponse
-> GetEndpointAttributesResponse -> Bool
$c/= :: GetEndpointAttributesResponse
-> GetEndpointAttributesResponse -> Bool
== :: GetEndpointAttributesResponse
-> GetEndpointAttributesResponse -> Bool
$c== :: GetEndpointAttributesResponse
-> GetEndpointAttributesResponse -> Bool
Prelude.Eq, ReadPrec [GetEndpointAttributesResponse]
ReadPrec GetEndpointAttributesResponse
Int -> ReadS GetEndpointAttributesResponse
ReadS [GetEndpointAttributesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetEndpointAttributesResponse]
$creadListPrec :: ReadPrec [GetEndpointAttributesResponse]
readPrec :: ReadPrec GetEndpointAttributesResponse
$creadPrec :: ReadPrec GetEndpointAttributesResponse
readList :: ReadS [GetEndpointAttributesResponse]
$creadList :: ReadS [GetEndpointAttributesResponse]
readsPrec :: Int -> ReadS GetEndpointAttributesResponse
$creadsPrec :: Int -> ReadS GetEndpointAttributesResponse
Prelude.Read, Int -> GetEndpointAttributesResponse -> ShowS
[GetEndpointAttributesResponse] -> ShowS
GetEndpointAttributesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetEndpointAttributesResponse] -> ShowS
$cshowList :: [GetEndpointAttributesResponse] -> ShowS
show :: GetEndpointAttributesResponse -> String
$cshow :: GetEndpointAttributesResponse -> String
showsPrec :: Int -> GetEndpointAttributesResponse -> ShowS
$cshowsPrec :: Int -> GetEndpointAttributesResponse -> ShowS
Prelude.Show, forall x.
Rep GetEndpointAttributesResponse x
-> GetEndpointAttributesResponse
forall x.
GetEndpointAttributesResponse
-> Rep GetEndpointAttributesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetEndpointAttributesResponse x
-> GetEndpointAttributesResponse
$cfrom :: forall x.
GetEndpointAttributesResponse
-> Rep GetEndpointAttributesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetEndpointAttributesResponse' 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:
--
-- 'attributes', 'getEndpointAttributesResponse_attributes' - Attributes include the following:
--
-- -   @CustomUserData@ – arbitrary user data to associate with the
--     endpoint. Amazon SNS does not use this data. The data must be in
--     UTF-8 format and less than 2KB.
--
-- -   @Enabled@ – flag that enables\/disables delivery to the endpoint.
--     Amazon SNS will set this to false when a notification service
--     indicates to Amazon SNS that the endpoint is invalid. Users can set
--     it back to true, typically after updating Token.
--
-- -   @Token@ – device token, also referred to as a registration id, for
--     an app and mobile device. This is returned from the notification
--     service when an app and mobile device are registered with the
--     notification service.
--
--     The device token for the iOS platform is returned in lowercase.
--
-- 'httpStatus', 'getEndpointAttributesResponse_httpStatus' - The response's http status code.
newGetEndpointAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetEndpointAttributesResponse
newGetEndpointAttributesResponse :: Int -> GetEndpointAttributesResponse
newGetEndpointAttributesResponse Int
pHttpStatus_ =
  GetEndpointAttributesResponse'
    { $sel:attributes:GetEndpointAttributesResponse' :: Maybe (HashMap Text Text)
attributes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetEndpointAttributesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Attributes include the following:
--
-- -   @CustomUserData@ – arbitrary user data to associate with the
--     endpoint. Amazon SNS does not use this data. The data must be in
--     UTF-8 format and less than 2KB.
--
-- -   @Enabled@ – flag that enables\/disables delivery to the endpoint.
--     Amazon SNS will set this to false when a notification service
--     indicates to Amazon SNS that the endpoint is invalid. Users can set
--     it back to true, typically after updating Token.
--
-- -   @Token@ – device token, also referred to as a registration id, for
--     an app and mobile device. This is returned from the notification
--     service when an app and mobile device are registered with the
--     notification service.
--
--     The device token for the iOS platform is returned in lowercase.
getEndpointAttributesResponse_attributes :: Lens.Lens' GetEndpointAttributesResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getEndpointAttributesResponse_attributes :: Lens' GetEndpointAttributesResponse (Maybe (HashMap Text Text))
getEndpointAttributesResponse_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEndpointAttributesResponse' {Maybe (HashMap Text Text)
attributes :: Maybe (HashMap Text Text)
$sel:attributes:GetEndpointAttributesResponse' :: GetEndpointAttributesResponse -> Maybe (HashMap Text Text)
attributes} -> Maybe (HashMap Text Text)
attributes) (\s :: GetEndpointAttributesResponse
s@GetEndpointAttributesResponse' {} Maybe (HashMap Text Text)
a -> GetEndpointAttributesResponse
s {$sel:attributes:GetEndpointAttributesResponse' :: Maybe (HashMap Text Text)
attributes = Maybe (HashMap Text Text)
a} :: GetEndpointAttributesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData GetEndpointAttributesResponse where
  rnf :: GetEndpointAttributesResponse -> ()
rnf GetEndpointAttributesResponse' {Int
Maybe (HashMap Text Text)
httpStatus :: Int
attributes :: Maybe (HashMap Text Text)
$sel:httpStatus:GetEndpointAttributesResponse' :: GetEndpointAttributesResponse -> Int
$sel:attributes:GetEndpointAttributesResponse' :: GetEndpointAttributesResponse -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus