{-# 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.GetServiceEndpoint
-- 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 the account-specific endpoint for Configuration and Update Server
-- (CUPS) protocol or LoRaWAN Network Server (LNS) connections.
module Amazonka.IoTWireless.GetServiceEndpoint
  ( -- * Creating a Request
    GetServiceEndpoint (..),
    newGetServiceEndpoint,

    -- * Request Lenses
    getServiceEndpoint_serviceType,

    -- * Destructuring the Response
    GetServiceEndpointResponse (..),
    newGetServiceEndpointResponse,

    -- * Response Lenses
    getServiceEndpointResponse_serverTrust,
    getServiceEndpointResponse_serviceEndpoint,
    getServiceEndpointResponse_serviceType,
    getServiceEndpointResponse_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:/ 'newGetServiceEndpoint' smart constructor.
data GetServiceEndpoint = GetServiceEndpoint'
  { -- | The service type for which to get endpoint information about. Can be
    -- @CUPS@ for the Configuration and Update Server endpoint, or @LNS@ for
    -- the LoRaWAN Network Server endpoint or @CLAIM@ for the global endpoint.
    GetServiceEndpoint -> Maybe WirelessGatewayServiceType
serviceType :: Prelude.Maybe WirelessGatewayServiceType
  }
  deriving (GetServiceEndpoint -> GetServiceEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetServiceEndpoint -> GetServiceEndpoint -> Bool
$c/= :: GetServiceEndpoint -> GetServiceEndpoint -> Bool
== :: GetServiceEndpoint -> GetServiceEndpoint -> Bool
$c== :: GetServiceEndpoint -> GetServiceEndpoint -> Bool
Prelude.Eq, ReadPrec [GetServiceEndpoint]
ReadPrec GetServiceEndpoint
Int -> ReadS GetServiceEndpoint
ReadS [GetServiceEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetServiceEndpoint]
$creadListPrec :: ReadPrec [GetServiceEndpoint]
readPrec :: ReadPrec GetServiceEndpoint
$creadPrec :: ReadPrec GetServiceEndpoint
readList :: ReadS [GetServiceEndpoint]
$creadList :: ReadS [GetServiceEndpoint]
readsPrec :: Int -> ReadS GetServiceEndpoint
$creadsPrec :: Int -> ReadS GetServiceEndpoint
Prelude.Read, Int -> GetServiceEndpoint -> ShowS
[GetServiceEndpoint] -> ShowS
GetServiceEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetServiceEndpoint] -> ShowS
$cshowList :: [GetServiceEndpoint] -> ShowS
show :: GetServiceEndpoint -> String
$cshow :: GetServiceEndpoint -> String
showsPrec :: Int -> GetServiceEndpoint -> ShowS
$cshowsPrec :: Int -> GetServiceEndpoint -> ShowS
Prelude.Show, forall x. Rep GetServiceEndpoint x -> GetServiceEndpoint
forall x. GetServiceEndpoint -> Rep GetServiceEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetServiceEndpoint x -> GetServiceEndpoint
$cfrom :: forall x. GetServiceEndpoint -> Rep GetServiceEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'GetServiceEndpoint' 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:
--
-- 'serviceType', 'getServiceEndpoint_serviceType' - The service type for which to get endpoint information about. Can be
-- @CUPS@ for the Configuration and Update Server endpoint, or @LNS@ for
-- the LoRaWAN Network Server endpoint or @CLAIM@ for the global endpoint.
newGetServiceEndpoint ::
  GetServiceEndpoint
newGetServiceEndpoint :: GetServiceEndpoint
newGetServiceEndpoint =
  GetServiceEndpoint' {$sel:serviceType:GetServiceEndpoint' :: Maybe WirelessGatewayServiceType
serviceType = forall a. Maybe a
Prelude.Nothing}

-- | The service type for which to get endpoint information about. Can be
-- @CUPS@ for the Configuration and Update Server endpoint, or @LNS@ for
-- the LoRaWAN Network Server endpoint or @CLAIM@ for the global endpoint.
getServiceEndpoint_serviceType :: Lens.Lens' GetServiceEndpoint (Prelude.Maybe WirelessGatewayServiceType)
getServiceEndpoint_serviceType :: Lens' GetServiceEndpoint (Maybe WirelessGatewayServiceType)
getServiceEndpoint_serviceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceEndpoint' {Maybe WirelessGatewayServiceType
serviceType :: Maybe WirelessGatewayServiceType
$sel:serviceType:GetServiceEndpoint' :: GetServiceEndpoint -> Maybe WirelessGatewayServiceType
serviceType} -> Maybe WirelessGatewayServiceType
serviceType) (\s :: GetServiceEndpoint
s@GetServiceEndpoint' {} Maybe WirelessGatewayServiceType
a -> GetServiceEndpoint
s {$sel:serviceType:GetServiceEndpoint' :: Maybe WirelessGatewayServiceType
serviceType = Maybe WirelessGatewayServiceType
a} :: GetServiceEndpoint)

