{-# 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.WorkSpacesWeb.DeleteTrustStore
-- 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 the trust store.
module Amazonka.WorkSpacesWeb.DeleteTrustStore
  ( -- * Creating a Request
    DeleteTrustStore (..),
    newDeleteTrustStore,

    -- * Request Lenses
    deleteTrustStore_trustStoreArn,

    -- * Destructuring the Response
    DeleteTrustStoreResponse (..),
    newDeleteTrustStoreResponse,

    -- * Response Lenses
    deleteTrustStoreResponse_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.WorkSpacesWeb.Types

-- | /See:/ 'newDeleteTrustStore' smart constructor.
data DeleteTrustStore = DeleteTrustStore'
  { -- | The ARN of the trust store.
    DeleteTrustStore -> Text
trustStoreArn :: Prelude.Text
  }
  deriving (DeleteTrustStore -> DeleteTrustStore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteTrustStore -> DeleteTrustStore -> Bool
$c/= :: DeleteTrustStore -> DeleteTrustStore -> Bool
== :: DeleteTrustStore -> DeleteTrustStore -> Bool
$c== :: DeleteTrustStore -> DeleteTrustStore -> Bool
Prelude.Eq, ReadPrec [DeleteTrustStore]
ReadPrec DeleteTrustStore
Int -> ReadS DeleteTrustStore
ReadS [DeleteTrustStore]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteTrustStore]
$creadListPrec :: ReadPrec [DeleteTrustStore]
readPrec :: ReadPrec DeleteTrustStore
$creadPrec :: ReadPrec DeleteTrustStore
readList :: ReadS [DeleteTrustStore]
$creadList :: ReadS [DeleteTrustStore]
readsPrec :: Int -> ReadS DeleteTrustStore
$creadsPrec :: Int -> ReadS DeleteTrustStore
Prelude.Read, Int -> DeleteTrustStore -> ShowS
[DeleteTrustStore] -> ShowS
DeleteTrustStore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteTrustStore] -> ShowS
$cshowList :: [DeleteTrustStore] -> ShowS
show :: DeleteTrustStore -> String
$cshow :: DeleteTrustStore -> String
showsPrec :: Int -> DeleteTrustStore -> ShowS
$cshowsPrec :: Int -> DeleteTrustStore -> ShowS
Prelude.Show, forall x. Rep DeleteTrustStore x -> DeleteTrustStore
forall x. DeleteTrustStore -> Rep DeleteTrustStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteTrustStore x -> DeleteTrustStore
$cfrom :: forall x. DeleteTrustStore -> Rep DeleteTrustStore x
Prelude.Generic)

-- |
-- Create a value of 'DeleteTrustStore' 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:
--
-- 'trustStoreArn', 'deleteTrustStore_trustStoreArn' - The ARN of the trust store.
newDeleteTrustStore ::
  -- | 'trustStoreArn'
  Prelude.Text ->
  DeleteTrustStore
newDeleteTrustStore :: Text -> DeleteTrustStore
newDeleteTrustStore Text
pTrustStoreArn_ =
  DeleteTrustStore' {$sel:trustStoreArn:DeleteTrustStore' :: Text
trustStoreArn = Text
pTrustStoreArn_}

-- | The ARN of the trust store.
deleteTrustStore_trustStoreArn :: Lens.Lens' DeleteTrustStore Prelude.Text
deleteTrustStore_trustStoreArn :: Lens' DeleteTrustStore Text
deleteTrustStore_trustStoreArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteTrustStore' {Text
trustStoreArn :: Text
$sel:trustStoreArn:DeleteTrustStore' :: DeleteTrustStore -> Text
trustStoreArn} -> Text
trustStoreArn) (\s :: DeleteTrustStore
s@DeleteTrustStore' {} Text
a -> DeleteTrustStore
s {$sel:trustStoreArn:DeleteTrustStore' :: Text
trustStoreArn = Text
a} :: DeleteTrustStore)

instance Core.AWSRequest DeleteTrustStore where
  type
    AWSResponse DeleteTrustStore =
      DeleteTrustStoreResponse
  request :: (Service -> Service)
-> DeleteTrustStore -> Request DeleteTrustStore
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteTrustStore
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteTrustStore)))
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 -> DeleteTrustStoreResponse
DeleteTrustStoreResponse'
            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 DeleteTrustStore where
  hashWithSalt :: Int -> DeleteTrustStore -> Int
hashWithSalt Int
_salt DeleteTrustStore' {Text
trustStoreArn :: Text
$sel:trustStoreArn:DeleteTrustStore' :: DeleteTrustStore -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trustStoreArn

instance Prelude.NFData DeleteTrustStore where
  rnf :: DeleteTrustStore -> ()
rnf DeleteTrustStore' {Text
trustStoreArn :: Text
$sel:trustStoreArn:DeleteTrustStore' :: DeleteTrustStore -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
trustStoreArn

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

instance Data.ToPath DeleteTrustStore where
  toPath :: DeleteTrustStore -> ByteString
toPath DeleteTrustStore' {Text
trustStoreArn :: Text
$sel:trustStoreArn:DeleteTrustStore' :: DeleteTrustStore -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/trustStores/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
trustStoreArn]

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

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

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

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

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