{-# 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.GetDeviceProfile
-- 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 device profile.
module Amazonka.IoTWireless.GetDeviceProfile
  ( -- * Creating a Request
    GetDeviceProfile (..),
    newGetDeviceProfile,

    -- * Request Lenses
    getDeviceProfile_id,

    -- * Destructuring the Response
    GetDeviceProfileResponse (..),
    newGetDeviceProfileResponse,

    -- * Response Lenses
    getDeviceProfileResponse_arn,
    getDeviceProfileResponse_id,
    getDeviceProfileResponse_loRaWAN,
    getDeviceProfileResponse_name,
    getDeviceProfileResponse_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:/ 'newGetDeviceProfile' smart constructor.
data GetDeviceProfile = GetDeviceProfile'
  { -- | The ID of the resource to get.
    GetDeviceProfile -> Text
id :: Prelude.Text
  }
  deriving (GetDeviceProfile -> GetDeviceProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDeviceProfile -> GetDeviceProfile -> Bool
$c/= :: GetDeviceProfile -> GetDeviceProfile -> Bool
== :: GetDeviceProfile -> GetDeviceProfile -> Bool
$c== :: GetDeviceProfile -> GetDeviceProfile -> Bool
Prelude.Eq, ReadPrec [GetDeviceProfile]
ReadPrec GetDeviceProfile
Int -> ReadS GetDeviceProfile
ReadS [GetDeviceProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDeviceProfile]
$creadListPrec :: ReadPrec [GetDeviceProfile]
readPrec :: ReadPrec GetDeviceProfile
$creadPrec :: ReadPrec GetDeviceProfile
readList :: ReadS [GetDeviceProfile]
$creadList :: ReadS [GetDeviceProfile]
readsPrec :: Int -> ReadS GetDeviceProfile
$creadsPrec :: Int -> ReadS GetDeviceProfile
Prelude.Read, Int -> GetDeviceProfile -> ShowS
[GetDeviceProfile] -> ShowS
GetDeviceProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDeviceProfile] -> ShowS
$cshowList :: [GetDeviceProfile] -> ShowS
show :: GetDeviceProfile -> String
$cshow :: GetDeviceProfile -> String
showsPrec :: Int -> GetDeviceProfile -> ShowS
$cshowsPrec :: Int -> GetDeviceProfile -> ShowS
Prelude.Show, forall x. Rep GetDeviceProfile x -> GetDeviceProfile
forall x. GetDeviceProfile -> Rep GetDeviceProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDeviceProfile x -> GetDeviceProfile
$cfrom :: forall x. GetDeviceProfile -> Rep GetDeviceProfile x
Prelude.Generic)

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

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

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

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

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

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

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

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

-- |
-- Create a value of 'GetDeviceProfileResponse' 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', 'getDeviceProfileResponse_arn' - The Amazon Resource Name of the resource.
--
-- 'id', 'getDeviceProfileResponse_id' - The ID of the device profile.
--
-- 'loRaWAN', 'getDeviceProfileResponse_loRaWAN' - Information about the device profile.
--
-- 'name', 'getDeviceProfileResponse_name' - The name of the resource.
--
-- 'httpStatus', 'getDeviceProfileResponse_httpStatus' - The response's http status code.
newGetDeviceProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDeviceProfileResponse
newGetDeviceProfileResponse :: Int -> GetDeviceProfileResponse
newGetDeviceProfileResponse Int
pHttpStatus_ =
  GetDeviceProfileResponse'
    { $sel:arn:GetDeviceProfileResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:id:GetDeviceProfileResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:loRaWAN:GetDeviceProfileResponse' :: Maybe LoRaWANDeviceProfile
loRaWAN = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetDeviceProfileResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDeviceProfileResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

-- | Information about the device profile.
getDeviceProfileResponse_loRaWAN :: Lens.Lens' GetDeviceProfileResponse (Prelude.Maybe LoRaWANDeviceProfile)
getDeviceProfileResponse_loRaWAN :: Lens' GetDeviceProfileResponse (Maybe LoRaWANDeviceProfile)
getDeviceProfileResponse_loRaWAN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeviceProfileResponse' {Maybe LoRaWANDeviceProfile
loRaWAN :: Maybe LoRaWANDeviceProfile
$sel:loRaWAN:GetDeviceProfileResponse' :: GetDeviceProfileResponse -> Maybe LoRaWANDeviceProfile
loRaWAN} -> Maybe LoRaWANDeviceProfile
loRaWAN) (\s :: GetDeviceProfileResponse
s@GetDeviceProfileResponse' {} Maybe LoRaWANDeviceProfile
a -> GetDeviceProfileResponse
s {$sel:loRaWAN:GetDeviceProfileResponse' :: Maybe LoRaWANDeviceProfile
loRaWAN = Maybe LoRaWANDeviceProfile
a} :: GetDeviceProfileResponse)

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

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

instance Prelude.NFData GetDeviceProfileResponse where
  rnf :: GetDeviceProfileResponse -> ()
rnf GetDeviceProfileResponse' {Int
Maybe Text
Maybe LoRaWANDeviceProfile
httpStatus :: Int
name :: Maybe Text
loRaWAN :: Maybe LoRaWANDeviceProfile
id :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:GetDeviceProfileResponse' :: GetDeviceProfileResponse -> Int
$sel:name:GetDeviceProfileResponse' :: GetDeviceProfileResponse -> Maybe Text
$sel:loRaWAN:GetDeviceProfileResponse' :: GetDeviceProfileResponse -> Maybe LoRaWANDeviceProfile
$sel:id:GetDeviceProfileResponse' :: GetDeviceProfileResponse -> Maybe Text
$sel:arn:GetDeviceProfileResponse' :: GetDeviceProfileResponse -> 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 LoRaWANDeviceProfile
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