{-# 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.GetPartnerAccount
-- 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 partner account. If @PartnerAccountId@ and
-- @PartnerType@ are @null@, returns all partner accounts.
module Amazonka.IoTWireless.GetPartnerAccount
  ( -- * Creating a Request
    GetPartnerAccount (..),
    newGetPartnerAccount,

    -- * Request Lenses
    getPartnerAccount_partnerAccountId,
    getPartnerAccount_partnerType,

    -- * Destructuring the Response
    GetPartnerAccountResponse (..),
    newGetPartnerAccountResponse,

    -- * Response Lenses
    getPartnerAccountResponse_accountLinked,
    getPartnerAccountResponse_sidewalk,
    getPartnerAccountResponse_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:/ 'newGetPartnerAccount' smart constructor.
data GetPartnerAccount = GetPartnerAccount'
  { -- | The partner account ID to disassociate from the AWS account.
    GetPartnerAccount -> Text
partnerAccountId :: Prelude.Text,
    -- | The partner type.
    GetPartnerAccount -> PartnerType
partnerType :: PartnerType
  }
  deriving (GetPartnerAccount -> GetPartnerAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPartnerAccount -> GetPartnerAccount -> Bool
$c/= :: GetPartnerAccount -> GetPartnerAccount -> Bool
== :: GetPartnerAccount -> GetPartnerAccount -> Bool
$c== :: GetPartnerAccount -> GetPartnerAccount -> Bool
Prelude.Eq, ReadPrec [GetPartnerAccount]
ReadPrec GetPartnerAccount
Int -> ReadS GetPartnerAccount
ReadS [GetPartnerAccount]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPartnerAccount]
$creadListPrec :: ReadPrec [GetPartnerAccount]
readPrec :: ReadPrec GetPartnerAccount
$creadPrec :: ReadPrec GetPartnerAccount
readList :: ReadS [GetPartnerAccount]
$creadList :: ReadS [GetPartnerAccount]
readsPrec :: Int -> ReadS GetPartnerAccount
$creadsPrec :: Int -> ReadS GetPartnerAccount
Prelude.Read, Int -> GetPartnerAccount -> ShowS
[GetPartnerAccount] -> ShowS
GetPartnerAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPartnerAccount] -> ShowS
$cshowList :: [GetPartnerAccount] -> ShowS
show :: GetPartnerAccount -> String
$cshow :: GetPartnerAccount -> String
showsPrec :: Int -> GetPartnerAccount -> ShowS
$cshowsPrec :: Int -> GetPartnerAccount -> ShowS
Prelude.Show, forall x. Rep GetPartnerAccount x -> GetPartnerAccount
forall x. GetPartnerAccount -> Rep GetPartnerAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPartnerAccount x -> GetPartnerAccount
$cfrom :: forall x. GetPartnerAccount -> Rep GetPartnerAccount x
Prelude.Generic)

-- |
-- Create a value of 'GetPartnerAccount' 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:
--
-- 'partnerAccountId', 'getPartnerAccount_partnerAccountId' - The partner account ID to disassociate from the AWS account.
--
-- 'partnerType', 'getPartnerAccount_partnerType' - The partner type.
newGetPartnerAccount ::
  -- | 'partnerAccountId'
  Prelude.Text ->
  -- | 'partnerType'
  PartnerType ->
  GetPartnerAccount
newGetPartnerAccount :: Text -> PartnerType -> GetPartnerAccount
newGetPartnerAccount Text
pPartnerAccountId_ PartnerType
pPartnerType_ =
  GetPartnerAccount'
    { $sel:partnerAccountId:GetPartnerAccount' :: Text
partnerAccountId =
        Text
pPartnerAccountId_,
      $sel:partnerType:GetPartnerAccount' :: PartnerType
partnerType = PartnerType
pPartnerType_
    }

-- | The partner account ID to disassociate from the AWS account.
getPartnerAccount_partnerAccountId :: Lens.Lens' GetPartnerAccount Prelude.Text
getPartnerAccount_partnerAccountId :: Lens' GetPartnerAccount Text
getPartnerAccount_partnerAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPartnerAccount' {Text
partnerAccountId :: Text
$sel:partnerAccountId:GetPartnerAccount' :: GetPartnerAccount -> Text
partnerAccountId} -> Text
partnerAccountId) (\s :: GetPartnerAccount
s@GetPartnerAccount' {} Text
a -> GetPartnerAccount
s {$sel:partnerAccountId:GetPartnerAccount' :: Text
partnerAccountId = Text
a} :: GetPartnerAccount)

-- | The partner type.
getPartnerAccount_partnerType :: Lens.Lens' GetPartnerAccount PartnerType
getPartnerAccount_partnerType :: Lens' GetPartnerAccount PartnerType
getPartnerAccount_partnerType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPartnerAccount' {PartnerType
partnerType :: PartnerType
$sel:partnerType:GetPartnerAccount' :: GetPartnerAccount -> PartnerType
partnerType} -> PartnerType
partnerType) (\s :: GetPartnerAccount
s@GetPartnerAccount' {} PartnerType
a -> GetPartnerAccount
s {$sel:partnerType:GetPartnerAccount' :: PartnerType
partnerType = PartnerType
a} :: GetPartnerAccount)

instance Core.AWSRequest GetPartnerAccount where
  type
    AWSResponse GetPartnerAccount =
      GetPartnerAccountResponse
  request :: (Service -> Service)
-> GetPartnerAccount -> Request GetPartnerAccount
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 GetPartnerAccount
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetPartnerAccount)))
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 Bool
-> Maybe SidewalkAccountInfoWithFingerprint
-> Int
-> GetPartnerAccountResponse
GetPartnerAccountResponse'
            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
"AccountLinked")
            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
"Sidewalk")
            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 GetPartnerAccount where
  hashWithSalt :: Int -> GetPartnerAccount -> Int
hashWithSalt Int
_salt GetPartnerAccount' {Text
PartnerType
partnerType :: PartnerType
partnerAccountId :: Text
$sel:partnerType:GetPartnerAccount' :: GetPartnerAccount -> PartnerType
$sel:partnerAccountId:GetPartnerAccount' :: GetPartnerAccount -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
partnerAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PartnerType
partnerType

instance Prelude.NFData GetPartnerAccount where
  rnf :: GetPartnerAccount -> ()
rnf GetPartnerAccount' {Text
PartnerType
partnerType :: PartnerType
partnerAccountId :: Text
$sel:partnerType:GetPartnerAccount' :: GetPartnerAccount -> PartnerType
$sel:partnerAccountId:GetPartnerAccount' :: GetPartnerAccount -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
partnerAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PartnerType
partnerType

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

instance Data.ToPath GetPartnerAccount where
  toPath :: GetPartnerAccount -> ByteString
toPath GetPartnerAccount' {Text
PartnerType
partnerType :: PartnerType
partnerAccountId :: Text
$sel:partnerType:GetPartnerAccount' :: GetPartnerAccount -> PartnerType
$sel:partnerAccountId:GetPartnerAccount' :: GetPartnerAccount -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/partner-accounts/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
partnerAccountId]

instance Data.ToQuery GetPartnerAccount where
  toQuery :: GetPartnerAccount -> QueryString
toQuery GetPartnerAccount' {Text
PartnerType
partnerType :: PartnerType
partnerAccountId :: Text
$sel:partnerType:GetPartnerAccount' :: GetPartnerAccount -> PartnerType
$sel:partnerAccountId:GetPartnerAccount' :: GetPartnerAccount -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"partnerType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: PartnerType
partnerType]

