{-# 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.DirectoryService.DisableLDAPS
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deactivates LDAP secure calls for the specified directory.
module Amazonka.DirectoryService.DisableLDAPS
  ( -- * Creating a Request
    DisableLDAPS (..),
    newDisableLDAPS,

    -- * Request Lenses
    disableLDAPS_directoryId,
    disableLDAPS_type,

    -- * Destructuring the Response
    DisableLDAPSResponse (..),
    newDisableLDAPSResponse,

    -- * Response Lenses
    disableLDAPSResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDisableLDAPS' smart constructor.
data DisableLDAPS = DisableLDAPS'
  { -- | The identifier of the directory.
    DisableLDAPS -> Text
directoryId :: Prelude.Text,
    -- | The type of LDAP security to enable. Currently only the value @Client@
    -- is supported.
    DisableLDAPS -> LDAPSType
type' :: LDAPSType
  }
  deriving (DisableLDAPS -> DisableLDAPS -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisableLDAPS -> DisableLDAPS -> Bool
$c/= :: DisableLDAPS -> DisableLDAPS -> Bool
== :: DisableLDAPS -> DisableLDAPS -> Bool
$c== :: DisableLDAPS -> DisableLDAPS -> Bool
Prelude.Eq, ReadPrec [DisableLDAPS]
ReadPrec DisableLDAPS
Int -> ReadS DisableLDAPS
ReadS [DisableLDAPS]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisableLDAPS]
$creadListPrec :: ReadPrec [DisableLDAPS]
readPrec :: ReadPrec DisableLDAPS
$creadPrec :: ReadPrec DisableLDAPS
readList :: ReadS [DisableLDAPS]
$creadList :: ReadS [DisableLDAPS]
readsPrec :: Int -> ReadS DisableLDAPS
$creadsPrec :: Int -> ReadS DisableLDAPS
Prelude.Read, Int -> DisableLDAPS -> ShowS
[DisableLDAPS] -> ShowS
DisableLDAPS -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisableLDAPS] -> ShowS
$cshowList :: [DisableLDAPS] -> ShowS
show :: DisableLDAPS -> String
$cshow :: DisableLDAPS -> String
showsPrec :: Int -> DisableLDAPS -> ShowS
$cshowsPrec :: Int -> DisableLDAPS -> ShowS
Prelude.Show, forall x. Rep DisableLDAPS x -> DisableLDAPS
forall x. DisableLDAPS -> Rep DisableLDAPS x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisableLDAPS x -> DisableLDAPS
$cfrom :: forall x. DisableLDAPS -> Rep DisableLDAPS x
Prelude.Generic)

-- |
-- Create a value of 'DisableLDAPS' 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:
--
-- 'directoryId', 'disableLDAPS_directoryId' - The identifier of the directory.
--
-- 'type'', 'disableLDAPS_type' - The type of LDAP security to enable. Currently only the value @Client@
-- is supported.
newDisableLDAPS ::
  -- | 'directoryId'
  Prelude.Text ->
  -- | 'type''
  LDAPSType ->
  DisableLDAPS
newDisableLDAPS :: Text -> LDAPSType -> DisableLDAPS
newDisableLDAPS Text
pDirectoryId_ LDAPSType
pType_ =
  DisableLDAPS'
    { $sel:directoryId:DisableLDAPS' :: Text
directoryId = Text
pDirectoryId_,
      $sel:type':DisableLDAPS' :: LDAPSType
type' = LDAPSType
pType_
    }

-- | The identifier of the directory.
disableLDAPS_directoryId :: Lens.Lens' DisableLDAPS Prelude.Text
disableLDAPS_directoryId :: Lens' DisableLDAPS Text
disableLDAPS_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisableLDAPS' {Text
directoryId :: Text
$sel:directoryId:DisableLDAPS' :: DisableLDAPS -> Text
directoryId} -> Text
directoryId) (\s :: DisableLDAPS
s@DisableLDAPS' {} Text
a -> DisableLDAPS
s {$sel:directoryId:DisableLDAPS' :: Text
directoryId = Text
a} :: DisableLDAPS)

-- | The type of LDAP security to enable. Currently only the value @Client@
-- is supported.
disableLDAPS_type :: Lens.Lens' DisableLDAPS LDAPSType
disableLDAPS_type :: Lens' DisableLDAPS LDAPSType
disableLDAPS_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisableLDAPS' {LDAPSType
type' :: LDAPSType
$sel:type':DisableLDAPS' :: DisableLDAPS -> LDAPSType
type'} -> LDAPSType
type') (\s :: DisableLDAPS
s@DisableLDAPS' {} LDAPSType
a -> DisableLDAPS
s {$sel:type':DisableLDAPS' :: LDAPSType
type' = LDAPSType
a} :: DisableLDAPS)

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

instance Prelude.NFData DisableLDAPS where
  rnf :: DisableLDAPS -> ()
rnf DisableLDAPS' {Text
LDAPSType
type' :: LDAPSType
directoryId :: Text
$sel:type':DisableLDAPS' :: DisableLDAPS -> LDAPSType
$sel:directoryId:DisableLDAPS' :: DisableLDAPS -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
directoryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LDAPSType
type'

instance Data.ToHeaders DisableLDAPS where
  toHeaders :: DisableLDAPS -> 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
"DirectoryService_20150416.DisableLDAPS" ::
                          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 DisableLDAPS where
  toJSON :: DisableLDAPS -> Value
toJSON DisableLDAPS' {Text
LDAPSType
type' :: LDAPSType
directoryId :: Text
$sel:type':DisableLDAPS' :: DisableLDAPS -> LDAPSType
$sel:directoryId:DisableLDAPS' :: DisableLDAPS -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"DirectoryId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
directoryId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LDAPSType
type')
          ]
      )

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

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

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

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

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

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