instance Core.AWSRequest GetServiceEndpoint where
  type
    AWSResponse GetServiceEndpoint =
      GetServiceEndpointResponse
  request :: (Service -> Service)
-> GetServiceEndpoint -> Request GetServiceEndpoint
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 GetServiceEndpoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetServiceEndpoint)))
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 WirelessGatewayServiceType
-> Int
-> GetServiceEndpointResponse
GetServiceEndpointResponse'
            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
"ServerTrust")
            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
"ServiceEndpoint")
            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
"ServiceType")
            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 GetServiceEndpoint where
  hashWithSalt :: Int -> GetServiceEndpoint -> Int
hashWithSalt Int
_salt GetServiceEndpoint' {Maybe WirelessGatewayServiceType
serviceType :: Maybe WirelessGatewayServiceType
$sel:serviceType:GetServiceEndpoint' :: GetServiceEndpoint -> Maybe WirelessGatewayServiceType
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WirelessGatewayServiceType
serviceType

instance Prelude.NFData GetServiceEndpoint where
  rnf :: GetServiceEndpoint -> ()
rnf GetServiceEndpoint' {Maybe WirelessGatewayServiceType
serviceType :: Maybe WirelessGatewayServiceType
$sel:serviceType:GetServiceEndpoint' :: GetServiceEndpoint -> Maybe WirelessGatewayServiceType
..} = forall a. NFData a => a -> ()
Prelude.rnf Maybe WirelessGatewayServiceType
serviceType

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

instance Data.ToPath GetServiceEndpoint where
  toPath :: GetServiceEndpoint -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/service-endpoint"

instance Data.ToQuery GetServiceEndpoint where
  toQuery :: GetServiceEndpoint -> QueryString
toQuery GetServiceEndpoint' {Maybe WirelessGatewayServiceType
serviceType :: Maybe WirelessGatewayServiceType
$sel:serviceType:GetServiceEndpoint' :: GetServiceEndpoint -> Maybe WirelessGatewayServiceType
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"serviceType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe WirelessGatewayServiceType
serviceType]

-- | /See:/ 'newGetServiceEndpointResponse' smart constructor.
data GetServiceEndpointResponse = GetServiceEndpointResponse'
  { -- | The Root CA of the server trust certificate.
    GetServiceEndpointResponse -> Maybe Text
serverTrust :: Prelude.Maybe Prelude.Text,
    -- | The service endpoint value.
    GetServiceEndpointResponse -> Maybe Text
serviceEndpoint :: Prelude.Maybe Prelude.Text,
    -- | The endpoint\'s service type.
    GetServiceEndpointResponse -> Maybe WirelessGatewayServiceType
serviceType :: Prelude.Maybe WirelessGatewayServiceType,
    -- | The response's http status code.
    GetServiceEndpointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetServiceEndpointResponse -> GetServiceEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetServiceEndpointResponse -> GetServiceEndpointResponse -> Bool
$c/= :: GetServiceEndpointResponse -> GetServiceEndpointResponse -> Bool
== :: GetServiceEndpointResponse -> GetServiceEndpointResponse -> Bool
$c== :: GetServiceEndpointResponse -> GetServiceEndpointResponse -> Bool
Prelude.Eq, ReadPrec [GetServiceEndpointResponse]
ReadPrec GetServiceEndpointResponse
Int -> ReadS GetServiceEndpointResponse
ReadS [GetServiceEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetServiceEndpointResponse]
$creadListPrec :: ReadPrec [GetServiceEndpointResponse]
readPrec :: ReadPrec GetServiceEndpointResponse
$creadPrec :: ReadPrec GetServiceEndpointResponse
readList :: ReadS [GetServiceEndpointResponse]
$creadList :: ReadS [GetServiceEndpointResponse]
readsPrec :: Int -> ReadS GetServiceEndpointResponse
$creadsPrec :: Int -> ReadS GetServiceEndpointResponse
Prelude.Read, Int -> GetServiceEndpointResponse -> ShowS
[GetServiceEndpointResponse] -> ShowS
GetServiceEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetServiceEndpointResponse] -> ShowS
$cshowList :: [GetServiceEndpointResponse] -> ShowS
show :: GetServiceEndpointResponse -> String
$cshow :: GetServiceEndpointResponse -> String
showsPrec :: Int -> GetServiceEndpointResponse -> ShowS
$cshowsPrec :: Int -> GetServiceEndpointResponse -> ShowS
Prelude.Show, forall x.
Rep GetServiceEndpointResponse x -> GetServiceEndpointResponse
forall x.
GetServiceEndpointResponse -> Rep GetServiceEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetServiceEndpointResponse x -> GetServiceEndpointResponse
$cfrom :: forall x.
GetServiceEndpointResponse -> Rep GetServiceEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetServiceEndpointResponse' 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:
--
-- 'serverTrust', 'getServiceEndpointResponse_serverTrust' - The Root CA of the server trust certificate.
--
-- 'serviceEndpoint', 'getServiceEndpointResponse_serviceEndpoint' - The service endpoint value.
--
-- 'serviceType', 'getServiceEndpointResponse_serviceType' - The endpoint\'s service type.
--
-- 'httpStatus', 'getServiceEndpointResponse_httpStatus' - The response's http status code.
newGetServiceEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetServiceEndpointResponse
newGetServiceEndpointResponse :: Int -> GetServiceEndpointResponse
newGetServiceEndpointResponse Int
pHttpStatus_ =
  GetServiceEndpointResponse'
    { $sel:serverTrust:GetServiceEndpointResponse' :: Maybe Text
serverTrust =
        forall a. Maybe a
Prelude.Nothing,
      $sel:serviceEndpoint:GetServiceEndpointResponse' :: Maybe Text
serviceEndpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceType:GetServiceEndpointResponse' :: Maybe WirelessGatewayServiceType
serviceType = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetServiceEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Root CA of the server trust certificate.
getServiceEndpointResponse_serverTrust :: Lens.Lens' GetServiceEndpointResponse (Prelude.Maybe Prelude.Text)
getServiceEndpointResponse_serverTrust :: Lens' GetServiceEndpointResponse (Maybe Text)
getServiceEndpointResponse_serverTrust = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceEndpointResponse' {Maybe Text
serverTrust :: Maybe Text
$sel:serverTrust:GetServiceEndpointResponse' :: GetServiceEndpointResponse -> Maybe Text
serverTrust} -> Maybe Text
serverTrust) (\s :: GetServiceEndpointResponse
s@GetServiceEndpointResponse' {} Maybe Text
a -> GetServiceEndpointResponse
s {$sel:serverTrust:GetServiceEndpointResponse' :: Maybe Text
serverTrust = Maybe Text
a} :: GetServiceEndpointResponse)

