{-# 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.WorkDocs.GetFolder
-- 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 the metadata of the specified folder.
module Amazonka.WorkDocs.GetFolder
  ( -- * Creating a Request
    GetFolder (..),
    newGetFolder,

    -- * Request Lenses
    getFolder_authenticationToken,
    getFolder_includeCustomMetadata,
    getFolder_folderId,

    -- * Destructuring the Response
    GetFolderResponse (..),
    newGetFolderResponse,

    -- * Response Lenses
    getFolderResponse_customMetadata,
    getFolderResponse_metadata,
    getFolderResponse_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.WorkDocs.Types

-- | /See:/ 'newGetFolder' smart constructor.
data GetFolder = GetFolder'
  { -- | Amazon WorkDocs authentication token. Not required when using AWS
    -- administrator credentials to access the API.
    GetFolder -> Maybe (Sensitive Text)
authenticationToken :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Set to TRUE to include custom metadata in the response.
    GetFolder -> Maybe Bool
includeCustomMetadata :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the folder.
    GetFolder -> Text
folderId :: Prelude.Text
  }
  deriving (GetFolder -> GetFolder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFolder -> GetFolder -> Bool
$c/= :: GetFolder -> GetFolder -> Bool
== :: GetFolder -> GetFolder -> Bool
$c== :: GetFolder -> GetFolder -> Bool
Prelude.Eq, Int -> GetFolder -> ShowS
[GetFolder] -> ShowS
GetFolder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFolder] -> ShowS
$cshowList :: [GetFolder] -> ShowS
show :: GetFolder -> String
$cshow :: GetFolder -> String
showsPrec :: Int -> GetFolder -> ShowS
$cshowsPrec :: Int -> GetFolder -> ShowS
Prelude.Show, forall x. Rep GetFolder x -> GetFolder
forall x. GetFolder -> Rep GetFolder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFolder x -> GetFolder
$cfrom :: forall x. GetFolder -> Rep GetFolder x
Prelude.Generic)

-- |
-- Create a value of 'GetFolder' 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:
--
-- 'authenticationToken', 'getFolder_authenticationToken' - Amazon WorkDocs authentication token. Not required when using AWS
-- administrator credentials to access the API.
--
-- 'includeCustomMetadata', 'getFolder_includeCustomMetadata' - Set to TRUE to include custom metadata in the response.
--
-- 'folderId', 'getFolder_folderId' - The ID of the folder.
newGetFolder ::
  -- | 'folderId'
  Prelude.Text ->
  GetFolder
newGetFolder :: Text -> GetFolder
newGetFolder Text
pFolderId_ =
  GetFolder'
    { $sel:authenticationToken:GetFolder' :: Maybe (Sensitive Text)
authenticationToken = forall a. Maybe a
Prelude.Nothing,
      $sel:includeCustomMetadata:GetFolder' :: Maybe Bool
includeCustomMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:folderId:GetFolder' :: Text
folderId = Text
pFolderId_
    }

-- | Amazon WorkDocs authentication token. Not required when using AWS
-- administrator credentials to access the API.
getFolder_authenticationToken :: Lens.Lens' GetFolder (Prelude.Maybe Prelude.Text)
getFolder_authenticationToken :: Lens' GetFolder (Maybe Text)
getFolder_authenticationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolder' {Maybe (Sensitive Text)
authenticationToken :: Maybe (Sensitive Text)
$sel:authenticationToken:GetFolder' :: GetFolder -> Maybe (Sensitive Text)
authenticationToken} -> Maybe (Sensitive Text)
authenticationToken) (\s :: GetFolder
s@GetFolder' {} Maybe (Sensitive Text)
a -> GetFolder
s {$sel:authenticationToken:GetFolder' :: Maybe (Sensitive Text)
authenticationToken = Maybe (Sensitive Text)
a} :: GetFolder) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | Set to TRUE to include custom metadata in the response.
getFolder_includeCustomMetadata :: Lens.Lens' GetFolder (Prelude.Maybe Prelude.Bool)
getFolder_includeCustomMetadata :: Lens' GetFolder (Maybe Bool)
getFolder_includeCustomMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolder' {Maybe Bool
includeCustomMetadata :: Maybe Bool
$sel:includeCustomMetadata:GetFolder' :: GetFolder -> Maybe Bool
includeCustomMetadata} -> Maybe Bool
includeCustomMetadata) (\s :: GetFolder
s@GetFolder' {} Maybe Bool
a -> GetFolder
s {$sel:includeCustomMetadata:GetFolder' :: Maybe Bool
includeCustomMetadata = Maybe Bool
a} :: GetFolder)

