{-# 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.IoTWireless.GetServiceProfile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about a service profile.
module Amazonka.IoTWireless.GetServiceProfile
  ( -- * Creating a Request
    GetServiceProfile (..),
    newGetServiceProfile,

    -- * Request Lenses
    getServiceProfile_id,

    -- * Destructuring the Response
    GetServiceProfileResponse (..),
    newGetServiceProfileResponse,

    -- * Response Lenses
    getServiceProfileResponse_arn,
    getServiceProfileResponse_id,
    getServiceProfileResponse_loRaWAN,
    getServiceProfileResponse_name,
    getServiceProfileResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetServiceProfile' smart constructor.
data GetServiceProfile = GetServiceProfile'
  { -- | The ID of the resource to get.
    GetServiceProfile -> Text
id :: Prelude.Text
  }
  deriving (GetServiceProfile -> GetServiceProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetServiceProfile -> GetServiceProfile -> Bool
$c/= :: GetServiceProfile -> GetServiceProfile -> Bool
== :: GetServiceProfile -> GetServiceProfile -> Bool
$c== :: GetServiceProfile -> GetServiceProfile -> Bool
Prelude.Eq, ReadPrec [GetServiceProfile]
ReadPrec GetServiceProfile
Int -> ReadS GetServiceProfile
ReadS [GetServiceProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetServiceProfile]
$creadListPrec :: ReadPrec [GetServiceProfile]
readPrec :: ReadPrec GetServiceProfile
$creadPrec :: ReadPrec GetServiceProfile
readList :: ReadS [GetServiceProfile]
$creadList :: ReadS [GetServiceProfile]
readsPrec :: Int -> ReadS GetServiceProfile
$creadsPrec :: Int -> ReadS GetServiceProfile
Prelude.Read, Int -> GetServiceProfile -> ShowS
[GetServiceProfile] -> ShowS
GetServiceProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetServiceProfile] -> ShowS
$cshowList :: [GetServiceProfile] -> ShowS
show :: GetServiceProfile -> String
$cshow :: GetServiceProfile -> String
showsPrec :: Int -> GetServiceProfile -> ShowS
$cshowsPrec :: Int -> GetServiceProfile -> ShowS
Prelude.Show, forall x. Rep GetServiceProfile x -> GetServiceProfile
forall x. GetServiceProfile -> Rep GetServiceProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetServiceProfile x -> GetServiceProfile
$cfrom :: forall x. GetServiceProfile -> Rep GetServiceProfile x
Prelude.Generic)

-- |
-- Create a value of 'GetServiceProfile' 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:
--
-- 'id', 'getServiceProfile_id' - The ID of the resource to get.
newGetServiceProfile ::
  -- | 'id'
  Prelude.Text ->
  GetServiceProfile
newGetServiceProfile :: Text -> GetServiceProfile
newGetServiceProfile Text
pId_ =
  GetServiceProfile' {$sel:id:GetServiceProfile' :: Text
id = Text
pId_}

-- | The ID of the resource to get.
getServiceProfile_id :: Lens.Lens' GetServiceProfile Prelude.Text
getServiceProfile_id :: Lens' GetServiceProfile Text
getServiceProfile_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceProfile' {Text
id :: Text
$sel:id:GetServiceProfile' :: GetServiceProfile -> Text
id} -> Text
id) (\s :: GetServiceProfile
s@GetServiceProfile' {} Text
a -> GetServiceProfile
s {$sel:id:GetServiceProfile' :: Text
id = Text
a} :: GetServiceProfile)

instance Core.AWSRequest GetServiceProfile where
  type
    AWSResponse GetServiceProfile =
      GetServiceProfileResponse
  request :: (Service -> Service)
-> GetServiceProfile -> Request GetServiceProfile
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 GetServiceProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetServiceProfile)))
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 ->
          Maybe Text
-> Maybe Text
-> Maybe LoRaWANGetServiceProfileInfo
-> Maybe Text
-> Int
-> GetServiceProfileResponse
GetServiceProfileResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Id")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LoRaWAN")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Name")
            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 GetServiceProfile where
  hashWithSalt :: Int -> GetServiceProfile -> Int
