{-# 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.AssociateAwsAccountWithPartnerAccount
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates a partner account with your AWS account.
module Amazonka.IoTWireless.AssociateAwsAccountWithPartnerAccount
  ( -- * Creating a Request
    AssociateAwsAccountWithPartnerAccount (..),
    newAssociateAwsAccountWithPartnerAccount,

    -- * Request Lenses
    associateAwsAccountWithPartnerAccount_clientRequestToken,
    associateAwsAccountWithPartnerAccount_tags,
    associateAwsAccountWithPartnerAccount_sidewalk,

    -- * Destructuring the Response
    AssociateAwsAccountWithPartnerAccountResponse (..),
    newAssociateAwsAccountWithPartnerAccountResponse,

    -- * Response Lenses
    associateAwsAccountWithPartnerAccountResponse_arn,
    associateAwsAccountWithPartnerAccountResponse_sidewalk,
    associateAwsAccountWithPartnerAccountResponse_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:/ 'newAssociateAwsAccountWithPartnerAccount' smart constructor.
data AssociateAwsAccountWithPartnerAccount = AssociateAwsAccountWithPartnerAccount'
  { -- | Each resource must have a unique client request token. If you try to
    -- create a new resource with the same token as a resource that already
    -- exists, an exception occurs. If you omit this value, AWS SDKs will
    -- automatically generate a unique client request.
    AssociateAwsAccountWithPartnerAccount -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The tags to attach to the specified resource. Tags are metadata that you
    -- can use to manage a resource.
    AssociateAwsAccountWithPartnerAccount -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The Sidewalk account credentials.
    AssociateAwsAccountWithPartnerAccount -> SidewalkAccountInfo
sidewalk :: SidewalkAccountInfo
  }
  deriving (AssociateAwsAccountWithPartnerAccount
-> AssociateAwsAccountWithPartnerAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateAwsAccountWithPartnerAccount
-> AssociateAwsAccountWithPartnerAccount -> Bool
$c/= :: AssociateAwsAccountWithPartnerAccount
-> AssociateAwsAccountWithPartnerAccount -> Bool
== :: AssociateAwsAccountWithPartnerAccount
-> AssociateAwsAccountWithPartnerAccount -> Bool
$c== :: AssociateAwsAccountWithPartnerAccount
-> AssociateAwsAccountWithPartnerAccount -> Bool
Prelude.Eq, Int -> AssociateAwsAccountWithPartnerAccount -> ShowS
[AssociateAwsAccountWithPartnerAccount] -> ShowS
AssociateAwsAccountWithPartnerAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateAwsAccountWithPartnerAccount] -> ShowS
$cshowList :: [AssociateAwsAccountWithPartnerAccount] -> ShowS
show :: AssociateAwsAccountWithPartnerAccount -> String
$cshow :: AssociateAwsAccountWithPartnerAccount -> String
showsPrec :: Int -> AssociateAwsAccountWithPartnerAccount -> ShowS
$cshowsPrec :: Int -> AssociateAwsAccountWithPartnerAccount -> ShowS
Prelude.Show, forall x.
Rep AssociateAwsAccountWithPartnerAccount x
-> AssociateAwsAccountWithPartnerAccount
forall x.
AssociateAwsAccountWithPartnerAccount
-> Rep AssociateAwsAccountWithPartnerAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateAwsAccountWithPartnerAccount x
-> AssociateAwsAccountWithPartnerAccount
$cfrom :: forall x.
AssociateAwsAccountWithPartnerAccount
-> Rep AssociateAwsAccountWithPartnerAccount x
Prelude.Generic)

-- |
-- Create a value of 'AssociateAwsAccountWithPartnerAccount' 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:
--
-- 'clientRequestToken', 'associateAwsAccountWithPartnerAccount_clientRequestToken' - Each resource must have a unique client request token. If you try to
-- create a new resource with the same token as a resource that already
-- exists, an exception occurs. If you omit this value, AWS SDKs will
-- automatically generate a unique client request.
--
-- 'tags', 'associateAwsAccountWithPartnerAccount_tags' - The tags to attach to the specified resource. Tags are metadata that you
-- can use to manage a resource.
--
-- 'sidewalk', 'associateAwsAccountWithPartnerAccount_sidewalk' - The Sidewalk account credentials.
newAssociateAwsAccountWithPartnerAccount ::
  -- | 'sidewalk'
  SidewalkAccountInfo ->
  AssociateAwsAccountWithPartnerAccount
newAssociateAwsAccountWithPartnerAccount :: SidewalkAccountInfo -> AssociateAwsAccountWithPartnerAccount
newAssociateAwsAccountWithPartnerAccount SidewalkAccountInfo
pSidewalk_ =
  AssociateAwsAccountWithPartnerAccount'
    { $sel:clientRequestToken:AssociateAwsAccountWithPartnerAccount' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tags:AssociateAwsAccountWithPartnerAccount' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:sidewalk:AssociateAwsAccountWithPartnerAccount' :: SidewalkAccountInfo
sidewalk = SidewalkAccountInfo
pSidewalk_
    }

-- | Each resource must have a unique client request token. If you try to
-- create a new resource with the same token as a resource that already
-- exists, an exception occurs. If you omit this value, AWS SDKs will
-- automatically generate a unique client request.
associateAwsAccountWithPartnerAccount_clientRequestToken :: Lens.Lens' AssociateAwsAccountWithPartnerAccount (Prelude.Maybe Prelude.Text)
associateAwsAccountWithPartnerAccount_clientRequestToken :: Lens' AssociateAwsAccountWithPartnerAccount (Maybe Text)
associateAwsAccountWithPartnerAccount_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateAwsAccountWithPartnerAccount' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:AssociateAwsAccountWithPartnerAccount' :: AssociateAwsAccountWithPartnerAccount -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: AssociateAwsAccountWithPartnerAccount
s@AssociateAwsAccountWithPartnerAccount' {} Maybe Text
a -> AssociateAwsAccountWithPartnerAccount
s {$sel:clientRequestToken:AssociateAwsAccountWithPartnerAccount' :: Maybe Text
clientRequestToken = Maybe Text
a} :: AssociateAwsAccountWithPartnerAccount)

-- | The tags to attach to the specified resource. Tags are metadata that you
-- can use to manage a resource.
associateAwsAccountWithPartnerAccount_tags :: Lens.Lens' AssociateAwsAccountWithPartnerAccount (Prelude.Maybe [Tag])
associateAwsAccountWithPartnerAccount_tags :: Lens' AssociateAwsAccountWithPartnerAccount (Maybe [Tag])
associateAwsAccountWithPartnerAccount_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateAwsAccountWithPartnerAccount' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:AssociateAwsAccountWithPartnerAccount' :: AssociateAwsAccountWithPartnerAccount -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: AssociateAwsAccountWithPartnerAccount
s@AssociateAwsAccountWithPartnerAccount' {} Maybe [Tag]
a -> AssociateAwsAccountWithPartnerAccount
s {$sel:tags:AssociateAwsAccountWithPartnerAccount' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: AssociateAwsAccountWithPartnerAccount) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Sidewalk account credentials.
associateAwsAccountWithPartnerAccount_sidewalk :: Lens.Lens' AssociateAwsAccountWithPartnerAccount SidewalkAccountInfo
associateAwsAccountWithPartnerAccount_sidewalk :: Lens' AssociateAwsAccountWithPartnerAccount SidewalkAccountInfo
associateAwsAccountWithPartnerAccount_sidewalk = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateAwsAccountWithPartnerAccount' {SidewalkAccountInfo
sidewalk :: SidewalkAccountInfo
$sel:sidewalk:AssociateAwsAccountWithPartnerAccount' :: AssociateAwsAccountWithPartnerAccount -> SidewalkAccountInfo
sidewalk} -> SidewalkAccountInfo
sidewalk) (\s :: AssociateAwsAccountWithPartnerAccount
s@AssociateAwsAccountWithPartnerAccount' {} SidewalkAccountInfo
a -> AssociateAwsAccountWithPartnerAccount
s {$sel:sidewalk:AssociateAwsAccountWithPartnerAccount' :: SidewalkAccountInfo
sidewalk = SidewalkAccountInfo
a} :: AssociateAwsAccountWithPartnerAccount)

instance
  Core.AWSRequest
    AssociateAwsAccountWithPartnerAccount
  where
  type
    AWSResponse
      AssociateAwsAccountWithPartnerAccount =
      AssociateAwsAccountWithPartnerAccountResponse
  request :: (Service -> Service)
-> AssociateAwsAccountWithPartnerAccount
-> Request AssociateAwsAccountWithPartnerAccount
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy AssociateAwsAccountWithPartnerAccount
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse AssociateAwsAccountWithPartnerAccount)))
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 SidewalkAccountInfo
-> Int
-> AssociateAwsAccountWithPartnerAccountResponse
AssociateAwsAccountWithPartnerAccountResponse'
            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
"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
    AssociateAwsAccountWithPartnerAccount
  where
  hashWithSalt :: Int -> AssociateAwsAccountWithPartnerAccount -> Int
hashWithSalt
    Int
_salt
    AssociateAwsAccountWithPartnerAccount' {Maybe [Tag]
Maybe Text
SidewalkAccountInfo
sidewalk :: SidewalkAccountInfo
tags :: Maybe [Tag]
clientRequestToken :: Maybe Text
$sel:sidewalk:AssociateAwsAccountWithPartnerAccount' :: AssociateAwsAccountWithPartnerAccount -> SidewalkAccountInfo
$sel:tags:AssociateAwsAccountWithPartnerAccount' :: AssociateAwsAccountWithPartnerAccount -> Maybe [Tag]
$sel:clientRequestToken:AssociateAwsAccountWithPartnerAccount' :: AssociateAwsAccountWithPartnerAccount -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SidewalkAccountInfo
sidewalk

instance
  Prelude.NFData
    AssociateAwsAccountWithPartnerAccount
  where
  rnf :: AssociateAwsAccountWithPartnerAccount -> ()
rnf AssociateAwsAccountWithPartnerAccount' {Maybe [Tag]
Maybe Text
SidewalkAccountInfo
sidewalk :: SidewalkAccountInfo
tags :: Maybe [Tag]
clientRequestToken :: Maybe Text
$sel:sidewalk:AssociateAwsAccountWithPartnerAccount' :: AssociateAwsAccountWithPartnerAccount -> SidewalkAccountInfo
$sel:tags:AssociateAwsAccountWithPartnerAccount' :: AssociateAwsAccountWithPartnerAccount -> Maybe [Tag]
$sel:clientRequestToken:AssociateAwsAccountWithPartnerAccount' :: AssociateAwsAccountWithPartnerAccount -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SidewalkAccountInfo
sidewalk

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

instance
  Data.ToJSON
    AssociateAwsAccountWithPartnerAccount
  where
  toJSON :: AssociateAwsAccountWithPartnerAccount -> Value
toJSON AssociateAwsAccountWithPartnerAccount' {Maybe [Tag]
Maybe Text
SidewalkAccountInfo
sidewalk :: SidewalkAccountInfo
tags :: Maybe [Tag]
clientRequestToken :: Maybe Text
$sel:sidewalk:AssociateAwsAccountWithPartnerAccount' :: AssociateAwsAccountWithPartnerAccount -> SidewalkAccountInfo
$sel:tags:AssociateAwsAccountWithPartnerAccount' :: AssociateAwsAccountWithPartnerAccount -> Maybe [Tag]
$sel:clientRequestToken:AssociateAwsAccountWithPartnerAccount' :: AssociateAwsAccountWithPartnerAccount -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientRequestToken,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Sidewalk" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SidewalkAccountInfo
sidewalk)
          ]
      )

instance
  Data.ToPath
    AssociateAwsAccountWithPartnerAccount
  where
  toPath :: AssociateAwsAccountWithPartnerAccount -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/partner-accounts"

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

-- | /See:/ 'newAssociateAwsAccountWithPartnerAccountResponse' smart constructor.
data AssociateAwsAccountWithPartnerAccountResponse = AssociateAwsAccountWithPartnerAccountResponse'
  { -- | The Amazon Resource Name of the resource.
    AssociateAwsAccountWithPartnerAccountResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The Sidewalk account credentials.
    AssociateAwsAccountWithPartnerAccountResponse
-> Maybe SidewalkAccountInfo
sidewalk :: Prelude.Maybe SidewalkAccountInfo,
    -- | The response's http status code.
    AssociateAwsAccountWithPartnerAccountResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AssociateAwsAccountWithPartnerAccountResponse
-> AssociateAwsAccountWithPartnerAccountResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateAwsAccountWithPartnerAccountResponse
-> AssociateAwsAccountWithPartnerAccountResponse -> Bool
$c/= :: AssociateAwsAccountWithPartnerAccountResponse
-> AssociateAwsAccountWithPartnerAccountResponse -> Bool
== :: AssociateAwsAccountWithPartnerAccountResponse
-> AssociateAwsAccountWithPartnerAccountResponse -> Bool
$c== :: AssociateAwsAccountWithPartnerAccountResponse
-> AssociateAwsAccountWithPartnerAccountResponse -> Bool
Prelude.Eq, Int -> AssociateAwsAccountWithPartnerAccountResponse -> ShowS
[AssociateAwsAccountWithPartnerAccountResponse] -> ShowS
AssociateAwsAccountWithPartnerAccountResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateAwsAccountWithPartnerAccountResponse] -> ShowS
$cshowList :: [AssociateAwsAccountWithPartnerAccountResponse] -> ShowS
show :: AssociateAwsAccountWithPartnerAccountResponse -> String
$cshow :: AssociateAwsAccountWithPartnerAccountResponse -> String
showsPrec :: Int -> AssociateAwsAccountWithPartnerAccountResponse -> ShowS
$cshowsPrec :: Int -> AssociateAwsAccountWithPartnerAccountResponse -> ShowS
Prelude.Show, forall x.
Rep AssociateAwsAccountWithPartnerAccountResponse x
-> AssociateAwsAccountWithPartnerAccountResponse
forall x.
AssociateAwsAccountWithPartnerAccountResponse
-> Rep AssociateAwsAccountWithPartnerAccountResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateAwsAccountWithPartnerAccountResponse x
-> AssociateAwsAccountWithPartnerAccountResponse
$cfrom :: forall x.
AssociateAwsAccountWithPartnerAccountResponse
-> Rep AssociateAwsAccountWithPartnerAccountResponse x
Prelude.Generic)

-- |
-- Create a value of 'AssociateAwsAccountWithPartnerAccountResponse' 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', 'associateAwsAccountWithPartnerAccountResponse_arn' - The Amazon Resource Name of the resource.
--
-- 'sidewalk', 'associateAwsAccountWithPartnerAccountResponse_sidewalk' - The Sidewalk account credentials.
--
-- 'httpStatus', 'associateAwsAccountWithPartnerAccountResponse_httpStatus' - The response's http status code.
newAssociateAwsAccountWithPartnerAccountResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateAwsAccountWithPartnerAccountResponse
newAssociateAwsAccountWithPartnerAccountResponse :: Int -> AssociateAwsAccountWithPartnerAccountResponse
newAssociateAwsAccountWithPartnerAccountResponse
  Int
pHttpStatus_ =
    AssociateAwsAccountWithPartnerAccountResponse'
      { $sel:arn:AssociateAwsAccountWithPartnerAccountResponse' :: Maybe Text
arn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sidewalk:AssociateAwsAccountWithPartnerAccountResponse' :: Maybe SidewalkAccountInfo
sidewalk = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:AssociateAwsAccountWithPartnerAccountResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

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

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

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

instance
  Prelude.NFData
    AssociateAwsAccountWithPartnerAccountResponse
  where
  rnf :: AssociateAwsAccountWithPartnerAccountResponse -> ()
rnf
    AssociateAwsAccountWithPartnerAccountResponse' {Int
Maybe Text
Maybe SidewalkAccountInfo
httpStatus :: Int
sidewalk :: Maybe SidewalkAccountInfo
arn :: Maybe Text
$sel:httpStatus:AssociateAwsAccountWithPartnerAccountResponse' :: AssociateAwsAccountWithPartnerAccountResponse -> Int
$sel:sidewalk:AssociateAwsAccountWithPartnerAccountResponse' :: AssociateAwsAccountWithPartnerAccountResponse
-> Maybe SidewalkAccountInfo
$sel:arn:AssociateAwsAccountWithPartnerAccountResponse' :: AssociateAwsAccountWithPartnerAccountResponse -> 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 SidewalkAccountInfo
sidewalk
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus