{-# 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.GetSmsChannel
-- 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 SMS channel
-- for an application.
module Amazonka.Pinpoint.GetSmsChannel
  ( -- * Creating a Request
    GetSmsChannel (..),
    newGetSmsChannel,

    -- * Request Lenses
    getSmsChannel_applicationId,

    -- * Destructuring the Response
    GetSmsChannelResponse (..),
    newGetSmsChannelResponse,

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

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

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

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

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

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

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

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

-- |
-- Create a value of 'GetSmsChannelResponse' 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', 'getSmsChannelResponse_httpStatus' - The response's http status code.
--
-- 'sMSChannelResponse', 'getSmsChannelResponse_sMSChannelResponse' - Undocumented member.
newGetSmsChannelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'sMSChannelResponse'
  SMSChannelResponse ->
  GetSmsChannelResponse
newGetSmsChannelResponse :: Int -> SMSChannelResponse -> GetSmsChannelResponse
newGetSmsChannelResponse
  Int
pHttpStatus_
  SMSChannelResponse
pSMSChannelResponse_ =
    GetSmsChannelResponse'
      { $sel:httpStatus:GetSmsChannelResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:sMSChannelResponse:GetSmsChannelResponse' :: SMSChannelResponse
sMSChannelResponse = SMSChannelResponse
pSMSChannelResponse_
      }

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

-- | Undocumented member.
getSmsChannelResponse_sMSChannelResponse :: Lens.Lens' GetSmsChannelResponse SMSChannelResponse
getSmsChannelResponse_sMSChannelResponse :: Lens' GetSmsChannelResponse SMSChannelResponse
getSmsChannelResponse_sMSChannelResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSmsChannelResponse' {SMSChannelResponse
sMSChannelResponse :: SMSChannelResponse
$sel:sMSChannelResponse:GetSmsChannelResponse' :: GetSmsChannelResponse -> SMSChannelResponse
sMSChannelResponse} -> SMSChannelResponse
sMSChannelResponse) (\s :: GetSmsChannelResponse
s@GetSmsChannelResponse' {} SMSChannelResponse
a -> GetSmsChannelResponse
s {$sel:sMSChannelResponse:GetSmsChannelResponse' :: SMSChannelResponse
sMSChannelResponse = SMSChannelResponse
a} :: GetSmsChannelResponse)

instance Prelude.NFData GetSmsChannelResponse where
  rnf :: GetSmsChannelResponse -> ()
rnf GetSmsChannelResponse' {Int
SMSChannelResponse
sMSChannelResponse :: SMSChannelResponse
httpStatus :: Int
$sel:sMSChannelResponse:GetSmsChannelResponse' :: GetSmsChannelResponse -> SMSChannelResponse
$sel:httpStatus:GetSmsChannelResponse' :: GetSmsChannelResponse -> 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 SMSChannelResponse
sMSChannelResponse