hashWithSalt Int
_salt GetServiceProfile' {Text
id :: Text
$sel:id:GetServiceProfile' :: GetServiceProfile -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

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

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

instance Data.ToPath GetServiceProfile where
  toPath :: GetServiceProfile -> ByteString
toPath GetServiceProfile' {Text
id :: Text
$sel:id:GetServiceProfile' :: GetServiceProfile -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/service-profiles/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

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

-- | /See:/ 'newGetServiceProfileResponse' smart constructor.
data GetServiceProfileResponse = GetServiceProfileResponse'
  { -- | The Amazon Resource Name of the resource.
    GetServiceProfileResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the service profile.
    GetServiceProfileResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | Information about the service profile.
    GetServiceProfileResponse -> Maybe LoRaWANGetServiceProfileInfo
loRaWAN :: Prelude.Maybe LoRaWANGetServiceProfileInfo,
    -- | The name of the resource.
    GetServiceProfileResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetServiceProfileResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetServiceProfileResponse -> GetServiceProfileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetServiceProfileResponse -> GetServiceProfileResponse -> Bool
$c/= :: GetServiceProfileResponse -> GetServiceProfileResponse -> Bool
== :: GetServiceProfileResponse -> GetServiceProfileResponse -> Bool
$c== :: GetServiceProfileResponse -> GetServiceProfileResponse -> Bool
Prelude.Eq, ReadPrec [GetServiceProfileResponse]
ReadPrec GetServiceProfileResponse
Int -> ReadS GetServiceProfileResponse
ReadS [GetServiceProfileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetServiceProfileResponse]
$creadListPrec :: ReadPrec [GetServiceProfileResponse]
readPrec :: ReadPrec GetServiceProfileResponse
$creadPrec :: ReadPrec GetServiceProfileResponse
readList :: ReadS [GetServiceProfileResponse]
$creadList :: ReadS [GetServiceProfileResponse]
readsPrec :: Int -> ReadS GetServiceProfileResponse
$creadsPrec :: Int -> ReadS GetServiceProfileResponse
Prelude.Read, Int -> GetServiceProfileResponse -> ShowS
[GetServiceProfileResponse] -> ShowS
GetServiceProfileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetServiceProfileResponse] -> ShowS
$cshowList :: [GetServiceProfileResponse] -> ShowS
show :: GetServiceProfileResponse -> String
$cshow :: GetServiceProfileResponse -> String
showsPrec :: Int -> GetServiceProfileResponse -> ShowS
$cshowsPrec :: Int -> GetServiceProfileResponse -> ShowS
Prelude.Show, forall x.
Rep GetServiceProfileResponse x -> GetServiceProfileResponse
forall x.
GetServiceProfileResponse -> Rep GetServiceProfileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetServiceProfileResponse x -> GetServiceProfileResponse
$cfrom :: forall x.
GetServiceProfileResponse -> Rep GetServiceProfileResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetServiceProfileResponse' 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:
--
-- 'arn', 'getServiceProfileResponse_arn' - The Amazon Resource Name of the resource.
--
-- 'id', 'getServiceProfileResponse_id' - The ID of the service profile.
--
-- 'loRaWAN', 'getServiceProfileResponse_loRaWAN' - Information about the service profile.
--
-- 'name', 'getServiceProfileResponse_name' - The name of the resource.
--
-- 'httpStatus', 'getServiceProfileResponse_httpStatus' - The response's http status code.
newGetServiceProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetServiceProfileResponse
newGetServiceProfileResponse :: Int -> GetServiceProfileResponse
newGetServiceProfileResponse Int
pHttpStatus_ =
  GetServiceProfileResponse'
    { $sel:arn:GetServiceProfileResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:id:GetServiceProfileResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:loRaWAN:GetServiceProfileResponse' :: Maybe LoRaWANGetServiceProfileInfo
loRaWAN = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetServiceProfileResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetServiceProfileResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name of the resource.
getServiceProfileResponse_arn :: Lens.Lens' GetServiceProfileResponse (Prelude.Maybe Prelude.Text)
getServiceProfileResponse_arn :: Lens' GetServiceProfileResponse (Maybe Text)
getServiceProfileResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceProfileResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:GetServiceProfileResponse' :: GetServiceProfileResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: GetServiceProfileResponse
s@GetServiceProfileResponse' {} Maybe Text
a -> GetServiceProfileResponse
s {$sel:arn:GetServiceProfileResponse' :: Maybe Text
arn = Maybe Text
a} :: GetServiceProfileResponse)

-- | The ID of the service profile.
getServiceProfileResponse_id :: Lens.Lens' GetServiceProfileResponse (Prelude.Maybe Prelude.Text)
getServiceProfileResponse_id :: Lens' GetServiceProfileResponse (Maybe Text)
getServiceProfileResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceProfileResponse' {Maybe Text
id :: Maybe Text
$sel:id:GetServiceProfileResponse' :: GetServiceProfileResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: GetServiceProfileResponse
s@GetServiceProfileResponse' {} Maybe Text
a -> GetServiceProfileResponse
s {$sel:id:GetServiceProfileResponse' :: Maybe Text
id = Maybe Text
a} :: GetServiceProfileResponse)

-- | Information about the service profile.
getServiceProfileResponse_loRaWAN :: Lens.Lens' GetServiceProfileResponse (Prelude.Maybe LoRaWANGetServiceProfileInfo)
getServiceProfileResponse_loRaWAN :: Lens'
  GetServiceProfileResponse (Maybe LoRaWANGetServiceProfileInfo)
getServiceProfileResponse_loRaWAN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceProfileResponse' {Maybe LoRaWANGetServiceProfileInfo
loRaWAN :: Maybe LoRaWANGetServiceProfileInfo
$sel:loRaWAN:GetServiceProfileResponse' :: GetServiceProfileResponse -> Maybe LoRaWANGetServiceProfileInfo
loRaWAN} -> Maybe LoRaWANGetServiceProfileInfo
loRaWAN) (\s :: GetServiceProfileResponse
s@GetServiceProfileResponse' {} Maybe LoRaWANGetServiceProfileInfo
a -> GetServiceProfileResponse
s {$sel:loRaWAN:GetServiceProfileResponse' :: Maybe LoRaWANGetServiceProfileInfo
loRaWAN = Maybe LoRaWANGetServiceProfileInfo
a} :: GetServiceProfileResponse)

-- | The name of the resource.
getServiceProfileResponse_name :: Lens.Lens' GetServiceProfileResponse (Prelude.Maybe Prelude.Text)
getServiceProfileResponse_name :: Lens' GetServiceProfileResponse (Maybe Text)
getServiceProfileResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceProfileResponse' {Maybe Text
name :: Maybe Text
$sel:name:GetServiceProfileResponse' :: GetServiceProfileResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: GetServiceProfileResponse
s@GetServiceProfileResponse' {} Maybe Text
a -> GetServiceProfileResponse
s {$sel:name:GetServiceProfileResponse' :: Maybe Text
name = Maybe Text
a} :: GetServiceProfileResponse)

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

instance Prelude.NFData GetServiceProfileResponse where
  rnf :: GetServiceProfileResponse -> ()
rnf GetServiceProfileResponse' {Int
Maybe Text
Maybe LoRaWANGetServiceProfileInfo
httpStatus :: Int
name :: Maybe Text
loRaWAN :: Maybe LoRaWANGetServiceProfileInfo
id :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:GetServiceProfileResponse' :: GetServiceProfileResponse -> Int
$sel:name:GetServiceProfileResponse' :: GetServiceProfileResponse -> Maybe Text
$sel:loRaWAN:GetServiceProfileResponse' :: GetServiceProfileResponse -> Maybe LoRaWANGetServiceProfileInfo
$sel:id:GetServiceProfileResponse' :: GetServiceProfileResponse -> Maybe Text
$sel:arn:GetServiceProfileResponse' :: GetServiceProfileResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoRaWANGetServiceProfileInfo
loRaWAN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus