{-# 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.CloudDirectory.GetDirectory
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves metadata about a directory.
module Amazonka.CloudDirectory.GetDirectory
  ( -- * Creating a Request
    GetDirectory (..),
    newGetDirectory,

    -- * Request Lenses
    getDirectory_directoryArn,

    -- * Destructuring the Response
    GetDirectoryResponse (..),
    newGetDirectoryResponse,

    -- * Response Lenses
    getDirectoryResponse_httpStatus,
    getDirectoryResponse_directory,
  )
where

import Amazonka.CloudDirectory.Types
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

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

-- |
-- Create a value of 'GetDirectory' 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:
--
-- 'directoryArn', 'getDirectory_directoryArn' - The ARN of the directory.
newGetDirectory ::
  -- | 'directoryArn'
  Prelude.Text ->
  GetDirectory
newGetDirectory :: Text -> GetDirectory
newGetDirectory Text
pDirectoryArn_ =
  GetDirectory' {$sel:directoryArn:GetDirectory' :: Text
directoryArn = Text
pDirectoryArn_}

-- | The ARN of the directory.
getDirectory_directoryArn :: Lens.Lens' GetDirectory Prelude.Text
getDirectory_directoryArn :: Lens' GetDirectory Text
getDirectory_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDirectory' {Text
directoryArn :: Text
$sel:directoryArn:GetDirectory' :: GetDirectory -> Text
directoryArn} -> Text
directoryArn) (\s :: GetDirectory
s@GetDirectory' {} Text
a -> GetDirectory
s {$sel:directoryArn:GetDirectory' :: Text
directoryArn = Text
a} :: GetDirectory)

instance Core.AWSRequest GetDirectory where
  type AWSResponse GetDirectory = GetDirectoryResponse
  request :: (Service -> Service) -> GetDirectory -> Request GetDirectory
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 GetDirectory
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDirectory)))
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 ->
          Int -> Directory -> GetDirectoryResponse
GetDirectoryResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Directory")
      )

instance Prelude.Hashable GetDirectory where
  hashWithSalt :: Int -> GetDirectory -> Int
hashWithSalt Int
_salt GetDirectory' {Text
directoryArn :: Text
$sel:directoryArn:GetDirectory' :: GetDirectory -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryArn

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

instance Data.ToHeaders GetDirectory where
  toHeaders :: GetDirectory -> ResponseHeaders
toHeaders GetDirectory' {Text
directoryArn :: Text
$sel:directoryArn:GetDirectory' :: GetDirectory -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [HeaderName
"x-amz-data-partition" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
directoryArn]

instance Data.ToJSON GetDirectory where
  toJSON :: GetDirectory -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath GetDirectory where
  toPath :: GetDirectory -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/amazonclouddirectory/2017-01-11/directory/get"

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

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

-- |
-- Create a value of 'GetDirectoryResponse' 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', 'getDirectoryResponse_httpStatus' - The response's http status code.
--
-- 'directory', 'getDirectoryResponse_directory' - Metadata about the directory.
newGetDirectoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'directory'
  Directory ->
  GetDirectoryResponse
newGetDirectoryResponse :: Int -> Directory -> GetDirectoryResponse
newGetDirectoryResponse Int
pHttpStatus_ Directory
pDirectory_ =
  GetDirectoryResponse'
    { $sel:httpStatus:GetDirectoryResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:directory:GetDirectoryResponse' :: Directory
directory = Directory
pDirectory_
    }

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

-- | Metadata about the directory.
getDirectoryResponse_directory :: Lens.Lens' GetDirectoryResponse Directory
getDirectoryResponse_directory :: Lens' GetDirectoryResponse Directory
getDirectoryResponse_directory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDirectoryResponse' {Directory
directory :: Directory
$sel:directory:GetDirectoryResponse' :: GetDirectoryResponse -> Directory
directory} -> Directory
directory) (\s :: GetDirectoryResponse
s@GetDirectoryResponse' {} Directory
a -> GetDirectoryResponse
s {$sel:directory:GetDirectoryResponse' :: Directory
directory = Directory
a} :: GetDirectoryResponse)

instance Prelude.NFData GetDirectoryResponse where
  rnf :: GetDirectoryResponse -> ()
rnf GetDirectoryResponse' {Int
Directory
directory :: Directory
httpStatus :: Int
$sel:directory:GetDirectoryResponse' :: GetDirectoryResponse -> Directory
$sel:httpStatus:GetDirectoryResponse' :: GetDirectoryResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Directory
directory