{-# 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.GetAdmChannel
-- 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 status and settings of the ADM channel
-- for an application.
module Amazonka.Pinpoint.GetAdmChannel
  ( -- * Creating a Request
    GetAdmChannel (..),
    newGetAdmChannel,

    -- * Request Lenses
    getAdmChannel_applicationId,

    -- * Destructuring the Response
    GetAdmChannelResponse (..),
    newGetAdmChannelResponse,

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

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

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

instance Core.AWSRequest GetAdmChannel where
  type
    AWSResponse GetAdmChannel =
      GetAdmChannelResponse
  request :: (Service -> Service) -> GetAdmChannel -> Request GetAdmChannel
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 GetAdmChannel
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetAdmChannel)))
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 -> ADMChannelResponse -> GetAdmChannelResponse
GetAdmChannelResponse'
            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 GetAdmChannel where
  hashWithSalt :: Int -> GetAdmChannel -> Int
hashWithSalt Int
_salt GetAdmChannel' {Text
applicationId :: Text
$sel:applicationId:GetAdmChannel' :: GetAdmChannel -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId

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

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

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

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

-- |
-- Create a value of 'GetAdmChannelResponse' 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', 'getAdmChannelResponse_httpStatus' - The response's http status code.
--
-- 'aDMChannelResponse', 'getAdmChannelResponse_aDMChannelResponse' - Undocumented member.
newGetAdmChannelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'aDMChannelResponse'
  ADMChannelResponse ->
  GetAdmChannelResponse
newGetAdmChannelResponse :: Int -> ADMChannelResponse -> GetAdmChannelResponse
newGetAdmChannelResponse
  Int
pHttpStatus_
  ADMChannelResponse
pADMChannelResponse_ =
    GetAdmChannelResponse'
      { $sel:httpStatus:GetAdmChannelResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:aDMChannelResponse:GetAdmChannelResponse' :: ADMChannelResponse
aDMChannelResponse = ADMChannelResponse
pADMChannelResponse_
      }

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

-- | Undocumented member.
getAdmChannelResponse_aDMChannelResponse :: Lens.Lens' GetAdmChannelResponse ADMChannelResponse
getAdmChannelResponse_aDMChannelResponse :: Lens' GetAdmChannelResponse ADMChannelResponse
getAdmChannelResponse_aDMChannelResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAdmChannelResponse' {ADMChannelResponse
aDMChannelResponse :: ADMChannelResponse
$sel:aDMChannelResponse:GetAdmChannelResponse' :: GetAdmChannelResponse -> ADMChannelResponse
aDMChannelResponse} -> ADMChannelResponse
aDMChannelResponse) (\s :: GetAdmChannelResponse
s@GetAdmChannelResponse' {} ADMChannelResponse
a -> GetAdmChannelResponse
s {$sel:aDMChannelResponse:GetAdmChannelResponse' :: ADMChannelResponse
aDMChannelResponse = ADMChannelResponse
a} :: GetAdmChannelResponse)

instance Prelude.NFData GetAdmChannelResponse where
  rnf :: GetAdmChannelResponse -> ()
rnf GetAdmChannelResponse' {Int
ADMChannelResponse
aDMChannelResponse :: ADMChannelResponse
httpStatus :: Int
$sel:aDMChannelResponse:GetAdmChannelResponse' :: GetAdmChannelResponse -> ADMChannelResponse
$sel:httpStatus:GetAdmChannelResponse' :: GetAdmChannelResponse -> 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 ADMChannelResponse
aDMChannelResponse