{-# 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.DeleteClientBranding
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes customized client branding. Client branding allows you to
-- customize your WorkSpace\'s client login portal. You can tailor your
-- login portal company logo, the support email address, support link, link
-- to reset password, and a custom message for users trying to sign in.
--
-- After you delete your customized client branding, your login portal
-- reverts to the default client branding.
module Amazonka.WorkSpaces.DeleteClientBranding
  ( -- * Creating a Request
    DeleteClientBranding (..),
    newDeleteClientBranding,

    -- * Request Lenses
    deleteClientBranding_resourceId,
    deleteClientBranding_platforms,

    -- * Destructuring the Response
    DeleteClientBrandingResponse (..),
    newDeleteClientBrandingResponse,

    -- * Response Lenses
    deleteClientBrandingResponse_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:/ 'newDeleteClientBranding' smart constructor.
data DeleteClientBranding = DeleteClientBranding'
  { -- | The directory identifier of the WorkSpace for which you want to delete
    -- client branding.
    DeleteClientBranding -> Text
resourceId :: Prelude.Text,
    -- | The device type for which you want to delete client branding.
    DeleteClientBranding -> NonEmpty ClientDeviceType
platforms :: Prelude.NonEmpty ClientDeviceType
  }
  deriving (DeleteClientBranding -> DeleteClientBranding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteClientBranding -> DeleteClientBranding -> Bool
$c/= :: DeleteClientBranding -> DeleteClientBranding -> Bool
== :: DeleteClientBranding -> DeleteClientBranding -> Bool
$c== :: DeleteClientBranding -> DeleteClientBranding -> Bool
Prelude.Eq, ReadPrec [DeleteClientBranding]
ReadPrec DeleteClientBranding
Int -> ReadS DeleteClientBranding
ReadS [DeleteClientBranding]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteClientBranding]
$creadListPrec :: ReadPrec [DeleteClientBranding]
readPrec :: ReadPrec DeleteClientBranding
$creadPrec :: ReadPrec DeleteClientBranding
readList :: ReadS [DeleteClientBranding]
$creadList :: ReadS [DeleteClientBranding]
readsPrec :: Int -> ReadS DeleteClientBranding
$creadsPrec :: Int -> ReadS DeleteClientBranding
Prelude.Read, Int -> DeleteClientBranding -> ShowS
[DeleteClientBranding] -> ShowS
DeleteClientBranding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteClientBranding] -> ShowS
$cshowList :: [DeleteClientBranding] -> ShowS
show :: DeleteClientBranding -> String
$cshow :: DeleteClientBranding -> String
showsPrec :: Int -> DeleteClientBranding -> ShowS
$cshowsPrec :: Int -> DeleteClientBranding -> ShowS
Prelude.Show, forall x. Rep DeleteClientBranding x -> DeleteClientBranding
forall x. DeleteClientBranding -> Rep DeleteClientBranding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteClientBranding x -> DeleteClientBranding
$cfrom :: forall x. DeleteClientBranding -> Rep DeleteClientBranding x
Prelude.Generic)

-- |
-- Create a value of 'DeleteClientBranding' 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:
--
-- 'resourceId', 'deleteClientBranding_resourceId' - The directory identifier of the WorkSpace for which you want to delete
-- client branding.
--
-- 'platforms', 'deleteClientBranding_platforms' - The device type for which you want to delete client branding.
newDeleteClientBranding ::
  -- | 'resourceId'
  Prelude.Text ->
  -- | 'platforms'
  Prelude.NonEmpty ClientDeviceType ->
  DeleteClientBranding
newDeleteClientBranding :: Text -> NonEmpty ClientDeviceType -> DeleteClientBranding
newDeleteClientBranding Text
pResourceId_ NonEmpty ClientDeviceType
pPlatforms_ =
  DeleteClientBranding'
    { $sel:resourceId:DeleteClientBranding' :: Text
resourceId = Text
pResourceId_,
      $sel:platforms:DeleteClientBranding' :: NonEmpty ClientDeviceType
platforms = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty ClientDeviceType
pPlatforms_
    }

-- | The directory identifier of the WorkSpace for which you want to delete
-- client branding.
deleteClientBranding_resourceId :: Lens.Lens' DeleteClientBranding Prelude.Text
deleteClientBranding_resourceId :: Lens' DeleteClientBranding Text
deleteClientBranding_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteClientBranding' {Text
resourceId :: Text
$sel:resourceId:DeleteClientBranding' :: DeleteClientBranding -> Text
resourceId} -> Text
resourceId) (\s :: DeleteClientBranding
s@DeleteClientBranding' {} Text
a -> DeleteClientBranding
s {$sel:resourceId:DeleteClientBranding' :: Text
resourceId = Text
a} :: DeleteClientBranding)

-- | The device type for which you want to delete client branding.
deleteClientBranding_platforms :: Lens.Lens' DeleteClientBranding (Prelude.NonEmpty ClientDeviceType)
deleteClientBranding_platforms :: Lens' DeleteClientBranding (NonEmpty ClientDeviceType)
deleteClientBranding_platforms = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteClientBranding' {NonEmpty ClientDeviceType
platforms :: NonEmpty ClientDeviceType
$sel:platforms:DeleteClientBranding' :: DeleteClientBranding -> NonEmpty ClientDeviceType
platforms} -> NonEmpty ClientDeviceType
platforms) (\s :: DeleteClientBranding
s@DeleteClientBranding' {} NonEmpty ClientDeviceType
a -> DeleteClientBranding
s {$sel:platforms:DeleteClientBranding' :: NonEmpty ClientDeviceType
platforms = NonEmpty ClientDeviceType
a} :: DeleteClientBranding) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest DeleteClientBranding where
  type
    AWSResponse DeleteClientBranding =
      DeleteClientBrandingResponse
  request :: (Service -> Service)
-> DeleteClientBranding -> Request DeleteClientBranding
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 DeleteClientBranding
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteClientBranding)))
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 -> DeleteClientBrandingResponse
DeleteClientBrandingResponse'
            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 DeleteClientBranding where
  hashWithSalt :: Int -> DeleteClientBranding -> Int
hashWithSalt Int
_salt DeleteClientBranding' {NonEmpty ClientDeviceType
Text
platforms :: NonEmpty ClientDeviceType
resourceId :: Text
$sel:platforms:DeleteClientBranding' :: DeleteClientBranding -> NonEmpty ClientDeviceType
$sel:resourceId:DeleteClientBranding' :: DeleteClientBranding -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty ClientDeviceType
platforms

instance Prelude.NFData DeleteClientBranding where
  rnf :: DeleteClientBranding -> ()
rnf DeleteClientBranding' {NonEmpty ClientDeviceType
Text
platforms :: NonEmpty ClientDeviceType
resourceId :: Text
$sel:platforms:DeleteClientBranding' :: DeleteClientBranding -> NonEmpty ClientDeviceType
$sel:resourceId:DeleteClientBranding' :: DeleteClientBranding -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty ClientDeviceType
platforms

instance Data.ToHeaders DeleteClientBranding where
  toHeaders :: DeleteClientBranding -> 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.DeleteClientBranding" ::
                          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 DeleteClientBranding where
  toJSON :: DeleteClientBranding -> Value
toJSON DeleteClientBranding' {NonEmpty ClientDeviceType
Text
platforms :: NonEmpty ClientDeviceType
resourceId :: Text
$sel:platforms:DeleteClientBranding' :: DeleteClientBranding -> NonEmpty ClientDeviceType
$sel:resourceId:DeleteClientBranding' :: DeleteClientBranding -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ResourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Platforms" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty ClientDeviceType
platforms)
          ]
      )

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

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

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

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

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

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