-- | The ID of the folder.
getFolder_folderId :: Lens.Lens' GetFolder Prelude.Text
getFolder_folderId :: Lens' GetFolder Text
getFolder_folderId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolder' {Text
folderId :: Text
$sel:folderId:GetFolder' :: GetFolder -> Text
folderId} -> Text
folderId) (\s :: GetFolder
s@GetFolder' {} Text
a -> GetFolder
s {$sel:folderId:GetFolder' :: Text
folderId = Text
a} :: GetFolder)

instance Core.AWSRequest GetFolder where
  type AWSResponse GetFolder = GetFolderResponse
  request :: (Service -> Service) -> GetFolder -> Request GetFolder
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetFolder
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetFolder)))
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 (HashMap Text Text)
-> Maybe FolderMetadata -> Int -> GetFolderResponse
GetFolderResponse'
            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
"CustomMetadata" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Metadata")
            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 GetFolder where
  hashWithSalt :: Int -> GetFolder -> Int
hashWithSalt Int
_salt GetFolder' {Maybe Bool
Maybe (Sensitive Text)
Text
folderId :: Text
includeCustomMetadata :: Maybe Bool
authenticationToken :: Maybe (Sensitive Text)
$sel:folderId:GetFolder' :: GetFolder -> Text
$sel:includeCustomMetadata:GetFolder' :: GetFolder -> Maybe Bool
$sel:authenticationToken:GetFolder' :: GetFolder -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
authenticationToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeCustomMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
folderId

instance Prelude.NFData GetFolder where
  rnf :: GetFolder -> ()
rnf GetFolder' {Maybe Bool
Maybe (Sensitive Text)
Text
folderId :: Text
includeCustomMetadata :: Maybe Bool
authenticationToken :: Maybe (Sensitive Text)
$sel:folderId:GetFolder' :: GetFolder -> Text
$sel:includeCustomMetadata:GetFolder' :: GetFolder -> Maybe Bool
$sel:authenticationToken:GetFolder' :: GetFolder -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
authenticationToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeCustomMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
folderId

instance Data.ToHeaders GetFolder where
  toHeaders :: GetFolder -> ResponseHeaders
toHeaders GetFolder' {Maybe Bool
Maybe (Sensitive Text)
Text
folderId :: Text
includeCustomMetadata :: Maybe Bool
authenticationToken :: Maybe (Sensitive Text)
$sel:folderId:GetFolder' :: GetFolder -> Text
$sel:includeCustomMetadata:GetFolder' :: GetFolder -> Maybe Bool
$sel:authenticationToken:GetFolder' :: GetFolder -> Maybe (Sensitive Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"Authentication" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe (Sensitive Text)
authenticationToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToPath GetFolder where
  toPath :: GetFolder -> ByteString
toPath GetFolder' {Maybe Bool
Maybe (Sensitive Text)
Text
folderId :: Text
includeCustomMetadata :: Maybe Bool
authenticationToken :: Maybe (Sensitive Text)
$sel:folderId:GetFolder' :: GetFolder -> Text
$sel:includeCustomMetadata:GetFolder' :: GetFolder -> Maybe Bool
$sel:authenticationToken:GetFolder' :: GetFolder -> Maybe (Sensitive Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/api/v1/folders/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
folderId]

instance Data.ToQuery GetFolder where
  toQuery :: GetFolder -> QueryString
toQuery GetFolder' {Maybe Bool
Maybe (Sensitive Text)
Text
folderId :: Text
includeCustomMetadata :: Maybe Bool
authenticationToken :: Maybe (Sensitive Text)
$sel:folderId:GetFolder' :: GetFolder -> Text
$sel:includeCustomMetadata:GetFolder' :: GetFolder -> Maybe Bool
$sel:authenticationToken:GetFolder' :: GetFolder -> Maybe (Sensitive Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"includeCustomMetadata"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
includeCustomMetadata
      ]

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

-- |
-- Create a value of 'GetFolderResponse' 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:
--
-- 'customMetadata', 'getFolderResponse_customMetadata' - The custom metadata on the folder.
--
-- 'metadata', 'getFolderResponse_metadata' - The metadata of the folder.
--
-- 'httpStatus', 'getFolderResponse_httpStatus' - The response's http status code.
newGetFolderResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetFolderResponse
newGetFolderResponse :: Int -> GetFolderResponse
newGetFolderResponse Int
pHttpStatus_ =
  GetFolderResponse'
    { $sel:customMetadata:GetFolderResponse' :: Maybe (HashMap Text Text)
customMetadata =
        forall a. Maybe a
Prelude.Nothing,
      $sel:metadata:GetFolderResponse' :: Maybe FolderMetadata
metadata = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetFolderResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The custom metadata on the folder.
getFolderResponse_customMetadata :: Lens.Lens' GetFolderResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getFolderResponse_customMetadata :: Lens' GetFolderResponse (Maybe (HashMap Text Text))
getFolderResponse_customMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolderResponse' {Maybe (HashMap Text Text)
customMetadata :: Maybe (HashMap Text Text)
$sel:customMetadata:GetFolderResponse' :: GetFolderResponse -> Maybe (HashMap Text Text)
customMetadata} -> Maybe (HashMap Text Text)
customMetadata) (\s :: GetFolderResponse
s@GetFolderResponse' {} Maybe (HashMap Text Text)
a -> GetFolderResponse
s {$sel:customMetadata:GetFolderResponse' :: Maybe (HashMap Text Text)
customMetadata = Maybe (HashMap Text Text)
a} :: GetFolderResponse) 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 metadata of the folder.
getFolderResponse_metadata :: Lens.Lens' GetFolderResponse (Prelude.Maybe FolderMetadata)
getFolderResponse_metadata :: Lens' GetFolderResponse (Maybe FolderMetadata)
getFolderResponse_metadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolderResponse' {Maybe FolderMetadata
metadata :: Maybe FolderMetadata
$sel:metadata:GetFolderResponse' :: GetFolderResponse -> Maybe FolderMetadata
metadata} -> Maybe FolderMetadata
metadata) (\s :: GetFolderResponse
s@GetFolderResponse' {} Maybe FolderMetadata
a -> GetFolderResponse
s {$sel:metadata:GetFolderResponse' :: Maybe FolderMetadata
metadata = Maybe FolderMetadata
a} :: GetFolderResponse)

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

instance Prelude.NFData GetFolderResponse where
  rnf :: GetFolderResponse -> ()
rnf GetFolderResponse' {Int
Maybe (HashMap Text Text)
Maybe FolderMetadata
httpStatus :: Int
metadata :: Maybe FolderMetadata
customMetadata :: Maybe (HashMap Text Text)
$sel:httpStatus:GetFolderResponse' :: GetFolderResponse -> Int
$sel:metadata:GetFolderResponse' :: GetFolderResponse -> Maybe FolderMetadata
$sel:customMetadata:GetFolderResponse' :: GetFolderResponse -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
customMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FolderMetadata
metadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus