{-# 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.GetApplicationSettings
-- 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 information about the settings for an application.
module Amazonka.Pinpoint.GetApplicationSettings
  ( -- * Creating a Request
    GetApplicationSettings (..),
    newGetApplicationSettings,

    -- * Request Lenses
    getApplicationSettings_applicationId,

    -- * Destructuring the Response
    GetApplicationSettingsResponse (..),
    newGetApplicationSettingsResponse,

    -- * Response Lenses
    getApplicationSettingsResponse_httpStatus,
    getApplicationSettingsResponse_applicationSettingsResource,
  )
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:/ 'newGetApplicationSettings' smart constructor.
data GetApplicationSettings = GetApplicationSettings'
  { -- | The unique identifier for the application. This identifier is displayed
    -- as the __Project ID__ on the Amazon Pinpoint console.
    GetApplicationSettings -> Text
applicationId :: Prelude.Text
  }
  deriving (GetApplicationSettings -> GetApplicationSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApplicationSettings -> GetApplicationSettings -> Bool
$c/= :: GetApplicationSettings -> GetApplicationSettings -> Bool
== :: GetApplicationSettings -> GetApplicationSettings -> Bool
$c== :: GetApplicationSettings -> GetApplicationSettings -> Bool
Prelude.Eq, ReadPrec [GetApplicationSettings]
ReadPrec GetApplicationSettings
Int -> ReadS GetApplicationSettings
ReadS [GetApplicationSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApplicationSettings]
$creadListPrec :: ReadPrec [GetApplicationSettings]
readPrec :: ReadPrec GetApplicationSettings
$creadPrec :: ReadPrec GetApplicationSettings
readList :: ReadS [GetApplicationSettings]
$creadList :: ReadS [GetApplicationSettings]
readsPrec :: Int -> ReadS GetApplicationSettings
$creadsPrec :: Int -> ReadS GetApplicationSettings
Prelude.Read, Int -> GetApplicationSettings -> ShowS
[GetApplicationSettings] -> ShowS
GetApplicationSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApplicationSettings] -> ShowS
$cshowList :: [GetApplicationSettings] -> ShowS
show :: GetApplicationSettings -> String
$cshow :: GetApplicationSettings -> String
showsPrec :: Int -> GetApplicationSettings -> ShowS
$cshowsPrec :: Int -> GetApplicationSettings -> ShowS
Prelude.Show, forall x. Rep GetApplicationSettings x -> GetApplicationSettings
forall x. GetApplicationSettings -> Rep GetApplicationSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApplicationSettings x -> GetApplicationSettings
$cfrom :: forall x. GetApplicationSettings -> Rep GetApplicationSettings x
Prelude.Generic)

-- |
-- Create a value of 'GetApplicationSettings' 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:
--
-- 'applicationId', 'getApplicationSettings_applicationId' - The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
newGetApplicationSettings ::
  -- | 'applicationId'
  Prelude.Text ->
  GetApplicationSettings
newGetApplicationSettings :: Text -> GetApplicationSettings
newGetApplicationSettings Text
pApplicationId_ =
  GetApplicationSettings'
    { $sel:applicationId:GetApplicationSettings' :: Text
applicationId =
        Text
pApplicationId_
    }

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

instance Core.AWSRequest GetApplicationSettings where
  type
    AWSResponse GetApplicationSettings =
      GetApplicationSettingsResponse
  request :: (Service -> Service)
-> GetApplicationSettings -> Request GetApplicationSettings
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetApplicationSettings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetApplicationSettings)))
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
-> ApplicationSettingsResource -> GetApplicationSettingsResponse
GetApplicationSettingsResponse'
            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 GetApplicationSettings where
  hashWithSalt :: Int -> GetApplicationSettings -> Int
hashWithSalt Int
_salt GetApplicationSettings' {Text
applicationId :: Text
$sel:applicationId:GetApplicationSettings' :: GetApplicationSettings -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId

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

instance Data.ToHeaders GetApplicationSettings where
  toHeaders :: GetApplicationSettings -> 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 GetApplicationSettings where
  toPath :: GetApplicationSettings -> ByteString
toPath GetApplicationSettings' {Text
applicationId :: Text
$sel:applicationId:GetApplicationSettings' :: GetApplicationSettings -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/v1/apps/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId, ByteString
"/settings"]

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

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

-- |
-- Create a value of 'GetApplicationSettingsResponse' 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', 'getApplicationSettingsResponse_httpStatus' - The response's http status code.
--
-- 'applicationSettingsResource', 'getApplicationSettingsResponse_applicationSettingsResource' - Undocumented member.
newGetApplicationSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'applicationSettingsResource'
  ApplicationSettingsResource ->
  GetApplicationSettingsResponse
newGetApplicationSettingsResponse :: Int
-> ApplicationSettingsResource -> GetApplicationSettingsResponse
newGetApplicationSettingsResponse
  Int
pHttpStatus_
  ApplicationSettingsResource
pApplicationSettingsResource_ =
    GetApplicationSettingsResponse'
      { $sel:httpStatus:GetApplicationSettingsResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:applicationSettingsResource:GetApplicationSettingsResponse' :: ApplicationSettingsResource
applicationSettingsResource =
          ApplicationSettingsResource
pApplicationSettingsResource_
      }

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

-- | Undocumented member.
getApplicationSettingsResponse_applicationSettingsResource :: Lens.Lens' GetApplicationSettingsResponse ApplicationSettingsResource
getApplicationSettingsResponse_applicationSettingsResource :: Lens' GetApplicationSettingsResponse ApplicationSettingsResource
getApplicationSettingsResponse_applicationSettingsResource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationSettingsResponse' {ApplicationSettingsResource
applicationSettingsResource :: ApplicationSettingsResource
$sel:applicationSettingsResource:GetApplicationSettingsResponse' :: GetApplicationSettingsResponse -> ApplicationSettingsResource
applicationSettingsResource} -> ApplicationSettingsResource
applicationSettingsResource) (\s :: GetApplicationSettingsResponse
s@GetApplicationSettingsResponse' {} ApplicationSettingsResource
a -> GetApplicationSettingsResponse
s {$sel:applicationSettingsResource:GetApplicationSettingsResponse' :: ApplicationSettingsResource
applicationSettingsResource = ApplicationSettingsResource
a} :: GetApplicationSettingsResponse)

instance
  Prelude.NFData
    GetApplicationSettingsResponse
  where
  rnf :: GetApplicationSettingsResponse -> ()
rnf GetApplicationSettingsResponse' {Int
ApplicationSettingsResource
applicationSettingsResource :: ApplicationSettingsResource
httpStatus :: Int
$sel:applicationSettingsResource:GetApplicationSettingsResponse' :: GetApplicationSettingsResponse -> ApplicationSettingsResource
$sel:httpStatus:GetApplicationSettingsResponse' :: GetApplicationSettingsResponse -> 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 ApplicationSettingsResource
applicationSettingsResource