-- | /See:/ 'newGetPartnerAccountResponse' smart constructor.
data GetPartnerAccountResponse = GetPartnerAccountResponse'
  { -- | Whether the partner account is linked to the AWS account.
    GetPartnerAccountResponse -> Maybe Bool
accountLinked :: Prelude.Maybe Prelude.Bool,
    -- | The Sidewalk account credentials.
    GetPartnerAccountResponse
-> Maybe SidewalkAccountInfoWithFingerprint
sidewalk :: Prelude.Maybe SidewalkAccountInfoWithFingerprint,
    -- | The response's http status code.
    GetPartnerAccountResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetPartnerAccountResponse -> GetPartnerAccountResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPartnerAccountResponse -> GetPartnerAccountResponse -> Bool
$c/= :: GetPartnerAccountResponse -> GetPartnerAccountResponse -> Bool
== :: GetPartnerAccountResponse -> GetPartnerAccountResponse -> Bool
$c== :: GetPartnerAccountResponse -> GetPartnerAccountResponse -> Bool
Prelude.Eq, Int -> GetPartnerAccountResponse -> ShowS
[GetPartnerAccountResponse] -> ShowS
GetPartnerAccountResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPartnerAccountResponse] -> ShowS
$cshowList :: [GetPartnerAccountResponse] -> ShowS
show :: GetPartnerAccountResponse -> String
$cshow :: GetPartnerAccountResponse -> String
showsPrec :: Int -> GetPartnerAccountResponse -> ShowS
$cshowsPrec :: Int -> GetPartnerAccountResponse -> ShowS
Prelude.Show, forall x.
Rep GetPartnerAccountResponse x -> GetPartnerAccountResponse
forall x.
GetPartnerAccountResponse -> Rep GetPartnerAccountResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetPartnerAccountResponse x -> GetPartnerAccountResponse
$cfrom :: forall x.
GetPartnerAccountResponse -> Rep GetPartnerAccountResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetPartnerAccountResponse' 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:
--
-- 'accountLinked', 'getPartnerAccountResponse_accountLinked' - Whether the partner account is linked to the AWS account.
--
-- 'sidewalk', 'getPartnerAccountResponse_sidewalk' - The Sidewalk account credentials.
--
-- 'httpStatus', 'getPartnerAccountResponse_httpStatus' - The response's http status code.
newGetPartnerAccountResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetPartnerAccountResponse
newGetPartnerAccountResponse :: Int -> GetPartnerAccountResponse
newGetPartnerAccountResponse Int
pHttpStatus_ =
  GetPartnerAccountResponse'
    { $sel:accountLinked:GetPartnerAccountResponse' :: Maybe Bool
accountLinked =
        forall a. Maybe a
Prelude.Nothing,
      $sel:sidewalk:GetPartnerAccountResponse' :: Maybe SidewalkAccountInfoWithFingerprint
sidewalk = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetPartnerAccountResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Whether the partner account is linked to the AWS account.
getPartnerAccountResponse_accountLinked :: Lens.Lens' GetPartnerAccountResponse (Prelude.Maybe Prelude.Bool)
getPartnerAccountResponse_accountLinked :: Lens' GetPartnerAccountResponse (Maybe Bool)
getPartnerAccountResponse_accountLinked = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPartnerAccountResponse' {Maybe Bool
accountLinked :: Maybe Bool
$sel:accountLinked:GetPartnerAccountResponse' :: GetPartnerAccountResponse -> Maybe Bool
accountLinked} -> Maybe Bool
accountLinked) (\s :: GetPartnerAccountResponse
s@GetPartnerAccountResponse' {} Maybe Bool
a -> GetPartnerAccountResponse
s {$sel:accountLinked:GetPartnerAccountResponse' :: Maybe Bool
accountLinked = Maybe Bool
a} :: GetPartnerAccountResponse)

-- | The Sidewalk account credentials.
getPartnerAccountResponse_sidewalk :: Lens.Lens' GetPartnerAccountResponse (Prelude.Maybe SidewalkAccountInfoWithFingerprint)
getPartnerAccountResponse_sidewalk :: Lens'
  GetPartnerAccountResponse
  (Maybe SidewalkAccountInfoWithFingerprint)
getPartnerAccountResponse_sidewalk = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPartnerAccountResponse' {Maybe SidewalkAccountInfoWithFingerprint
sidewalk :: Maybe SidewalkAccountInfoWithFingerprint
$sel:sidewalk:GetPartnerAccountResponse' :: GetPartnerAccountResponse
-> Maybe SidewalkAccountInfoWithFingerprint
sidewalk} -> Maybe SidewalkAccountInfoWithFingerprint
sidewalk) (\s :: GetPartnerAccountResponse
s@GetPartnerAccountResponse' {} Maybe SidewalkAccountInfoWithFingerprint
a -> GetPartnerAccountResponse
s {$sel:sidewalk:GetPartnerAccountResponse' :: Maybe SidewalkAccountInfoWithFingerprint
sidewalk = Maybe SidewalkAccountInfoWithFingerprint
a} :: GetPartnerAccountResponse)

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

instance Prelude.NFData GetPartnerAccountResponse where
  rnf :: GetPartnerAccountResponse -> ()
rnf GetPartnerAccountResponse' {Int
Maybe Bool
Maybe SidewalkAccountInfoWithFingerprint
httpStatus :: Int
sidewalk :: Maybe SidewalkAccountInfoWithFingerprint
accountLinked :: Maybe Bool
$sel:httpStatus:GetPartnerAccountResponse' :: GetPartnerAccountResponse -> Int
$sel:sidewalk:GetPartnerAccountResponse' :: GetPartnerAccountResponse
-> Maybe SidewalkAccountInfoWithFingerprint
$sel:accountLinked:GetPartnerAccountResponse' :: GetPartnerAccountResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
accountLinked
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SidewalkAccountInfoWithFingerprint
sidewalk
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus