{-# 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.WorkSpaces.ModifyAccount
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the configuration of Bring Your Own License (BYOL) for the
-- specified account.
module Amazonka.WorkSpaces.ModifyAccount
  ( -- * Creating a Request
    ModifyAccount (..),
    newModifyAccount,

    -- * Request Lenses
    modifyAccount_dedicatedTenancyManagementCidrRange,
    modifyAccount_dedicatedTenancySupport,

    -- * Destructuring the Response
    ModifyAccountResponse (..),
    newModifyAccountResponse,

    -- * Response Lenses
    modifyAccountResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.WorkSpaces.Types

-- | /See:/ 'newModifyAccount' smart constructor.
data ModifyAccount = ModifyAccount'
  { -- | The IP address range, specified as an IPv4 CIDR block, for the
    -- management network interface. Specify an IP address range that is
    -- compatible with your network and in CIDR notation (that is, specify the
    -- range as an IPv4 CIDR block). The CIDR block size must be \/16 (for
    -- example, 203.0.113.25\/16). It must also be specified as available by
    -- the @ListAvailableManagementCidrRanges@ operation.
    ModifyAccount -> Maybe Text
dedicatedTenancyManagementCidrRange :: Prelude.Maybe Prelude.Text,
    -- | The status of BYOL.
    ModifyAccount -> Maybe DedicatedTenancySupportEnum
dedicatedTenancySupport :: Prelude.Maybe DedicatedTenancySupportEnum
  }
  deriving (ModifyAccount -> ModifyAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyAccount -> ModifyAccount -> Bool
$c/= :: ModifyAccount -> ModifyAccount -> Bool
== :: ModifyAccount -> ModifyAccount -> Bool
$c== :: ModifyAccount -> ModifyAccount -> Bool
Prelude.Eq, ReadPrec [ModifyAccount]
ReadPrec ModifyAccount
Int -> ReadS ModifyAccount
ReadS [ModifyAccount]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyAccount]
$creadListPrec :: ReadPrec [ModifyAccount]
readPrec :: ReadPrec ModifyAccount
$creadPrec :: ReadPrec ModifyAccount
readList :: ReadS [ModifyAccount]
$creadList :: ReadS [ModifyAccount]
readsPrec :: Int -> ReadS ModifyAccount
$creadsPrec :: Int -> ReadS ModifyAccount
Prelude.Read, Int -> ModifyAccount -> ShowS
[ModifyAccount] -> ShowS
ModifyAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyAccount] -> ShowS
$cshowList :: [ModifyAccount] -> ShowS
show :: ModifyAccount -> String
$cshow :: ModifyAccount -> String
showsPrec :: Int -> ModifyAccount -> ShowS
$cshowsPrec :: Int -> ModifyAccount -> ShowS
Prelude.Show, forall x. Rep ModifyAccount x -> ModifyAccount
forall x. ModifyAccount -> Rep ModifyAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyAccount x -> ModifyAccount
$cfrom :: forall x. ModifyAccount -> Rep ModifyAccount x
Prelude.Generic)

-- |
-- Create a value of 'ModifyAccount' 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:
--
-- 'dedicatedTenancyManagementCidrRange', 'modifyAccount_dedicatedTenancyManagementCidrRange' - The IP address range, specified as an IPv4 CIDR block, for the
-- management network interface. Specify an IP address range that is
-- compatible with your network and in CIDR notation (that is, specify the
-- range as an IPv4 CIDR block). The CIDR block size must be \/16 (for
-- example, 203.0.113.25\/16). It must also be specified as available by
-- the @ListAvailableManagementCidrRanges@ operation.
--
-- 'dedicatedTenancySupport', 'modifyAccount_dedicatedTenancySupport' - The status of BYOL.
newModifyAccount ::
  ModifyAccount
newModifyAccount :: ModifyAccount
newModifyAccount =
  ModifyAccount'
    { $sel:dedicatedTenancyManagementCidrRange:ModifyAccount' :: Maybe Text
dedicatedTenancyManagementCidrRange =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dedicatedTenancySupport:ModifyAccount' :: Maybe DedicatedTenancySupportEnum
dedicatedTenancySupport = forall a. Maybe a
Prelude.Nothing
    }

-- | The IP address range, specified as an IPv4 CIDR block, for the
-- management network interface. Specify an IP address range that is
-- compatible with your network and in CIDR notation (that is, specify the
-- range as an IPv4 CIDR block). The CIDR block size must be \/16 (for
-- example, 203.0.113.25\/16). It must also be specified as available by
-- the @ListAvailableManagementCidrRanges@ operation.
modifyAccount_dedicatedTenancyManagementCidrRange :: Lens.Lens' ModifyAccount (Prelude.Maybe Prelude.Text)
modifyAccount_dedicatedTenancyManagementCidrRange :: Lens' ModifyAccount (Maybe Text)
modifyAccount_dedicatedTenancyManagementCidrRange = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyAccount' {Maybe Text
dedicatedTenancyManagementCidrRange :: Maybe Text
$sel:dedicatedTenancyManagementCidrRange:ModifyAccount' :: ModifyAccount -> Maybe Text
dedicatedTenancyManagementCidrRange} -> Maybe Text
dedicatedTenancyManagementCidrRange) (\s :: ModifyAccount
s@ModifyAccount' {} Maybe Text
a -> ModifyAccount
s {$sel:dedicatedTenancyManagementCidrRange:ModifyAccount' :: Maybe Text
dedicatedTenancyManagementCidrRange = Maybe Text
a} :: ModifyAccount)

-- | The status of BYOL.
modifyAccount_dedicatedTenancySupport :: Lens.Lens' ModifyAccount (Prelude.Maybe DedicatedTenancySupportEnum)
modifyAccount_dedicatedTenancySupport :: Lens' ModifyAccount (Maybe DedicatedTenancySupportEnum)
modifyAccount_dedicatedTenancySupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyAccount' {Maybe DedicatedTenancySupportEnum
dedicatedTenancySupport :: Maybe DedicatedTenancySupportEnum
$sel:dedicatedTenancySupport:ModifyAccount' :: ModifyAccount -> Maybe DedicatedTenancySupportEnum
dedicatedTenancySupport} -> Maybe DedicatedTenancySupportEnum
dedicatedTenancySupport) (\s :: ModifyAccount
s@ModifyAccount' {} Maybe DedicatedTenancySupportEnum
a -> ModifyAccount
s {$sel:dedicatedTenancySupport:ModifyAccount' :: Maybe DedicatedTenancySupportEnum
dedicatedTenancySupport = Maybe DedicatedTenancySupportEnum
a} :: ModifyAccount)

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

instance Prelude.NFData ModifyAccount where
  rnf :: ModifyAccount -> ()
rnf ModifyAccount' {Maybe Text
Maybe DedicatedTenancySupportEnum
dedicatedTenancySupport :: Maybe DedicatedTenancySupportEnum
dedicatedTenancyManagementCidrRange :: Maybe Text
$sel:dedicatedTenancySupport:ModifyAccount' :: ModifyAccount -> Maybe DedicatedTenancySupportEnum
$sel:dedicatedTenancyManagementCidrRange:ModifyAccount' :: ModifyAccount -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dedicatedTenancyManagementCidrRange
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DedicatedTenancySupportEnum
dedicatedTenancySupport

instance Data.ToHeaders ModifyAccount where
  toHeaders :: ModifyAccount -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"WorkspacesService.ModifyAccount" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ModifyAccount where
  toJSON :: ModifyAccount -> Value
toJSON ModifyAccount' {Maybe Text
Maybe DedicatedTenancySupportEnum
dedicatedTenancySupport :: Maybe DedicatedTenancySupportEnum
dedicatedTenancyManagementCidrRange :: Maybe Text
$sel:dedicatedTenancySupport:ModifyAccount' :: ModifyAccount -> Maybe DedicatedTenancySupportEnum
$sel:dedicatedTenancyManagementCidrRange:ModifyAccount' :: ModifyAccount -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DedicatedTenancyManagementCidrRange" 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
dedicatedTenancyManagementCidrRange,
            (Key
"DedicatedTenancySupport" 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 DedicatedTenancySupportEnum
dedicatedTenancySupport
          ]
      )

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

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

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

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

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

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