{-# 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.StartSchemaExtension
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Applies a schema extension to a Microsoft AD directory.
module Amazonka.DirectoryService.StartSchemaExtension
  ( -- * Creating a Request
    StartSchemaExtension (..),
    newStartSchemaExtension,

    -- * Request Lenses
    startSchemaExtension_directoryId,
    startSchemaExtension_createSnapshotBeforeSchemaExtension,
    startSchemaExtension_ldifContent,
    startSchemaExtension_description,

    -- * Destructuring the Response
    StartSchemaExtensionResponse (..),
    newStartSchemaExtensionResponse,

    -- * Response Lenses
    startSchemaExtensionResponse_schemaExtensionId,
    startSchemaExtensionResponse_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:/ 'newStartSchemaExtension' smart constructor.
data StartSchemaExtension = StartSchemaExtension'
  { -- | The identifier of the directory for which the schema extension will be
    -- applied to.
    StartSchemaExtension -> Text
directoryId :: Prelude.Text,
    -- | If true, creates a snapshot of the directory before applying the schema
    -- extension.
    StartSchemaExtension -> Bool
createSnapshotBeforeSchemaExtension :: Prelude.Bool,
    -- | The LDIF file represented as a string. To construct the LdifContent
    -- string, precede each line as it would be formatted in an ldif file with
    -- \\n. See the example request below for more details. The file size can
    -- be no larger than 1MB.
    StartSchemaExtension -> Text
ldifContent :: Prelude.Text,
    -- | A description of the schema extension.
    StartSchemaExtension -> Text
description :: Prelude.Text
  }
  deriving (StartSchemaExtension -> StartSchemaExtension -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSchemaExtension -> StartSchemaExtension -> Bool
$c/= :: StartSchemaExtension -> StartSchemaExtension -> Bool
== :: StartSchemaExtension -> StartSchemaExtension -> Bool
$c== :: StartSchemaExtension -> StartSchemaExtension -> Bool
Prelude.Eq, ReadPrec [StartSchemaExtension]
ReadPrec StartSchemaExtension
Int -> ReadS StartSchemaExtension
ReadS [StartSchemaExtension]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSchemaExtension]
$creadListPrec :: ReadPrec [StartSchemaExtension]
readPrec :: ReadPrec StartSchemaExtension
$creadPrec :: ReadPrec StartSchemaExtension
readList :: ReadS [StartSchemaExtension]
$creadList :: ReadS [StartSchemaExtension]
readsPrec :: Int -> ReadS StartSchemaExtension
$creadsPrec :: Int -> ReadS StartSchemaExtension
Prelude.Read, Int -> StartSchemaExtension -> ShowS
[StartSchemaExtension] -> ShowS
StartSchemaExtension -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSchemaExtension] -> ShowS
$cshowList :: [StartSchemaExtension] -> ShowS
show :: StartSchemaExtension -> String
$cshow :: StartSchemaExtension -> String
showsPrec :: Int -> StartSchemaExtension -> ShowS
$cshowsPrec :: Int -> StartSchemaExtension -> ShowS
Prelude.Show, forall x. Rep StartSchemaExtension x -> StartSchemaExtension
forall x. StartSchemaExtension -> Rep StartSchemaExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartSchemaExtension x -> StartSchemaExtension
$cfrom :: forall x. StartSchemaExtension -> Rep StartSchemaExtension x
Prelude.Generic)

-- |
-- Create a value of 'StartSchemaExtension' 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', 'startSchemaExtension_directoryId' - The identifier of the directory for which the schema extension will be
-- applied to.
--
-- 'createSnapshotBeforeSchemaExtension', 'startSchemaExtension_createSnapshotBeforeSchemaExtension' - If true, creates a snapshot of the directory before applying the schema
-- extension.
--
-- 'ldifContent', 'startSchemaExtension_ldifContent' - The LDIF file represented as a string. To construct the LdifContent
-- string, precede each line as it would be formatted in an ldif file with
-- \\n. See the example request below for more details. The file size can
-- be no larger than 1MB.
--
-- 'description', 'startSchemaExtension_description' - A description of the schema extension.
newStartSchemaExtension ::
  -- | 'directoryId'
  Prelude.Text ->
  -- | 'createSnapshotBeforeSchemaExtension'
  Prelude.Bool ->
  -- | 'ldifContent'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  StartSchemaExtension