-- | The service endpoint value.
getServiceEndpointResponse_serviceEndpoint :: Lens.Lens' GetServiceEndpointResponse (Prelude.Maybe Prelude.Text)
getServiceEndpointResponse_serviceEndpoint :: Lens' GetServiceEndpointResponse (Maybe Text)
getServiceEndpointResponse_serviceEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceEndpointResponse' {Maybe Text
serviceEndpoint :: Maybe Text
$sel:serviceEndpoint:GetServiceEndpointResponse' :: GetServiceEndpointResponse -> Maybe Text
serviceEndpoint} -> Maybe Text
serviceEndpoint) (\s :: GetServiceEndpointResponse
s@GetServiceEndpointResponse' {} Maybe Text
a -> GetServiceEndpointResponse
s {$sel:serviceEndpoint:GetServiceEndpointResponse' :: Maybe Text
serviceEndpoint = Maybe Text
a} :: GetServiceEndpointResponse)

-- | The endpoint\'s service type.
getServiceEndpointResponse_serviceType :: Lens.Lens' GetServiceEndpointResponse (Prelude.Maybe WirelessGatewayServiceType)
getServiceEndpointResponse_serviceType :: Lens' GetServiceEndpointResponse (Maybe WirelessGatewayServiceType)
getServiceEndpointResponse_serviceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceEndpointResponse' {Maybe WirelessGatewayServiceType
serviceType :: Maybe WirelessGatewayServiceType
$sel:serviceType:GetServiceEndpointResponse' :: GetServiceEndpointResponse -> Maybe WirelessGatewayServiceType
serviceType} -> Maybe WirelessGatewayServiceType
serviceType) (\s :: GetServiceEndpointResponse
s@GetServiceEndpointResponse' {} Maybe WirelessGatewayServiceType
a -> GetServiceEndpointResponse
s {$sel:serviceType:GetServiceEndpointResponse' :: Maybe WirelessGatewayServiceType
serviceType = Maybe WirelessGatewayServiceType
a} :: GetServiceEndpointResponse)

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

instance Prelude.NFData GetServiceEndpointResponse where
  rnf :: GetServiceEndpointResponse -> ()
rnf GetServiceEndpointResponse' {Int
Maybe Text
Maybe WirelessGatewayServiceType
httpStatus :: Int
serviceType :: Maybe WirelessGatewayServiceType
serviceEndpoint :: Maybe Text
serverTrust :: Maybe Text
$sel:httpStatus:GetServiceEndpointResponse' :: GetServiceEndpointResponse -> Int
$sel:serviceType:GetServiceEndpointResponse' :: GetServiceEndpointResponse -> Maybe WirelessGatewayServiceType
$sel:serviceEndpoint:GetServiceEndpointResponse' :: GetServiceEndpointResponse -> Maybe Text
$sel:serverTrust:GetServiceEndpointResponse' :: GetServiceEndpointResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serverTrust
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceEndpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WirelessGatewayServiceType
serviceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus