{-# 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.CreateComputer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an Active Directory computer object in the specified directory.
module Amazonka.DirectoryService.CreateComputer
  ( -- * Creating a Request
    CreateComputer (..),
    newCreateComputer,

    -- * Request Lenses
    createComputer_computerAttributes,
    createComputer_organizationalUnitDistinguishedName,
    createComputer_directoryId,
    createComputer_computerName,
    createComputer_password,

    -- * Destructuring the Response
    CreateComputerResponse (..),
    newCreateComputerResponse,

    -- * Response Lenses
    createComputerResponse_computer,
    createComputerResponse_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

-- | Contains the inputs for the CreateComputer operation.
--
-- /See:/ 'newCreateComputer' smart constructor.
data CreateComputer = CreateComputer'
  { -- | An array of Attribute objects that contain any LDAP attributes to apply
    -- to the computer account.
    CreateComputer -> Maybe [Attribute]
computerAttributes :: Prelude.Maybe [Attribute],
    -- | The fully-qualified distinguished name of the organizational unit to
    -- place the computer account in.
    CreateComputer -> Maybe Text
organizationalUnitDistinguishedName :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the directory in which to create the computer account.
    CreateComputer -> Text
directoryId :: Prelude.Text,
    -- | The name of the computer account.
    CreateComputer -> Text
computerName :: Prelude.Text,
    -- | A one-time password that is used to join the computer to the directory.
    -- You should generate a random, strong password to use for this parameter.
    CreateComputer -> Sensitive Text
password :: Data.Sensitive Prelude.Text
  }
  deriving (CreateComputer -> CreateComputer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateComputer -> CreateComputer -> Bool
$c/= :: CreateComputer -> CreateComputer -> Bool
== :: CreateComputer -> CreateComputer -> Bool
$c== :: CreateComputer -> CreateComputer -> Bool
Prelude.Eq, Int -> CreateComputer -> ShowS
[CreateComputer] -> ShowS
CreateComputer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateComputer] -> ShowS
$cshowList :: [CreateComputer] -> ShowS
show :: CreateComputer -> String
$cshow :: CreateComputer -> String
showsPrec :: Int -> CreateComputer -> ShowS
$cshowsPrec :: Int -> CreateComputer -> ShowS
Prelude.Show, forall x. Rep CreateComputer x -> CreateComputer
forall x. CreateComputer -> Rep CreateComputer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateComputer x -> CreateComputer
$cfrom :: forall x. CreateComputer -> Rep CreateComputer x
Prelude.Generic)

-- |
-- Create a value of 'CreateComputer' 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:
--
-- 'computerAttributes', 'createComputer_computerAttributes' - An array of Attribute objects that contain any LDAP attributes to apply
-- to the computer account.
--
-- 'organizationalUnitDistinguishedName', 'createComputer_organizationalUnitDistinguishedName' - The fully-qualified distinguished name of the organizational unit to
-- place the computer account in.
--
-- 'directoryId', 'createComputer_directoryId' - The identifier of the directory in which to create the computer account.
--
-- 'computerName', 'createComputer_computerName' - The name of the computer account.
--
-- 'password', 'createComputer_password' - A one-time password that is used to join the computer to the directory.
-- You should generate a random, strong password to use for this parameter.
newCreateComputer ::
  -- | 'directoryId'
  Prelude.Text ->
  -- | 'computerName'
  Prelude.Text ->
  -- | 'password'
  Prelude.Text ->
  CreateComputer
newCreateComputer :: Text -> Text -> Text -> CreateComputer
newCreateComputer
  Text
pDirectoryId_
  Text
pComputerName_
  Text
pPassword_ =
    CreateComputer'
      { $sel:computerAttributes:CreateComputer' :: Maybe [Attribute]
computerAttributes =
          forall a. Maybe a
Prelude.Nothing,
        $sel:organizationalUnitDistinguishedName:CreateComputer' :: Maybe Text
organizationalUnitDistinguishedName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:directoryId:CreateComputer' :: Text
directoryId = Text
pDirectoryId_,
        $sel:computerName:CreateComputer' :: Text
computerName = Text
pComputerName_,
        $sel:password:CreateComputer' :: Sensitive Text
password = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPassword_
      }

-- | An array of Attribute objects that contain any LDAP attributes to apply
-- to the computer account.
createComputer_computerAttributes :: Lens.Lens' CreateComputer (Prelude.Maybe [Attribute])
createComputer_computerAttributes :: Lens' CreateComputer (Maybe [Attribute])
createComputer_computerAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComputer' {Maybe [Attribute]
computerAttributes :: Maybe [Attribute]
$sel:computerAttributes:CreateComputer' :: CreateComputer -> Maybe [Attribute]
computerAttributes} -> Maybe [Attribute]
computerAttributes) (\s :: CreateComputer
s@CreateComputer' {} Maybe [Attribute]
a -> CreateComputer
s {$sel:computerAttributes:CreateComputer' :: Maybe [Attribute]
computerAttributes = Maybe [Attribute]
a} :: CreateComputer) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The fully-qualified distinguished name of the organizational unit to
-- place the computer account in.
createComputer_organizationalUnitDistinguishedName :: Lens.Lens' CreateComputer (Prelude.Maybe Prelude.Text)
createComputer_organizationalUnitDistinguishedName :: Lens' CreateComputer (Maybe Text)
createComputer_organizationalUnitDistinguishedName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComputer' {Maybe Text
organizationalUnitDistinguishedName :: Maybe Text
$sel:organizationalUnitDistinguishedName:CreateComputer' :: CreateComputer -> Maybe Text
organizationalUnitDistinguishedName} -> Maybe Text
organizationalUnitDistinguishedName) (\s :: CreateComputer
s@CreateComputer' {} Maybe Text
a -> CreateComputer
s {$sel:organizationalUnitDistinguishedName:CreateComputer' :: Maybe Text
organizationalUnitDistinguishedName = Maybe Text
a} :: CreateComputer)

-- | The identifier of the directory in which to create the computer account.
createComputer_directoryId :: Lens.Lens' CreateComputer Prelude.Text
createComputer_directoryId :: Lens' CreateComputer Text
createComputer_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComputer' {Text
directoryId :: Text
$sel:directoryId:CreateComputer' :: CreateComputer -> Text
directoryId} -> Text
directoryId) (\s :: CreateComputer
s@CreateComputer' {} Text
a -> CreateComputer
s {$sel:directoryId:CreateComputer' :: Text
directoryId = Text
a} :: CreateComputer)

-- | The name of the computer account.
createComputer_computerName :: Lens.Lens' CreateComputer Prelude.Text
createComputer_computerName :: Lens' CreateComputer Text
createComputer_computerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComputer' {Text
computerName :: Text
$sel:computerName:CreateComputer' :: CreateComputer -> Text
computerName} -> Text
computerName) (\s :: CreateComputer
s@CreateComputer' {} Text
a -> CreateComputer
s {$sel:computerName:CreateComputer' :: Text
computerName = Text
a} :: CreateComputer)

-- | A one-time password that is used to join the computer to the directory.
-- You should generate a random, strong password to use for this parameter.
createComputer_password :: Lens.Lens' CreateComputer Prelude.Text
createComputer_password :: Lens' CreateComputer Text
createComputer_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComputer' {Sensitive Text
password :: Sensitive Text
$sel:password:CreateComputer' :: CreateComputer -> Sensitive Text
password} -> Sensitive Text
password) (\s :: CreateComputer
s@CreateComputer' {} Sensitive Text
a -> CreateComputer
s {$sel:password:CreateComputer' :: Sensitive Text
password = Sensitive Text
a} :: CreateComputer) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest CreateComputer where
  type
    AWSResponse CreateComputer =
      CreateComputerResponse
  request :: (Service -> Service) -> CreateComputer -> Request CreateComputer
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 CreateComputer
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateComputer)))
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 Computer -> Int -> CreateComputerResponse
CreateComputerResponse'
            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
"Computer")
            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 CreateComputer where
  hashWithSalt :: Int -> CreateComputer -> Int
hashWithSalt Int
_salt CreateComputer' {Maybe [Attribute]
Maybe Text
Text
Sensitive Text
password :: Sensitive Text
computerName :: Text
directoryId :: Text
organizationalUnitDistinguishedName :: Maybe Text
computerAttributes :: Maybe [Attribute]
$sel:password:CreateComputer' :: CreateComputer -> Sensitive Text
$sel:computerName:CreateComputer' :: CreateComputer -> Text
$sel:directoryId:CreateComputer' :: CreateComputer -> Text
$sel:organizationalUnitDistinguishedName:CreateComputer' :: CreateComputer -> Maybe Text
$sel:computerAttributes:CreateComputer' :: CreateComputer -> Maybe [Attribute]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Attribute]
computerAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
organizationalUnitDistinguishedName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
computerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
password

instance Prelude.NFData CreateComputer where
  rnf :: CreateComputer -> ()
rnf CreateComputer' {Maybe [Attribute]
Maybe Text
Text
Sensitive Text
password :: Sensitive Text
computerName :: Text
directoryId :: Text
organizationalUnitDistinguishedName :: Maybe Text
computerAttributes :: Maybe [Attribute]
$sel:password:CreateComputer' :: CreateComputer -> Sensitive Text
$sel:computerName:CreateComputer' :: CreateComputer -> Text
$sel:directoryId:CreateComputer' :: CreateComputer -> Text
$sel:organizationalUnitDistinguishedName:CreateComputer' :: CreateComputer -> Maybe Text
$sel:computerAttributes:CreateComputer' :: CreateComputer -> Maybe [Attribute]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Attribute]
computerAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
organizationalUnitDistinguishedName
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
computerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
password

instance Data.ToHeaders CreateComputer where
  toHeaders :: CreateComputer -> 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.CreateComputer" ::
                          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 CreateComputer where
  toJSON :: CreateComputer -> Value
toJSON CreateComputer' {Maybe [Attribute]
Maybe Text
Text
Sensitive Text
password :: Sensitive Text
computerName :: Text
directoryId :: Text
organizationalUnitDistinguishedName :: Maybe Text
computerAttributes :: Maybe [Attribute]
$sel:password:CreateComputer' :: CreateComputer -> Sensitive Text
$sel:computerName:CreateComputer' :: CreateComputer -> Text
$sel:directoryId:CreateComputer' :: CreateComputer -> Text
$sel:organizationalUnitDistinguishedName:CreateComputer' :: CreateComputer -> Maybe Text
$sel:computerAttributes:CreateComputer' :: CreateComputer -> Maybe [Attribute]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ComputerAttributes" 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 [Attribute]
computerAttributes,
            (Key
"OrganizationalUnitDistinguishedName" 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
organizationalUnitDistinguishedName,
            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
"ComputerName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
computerName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Password" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
password)
          ]
      )

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

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

-- | Contains the results for the CreateComputer operation.
--
-- /See:/ 'newCreateComputerResponse' smart constructor.
data CreateComputerResponse = CreateComputerResponse'
  { -- | A Computer object that represents the computer account.
    CreateComputerResponse -> Maybe Computer
computer :: Prelude.Maybe Computer,
    -- | The response's http status code.
    CreateComputerResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateComputerResponse -> CreateComputerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateComputerResponse -> CreateComputerResponse -> Bool
$c/= :: CreateComputerResponse -> CreateComputerResponse -> Bool
== :: CreateComputerResponse -> CreateComputerResponse -> Bool
$c== :: CreateComputerResponse -> CreateComputerResponse -> Bool
Prelude.Eq, ReadPrec [CreateComputerResponse]
ReadPrec CreateComputerResponse
Int -> ReadS CreateComputerResponse
ReadS [CreateComputerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateComputerResponse]
$creadListPrec :: ReadPrec [CreateComputerResponse]
readPrec :: ReadPrec CreateComputerResponse
$creadPrec :: ReadPrec CreateComputerResponse
readList :: ReadS [CreateComputerResponse]
$creadList :: ReadS [CreateComputerResponse]
readsPrec :: Int -> ReadS CreateComputerResponse
$creadsPrec :: Int -> ReadS CreateComputerResponse
Prelude.Read, Int -> CreateComputerResponse -> ShowS
[CreateComputerResponse] -> ShowS
CreateComputerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateComputerResponse] -> ShowS
$cshowList :: [CreateComputerResponse] -> ShowS
show :: CreateComputerResponse -> String
$cshow :: CreateComputerResponse -> String
showsPrec :: Int -> CreateComputerResponse -> ShowS
$cshowsPrec :: Int -> CreateComputerResponse -> ShowS
Prelude.Show, forall x. Rep CreateComputerResponse x -> CreateComputerResponse
forall x. CreateComputerResponse -> Rep CreateComputerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateComputerResponse x -> CreateComputerResponse
$cfrom :: forall x. CreateComputerResponse -> Rep CreateComputerResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateComputerResponse' 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:
--
-- 'computer', 'createComputerResponse_computer' - A Computer object that represents the computer account.
--
-- 'httpStatus', 'createComputerResponse_httpStatus' - The response's http status code.
newCreateComputerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateComputerResponse
newCreateComputerResponse :: Int -> CreateComputerResponse
newCreateComputerResponse Int
pHttpStatus_ =
  CreateComputerResponse'
    { $sel:computer:CreateComputerResponse' :: Maybe Computer
computer = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateComputerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A Computer object that represents the computer account.
createComputerResponse_computer :: Lens.Lens' CreateComputerResponse (Prelude.Maybe Computer)
createComputerResponse_computer :: Lens' CreateComputerResponse (Maybe Computer)
createComputerResponse_computer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComputerResponse' {Maybe Computer
computer :: Maybe Computer
$sel:computer:CreateComputerResponse' :: CreateComputerResponse -> Maybe Computer
computer} -> Maybe Computer
computer) (\s :: CreateComputerResponse
s@CreateComputerResponse' {} Maybe Computer
a -> CreateComputerResponse
s {$sel:computer:CreateComputerResponse' :: Maybe Computer
computer = Maybe Computer
a} :: CreateComputerResponse)

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

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