newStartSchemaExtension :: Text -> Bool -> Text -> Text -> StartSchemaExtension
newStartSchemaExtension
  Text
pDirectoryId_
  Bool
pCreateSnapshotBeforeSchemaExtension_
  Text
pLdifContent_
  Text
pDescription_ =
    StartSchemaExtension'
      { $sel:directoryId:StartSchemaExtension' :: Text
directoryId = Text
pDirectoryId_,
        $sel:createSnapshotBeforeSchemaExtension:StartSchemaExtension' :: Bool
createSnapshotBeforeSchemaExtension =
          Bool
pCreateSnapshotBeforeSchemaExtension_,
        $sel:ldifContent:StartSchemaExtension' :: Text
ldifContent = Text
pLdifContent_,
        $sel:description:StartSchemaExtension' :: Text
description = Text
pDescription_
      }

-- | The identifier of the directory for which the schema extension will be
-- applied to.
startSchemaExtension_directoryId :: Lens.Lens' StartSchemaExtension Prelude.Text
startSchemaExtension_directoryId :: Lens' StartSchemaExtension Text
startSchemaExtension_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSchemaExtension' {Text
directoryId :: Text
$sel:directoryId:StartSchemaExtension' :: StartSchemaExtension -> Text
directoryId} -> Text
directoryId) (\s :: StartSchemaExtension
s@StartSchemaExtension' {} Text
a -> StartSchemaExtension
s {$sel:directoryId:StartSchemaExtension' :: Text
directoryId = Text
a} :: StartSchemaExtension)

-- | If true, creates a snapshot of the directory before applying the schema
-- extension.
startSchemaExtension_createSnapshotBeforeSchemaExtension :: Lens.Lens' StartSchemaExtension Prelude.Bool
startSchemaExtension_createSnapshotBeforeSchemaExtension :: Lens' StartSchemaExtension Bool
startSchemaExtension_createSnapshotBeforeSchemaExtension = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSchemaExtension' {Bool
createSnapshotBeforeSchemaExtension :: Bool
$sel:createSnapshotBeforeSchemaExtension:StartSchemaExtension' :: StartSchemaExtension -> Bool
createSnapshotBeforeSchemaExtension} -> Bool
createSnapshotBeforeSchemaExtension) (\s :: StartSchemaExtension
s@StartSchemaExtension' {} Bool
a -> StartSchemaExtension
s {$sel:createSnapshotBeforeSchemaExtension:StartSchemaExtension' :: Bool
createSnapshotBeforeSchemaExtension = Bool
a} :: StartSchemaExtension)

-- | The LDIF file represented as a string. To construct the LdifContent
-- string, precede each line as it would be formatted in an ldif file with
-- \\n. See the example request below for more details. The file size can
-- be no larger than 1MB.
startSchemaExtension_ldifContent :: Lens.Lens' StartSchemaExtension Prelude.Text
startSchemaExtension_ldifContent :: Lens' StartSchemaExtension Text
startSchemaExtension_ldifContent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSchemaExtension' {Text
ldifContent :: Text
$sel:ldifContent:StartSchemaExtension' :: StartSchemaExtension -> Text
ldifContent} -> Text
ldifContent) (\s :: StartSchemaExtension
s@StartSchemaExtension' {} Text
a -> StartSchemaExtension
s {$sel:ldifContent:StartSchemaExtension' :: Text
ldifContent = Text
a} :: StartSchemaExtension)

-- | A description of the schema extension.
startSchemaExtension_description :: Lens.Lens' StartSchemaExtension Prelude.Text
startSchemaExtension_description :: Lens' StartSchemaExtension Text
startSchemaExtension_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSchemaExtension' {Text
description :: Text
$sel:description:StartSchemaExtension' :: StartSchemaExtension -> Text
description} -> Text
description) (\s :: StartSchemaExtension
s@StartSchemaExtension' {} Text
a -> StartSchemaExtension
s {$sel:description:StartSchemaExtension' :: Text
description = Text
a} :: StartSchemaExtension)

instance Core.AWSRequest StartSchemaExtension where
  type
    AWSResponse StartSchemaExtension =
      StartSchemaExtensionResponse
  request :: (Service -> Service)
-> StartSchemaExtension -> Request StartSchemaExtension
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 StartSchemaExtension
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartSchemaExtension)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> StartSchemaExtensionResponse
StartSchemaExtensionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SchemaExtensionId")
            forall (f :: * -> *) a b. Applicative f => 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 StartSchemaExtension where
  hashWithSalt :: Int -> StartSchemaExtension -> Int
hashWithSalt Int
_salt StartSchemaExtension' {Bool
Text
description :: Text
ldifContent :: Text
createSnapshotBeforeSchemaExtension :: Bool
directoryId :: Text
$sel:description:StartSchemaExtension' :: StartSchemaExtension -> Text
$sel:ldifContent:StartSchemaExtension' :: StartSchemaExtension -> Text
$sel:createSnapshotBeforeSchemaExtension:StartSchemaExtension' :: StartSchemaExtension -> Bool
$sel:directoryId:StartSchemaExtension' :: StartSchemaExtension -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
createSnapshotBeforeSchemaExtension
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ldifContent
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description

instance Prelude.NFData StartSchemaExtension where
  rnf :: StartSchemaExtension -> ()
rnf StartSchemaExtension' {Bool
Text
description :: Text
ldifContent :: Text
createSnapshotBeforeSchemaExtension :: Bool
directoryId :: Text
$sel:description:StartSchemaExtension' :: StartSchemaExtension -> Text
$sel:ldifContent:StartSchemaExtension' :: StartSchemaExtension -> Text
$sel:createSnapshotBeforeSchemaExtension:StartSchemaExtension' :: StartSchemaExtension -> Bool
$sel:directoryId:StartSchemaExtension' :: StartSchemaExtension -> 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 Bool
createSnapshotBeforeSchemaExtension
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ldifContent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description

instance Data.ToHeaders StartSchemaExtension where
  toHeaders :: StartSchemaExtension -> 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.StartSchemaExtension" ::
                          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 StartSchemaExtension where
  toJSON :: StartSchemaExtension -> Value
toJSON StartSchemaExtension' {Bool
Text
description :: Text
ldifContent :: Text
createSnapshotBeforeSchemaExtension :: Bool
directoryId :: Text
$sel:description:StartSchemaExtension' :: StartSchemaExtension -> Text
$sel:ldifContent:StartSchemaExtension' :: StartSchemaExtension -> Text
$sel:createSnapshotBeforeSchemaExtension:StartSchemaExtension' :: StartSchemaExtension -> Bool
$sel:directoryId:StartSchemaExtension' :: StartSchemaExtension -> 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
"CreateSnapshotBeforeSchemaExtension"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
createSnapshotBeforeSchemaExtension
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"LdifContent" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
ldifContent),
            forall a. a -> Maybe a
Prelude.Just (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
description)
          ]
      )

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

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

-- | /See:/ 'newStartSchemaExtensionResponse' smart constructor.
data StartSchemaExtensionResponse = StartSchemaExtensionResponse'
  { -- | The identifier of the schema extension that will be applied.
    StartSchemaExtensionResponse -> Maybe Text
schemaExtensionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartSchemaExtensionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartSchemaExtensionResponse
-> StartSchemaExtensionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSchemaExtensionResponse
-> StartSchemaExtensionResponse -> Bool
$c/= :: StartSchemaExtensionResponse
-> StartSchemaExtensionResponse -> Bool
== :: StartSchemaExtensionResponse
-> StartSchemaExtensionResponse -> Bool
$c== :: StartSchemaExtensionResponse
-> StartSchemaExtensionResponse -> Bool
Prelude.Eq, ReadPrec [StartSchemaExtensionResponse]
ReadPrec StartSchemaExtensionResponse
Int -> ReadS StartSchemaExtensionResponse
ReadS [StartSchemaExtensionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSchemaExtensionResponse]
$creadListPrec :: ReadPrec [StartSchemaExtensionResponse]
readPrec :: ReadPrec StartSchemaExtensionResponse
$creadPrec :: ReadPrec StartSchemaExtensionResponse
readList :: ReadS [StartSchemaExtensionResponse]
$creadList :: ReadS [StartSchemaExtensionResponse]
readsPrec :: Int -> ReadS StartSchemaExtensionResponse
$creadsPrec :: Int -> ReadS StartSchemaExtensionResponse
Prelude.Read, Int -> StartSchemaExtensionResponse -> ShowS
[StartSchemaExtensionResponse] -> ShowS
StartSchemaExtensionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSchemaExtensionResponse] -> ShowS
$cshowList :: [StartSchemaExtensionResponse] -> ShowS
show :: StartSchemaExtensionResponse -> String
$cshow :: StartSchemaExtensionResponse -> String
showsPrec :: Int -> StartSchemaExtensionResponse -> ShowS
$cshowsPrec :: Int -> StartSchemaExtensionResponse -> ShowS
Prelude.Show, forall x.
Rep StartSchemaExtensionResponse x -> StartSchemaExtensionResponse
forall x.
StartSchemaExtensionResponse -> Rep StartSchemaExtensionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartSchemaExtensionResponse x -> StartSchemaExtensionResponse
$cfrom :: forall x.
StartSchemaExtensionResponse -> Rep StartSchemaExtensionResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartSchemaExtensionResponse' 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:
--
-- 'schemaExtensionId', 'startSchemaExtensionResponse_schemaExtensionId' - The identifier of the schema extension that will be applied.
--
-- 'httpStatus', 'startSchemaExtensionResponse_httpStatus' - The response's http status code.
newStartSchemaExtensionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartSchemaExtensionResponse
newStartSchemaExtensionResponse :: Int -> StartSchemaExtensionResponse
newStartSchemaExtensionResponse Int
pHttpStatus_ =
  StartSchemaExtensionResponse'
    { $sel:schemaExtensionId:StartSchemaExtensionResponse' :: Maybe Text
schemaExtensionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartSchemaExtensionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the schema extension that will be applied.
startSchemaExtensionResponse_schemaExtensionId :: Lens.Lens' StartSchemaExtensionResponse (Prelude.Maybe Prelude.Text)
startSchemaExtensionResponse_schemaExtensionId :: Lens' StartSchemaExtensionResponse (Maybe Text)
startSchemaExtensionResponse_schemaExtensionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSchemaExtensionResponse' {Maybe Text
schemaExtensionId :: Maybe Text
$sel:schemaExtensionId:StartSchemaExtensionResponse' :: StartSchemaExtensionResponse -> Maybe Text
schemaExtensionId} -> Maybe Text
schemaExtensionId) (\s :: StartSchemaExtensionResponse
s@StartSchemaExtensionResponse' {} Maybe Text
a -> StartSchemaExtensionResponse
s {$sel:schemaExtensionId:StartSchemaExtensionResponse' :: Maybe Text
schemaExtensionId = Maybe Text
a} :: StartSchemaExtensionResponse)

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

instance Prelude.NFData StartSchemaExtensionResponse where
  rnf :: StartSchemaExtensionResponse -> ()
rnf StartSchemaExtensionResponse' {Int
Maybe Text
httpStatus :: Int
schemaExtensionId :: Maybe Text
$sel:httpStatus:StartSchemaExtensionResponse' :: StartSchemaExtensionResponse -> Int
$sel:schemaExtensionId:StartSchemaExtensionResponse' :: StartSchemaExtensionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
schemaExtensionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus