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

    -- * Request Lenses
    updatePartnerAccount_sidewalk,
    updatePartnerAccount_partnerAccountId,
    updatePartnerAccount_partnerType,

    -- * Destructuring the Response
    UpdatePartnerAccountResponse (..),
    newUpdatePartnerAccountResponse,

    -- * Response Lenses
    updatePartnerAccountResponse_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:/ 'newUpdatePartnerAccount' smart constructor.
data UpdatePartnerAccount = UpdatePartnerAccount'
  { -- | The Sidewalk account credentials.
    UpdatePartnerAccount -> SidewalkUpdateAccount
sidewalk :: SidewalkUpdateAccount,
    -- | The ID of the partner account to update.
    UpdatePartnerAccount -> Text
partnerAccountId :: Prelude.Text,
    -- | The partner type.
    UpdatePartnerAccount -> PartnerType
partnerType :: PartnerType
  }
  deriving (UpdatePartnerAccount -> UpdatePartnerAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePartnerAccount -> UpdatePartnerAccount -> Bool
$c/= :: UpdatePartnerAccount -> UpdatePartnerAccount -> Bool
== :: UpdatePartnerAccount -> UpdatePartnerAccount -> Bool
$c== :: UpdatePartnerAccount -> UpdatePartnerAccount -> Bool
Prelude.Eq, Int -> UpdatePartnerAccount -> ShowS
[UpdatePartnerAccount] -> ShowS
UpdatePartnerAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePartnerAccount] -> ShowS
$cshowList :: [UpdatePartnerAccount] -> ShowS
show :: UpdatePartnerAccount -> String
$cshow :: UpdatePartnerAccount -> String
showsPrec :: Int -> UpdatePartnerAccount -> ShowS
$cshowsPrec :: Int -> UpdatePartnerAccount -> ShowS
Prelude.Show, forall x. Rep UpdatePartnerAccount x -> UpdatePartnerAccount
forall x. UpdatePartnerAccount -> Rep UpdatePartnerAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePartnerAccount x -> UpdatePartnerAccount
$cfrom :: forall x. UpdatePartnerAccount -> Rep UpdatePartnerAccount x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePartnerAccount' 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:
--
-- 'sidewalk', 'updatePartnerAccount_sidewalk' - The Sidewalk account credentials.
--
-- 'partnerAccountId', 'updatePartnerAccount_partnerAccountId' - The ID of the partner account to update.
--
-- 'partnerType', 'updatePartnerAccount_partnerType' - The partner type.
newUpdatePartnerAccount ::
  -- | 'sidewalk'
  SidewalkUpdateAccount ->
  -- | 'partnerAccountId'
  Prelude.Text ->
  -- | 'partnerType'
  PartnerType ->
  UpdatePartnerAccount
newUpdatePartnerAccount :: SidewalkUpdateAccount
-> Text -> PartnerType -> UpdatePartnerAccount
newUpdatePartnerAccount
  SidewalkUpdateAccount
pSidewalk_
  Text
pPartnerAccountId_
  PartnerType
pPartnerType_ =
    UpdatePartnerAccount'
      { $sel:sidewalk:UpdatePartnerAccount' :: SidewalkUpdateAccount
sidewalk = SidewalkUpdateAccount
pSidewalk_,
        $sel:partnerAccountId:UpdatePartnerAccount' :: Text
partnerAccountId = Text
pPartnerAccountId_,
        $sel:partnerType:UpdatePartnerAccount' :: PartnerType
partnerType = PartnerType
pPartnerType_
      }

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

-- | The ID of the partner account to update.
updatePartnerAccount_partnerAccountId :: Lens.Lens' UpdatePartnerAccount Prelude.Text
updatePartnerAccount_partnerAccountId :: Lens' UpdatePartnerAccount Text
updatePartnerAccount_partnerAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePartnerAccount' {Text
partnerAccountId :: Text
$sel:partnerAccountId:UpdatePartnerAccount' :: UpdatePartnerAccount -> Text
partnerAccountId} -> Text
partnerAccountId) (\s :: UpdatePartnerAccount
s@UpdatePartnerAccount' {} Text
a -> UpdatePartnerAccount
s {$sel:partnerAccountId:UpdatePartnerAccount' :: Text
partnerAccountId = Text
a} :: UpdatePartnerAccount)

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

instance Core.AWSRequest UpdatePartnerAccount where
  type
    AWSResponse UpdatePartnerAccount =
      UpdatePartnerAccountResponse
  request :: (Service -> Service)
-> UpdatePartnerAccount -> Request UpdatePartnerAccount
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdatePartnerAccount
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdatePartnerAccount)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdatePartnerAccountResponse
UpdatePartnerAccountResponse'
            forall (f :: * -> *) a b. Functor 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 UpdatePartnerAccount where
  hashWithSalt :: Int -> UpdatePartnerAccount -> Int
hashWithSalt Int
_salt UpdatePartnerAccount' {Text
PartnerType
SidewalkUpdateAccount
partnerType :: PartnerType
partnerAccountId :: Text
sidewalk :: SidewalkUpdateAccount
$sel:partnerType:UpdatePartnerAccount' :: UpdatePartnerAccount -> PartnerType
$sel:partnerAccountId:UpdatePartnerAccount' :: UpdatePartnerAccount -> Text
$sel:sidewalk:UpdatePartnerAccount' :: UpdatePartnerAccount -> SidewalkUpdateAccount
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SidewalkUpdateAccount
sidewalk
      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 UpdatePartnerAccount where
  rnf :: UpdatePartnerAccount -> ()
rnf UpdatePartnerAccount' {Text
PartnerType
SidewalkUpdateAccount
partnerType :: PartnerType
partnerAccountId :: Text
sidewalk :: SidewalkUpdateAccount
$sel:partnerType:UpdatePartnerAccount' :: UpdatePartnerAccount -> PartnerType
$sel:partnerAccountId:UpdatePartnerAccount' :: UpdatePartnerAccount -> Text
$sel:sidewalk:UpdatePartnerAccount' :: UpdatePartnerAccount -> SidewalkUpdateAccount
..} =
    forall a. NFData a => a -> ()
Prelude.rnf SidewalkUpdateAccount
sidewalk
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 UpdatePartnerAccount where
  toHeaders :: UpdatePartnerAccount -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON UpdatePartnerAccount where
  toJSON :: UpdatePartnerAccount -> Value
toJSON UpdatePartnerAccount' {Text
PartnerType
SidewalkUpdateAccount
partnerType :: PartnerType
partnerAccountId :: Text
sidewalk :: SidewalkUpdateAccount
$sel:partnerType:UpdatePartnerAccount' :: UpdatePartnerAccount -> PartnerType
$sel:partnerAccountId:UpdatePartnerAccount' :: UpdatePartnerAccount -> Text
$sel:sidewalk:UpdatePartnerAccount' :: UpdatePartnerAccount -> SidewalkUpdateAccount
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Sidewalk" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SidewalkUpdateAccount
sidewalk)]
      )

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

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

-- | /See:/ 'newUpdatePartnerAccountResponse' smart constructor.
data UpdatePartnerAccountResponse = UpdatePartnerAccountResponse'
  { -- | The response's http status code.
    UpdatePartnerAccountResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdatePartnerAccountResponse
-> UpdatePartnerAccountResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePartnerAccountResponse
-> UpdatePartnerAccountResponse -> Bool
$c/= :: UpdatePartnerAccountResponse
-> UpdatePartnerAccountResponse -> Bool
== :: UpdatePartnerAccountResponse
-> UpdatePartnerAccountResponse -> Bool
$c== :: UpdatePartnerAccountResponse
-> UpdatePartnerAccountResponse -> Bool
Prelude.Eq, ReadPrec [UpdatePartnerAccountResponse]
ReadPrec UpdatePartnerAccountResponse
Int -> ReadS UpdatePartnerAccountResponse
ReadS [UpdatePartnerAccountResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePartnerAccountResponse]
$creadListPrec :: ReadPrec [UpdatePartnerAccountResponse]
readPrec :: ReadPrec UpdatePartnerAccountResponse
$creadPrec :: ReadPrec UpdatePartnerAccountResponse
readList :: ReadS [UpdatePartnerAccountResponse]
$creadList :: ReadS [UpdatePartnerAccountResponse]
readsPrec :: Int -> ReadS UpdatePartnerAccountResponse
$creadsPrec :: Int -> ReadS UpdatePartnerAccountResponse
Prelude.Read, Int -> UpdatePartnerAccountResponse -> ShowS
[UpdatePartnerAccountResponse] -> ShowS
UpdatePartnerAccountResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePartnerAccountResponse] -> ShowS
$cshowList :: [UpdatePartnerAccountResponse] -> ShowS
show :: UpdatePartnerAccountResponse -> String
$cshow :: UpdatePartnerAccountResponse -> String
showsPrec :: Int -> UpdatePartnerAccountResponse -> ShowS
$cshowsPrec :: Int -> UpdatePartnerAccountResponse -> ShowS
Prelude.Show, forall x.
Rep UpdatePartnerAccountResponse x -> UpdatePartnerAccountResponse
forall x.
UpdatePartnerAccountResponse -> Rep UpdatePartnerAccountResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdatePartnerAccountResponse x -> UpdatePartnerAccountResponse
$cfrom :: forall x.
UpdatePartnerAccountResponse -> Rep UpdatePartnerAccountResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePartnerAccountResponse' 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:
--
-- 'httpStatus', 'updatePartnerAccountResponse_httpStatus' - The response's http status code.
newUpdatePartnerAccountResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdatePartnerAccountResponse
newUpdatePartnerAccountResponse :: Int -> UpdatePartnerAccountResponse
newUpdatePartnerAccountResponse Int
pHttpStatus_ =
  UpdatePartnerAccountResponse'
    { $sel:httpStatus:UpdatePartnerAccountResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData UpdatePartnerAccountResponse where
  rnf :: UpdatePartnerAccountResponse -> ()
rnf UpdatePartnerAccountResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdatePartnerAccountResponse' :: UpdatePartnerAccountResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus