{-# 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.ShareDirectory
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Shares a specified directory (@DirectoryId@) in your Amazon Web Services
-- account (directory owner) with another Amazon Web Services account
-- (directory consumer). With this operation you can use your directory
-- from any Amazon Web Services account and from any Amazon VPC within an
-- Amazon Web Services Region.
--
-- When you share your Managed Microsoft AD directory, Directory Service
-- creates a shared directory in the directory consumer account. This
-- shared directory contains the metadata to provide access to the
-- directory within the directory owner account. The shared directory is
-- visible in all VPCs in the directory consumer account.
--
-- The @ShareMethod@ parameter determines whether the specified directory
-- can be shared between Amazon Web Services accounts inside the same
-- Amazon Web Services organization (@ORGANIZATIONS@). It also determines
-- whether you can share the directory with any other Amazon Web Services
-- account either inside or outside of the organization (@HANDSHAKE@).
--
-- The @ShareNotes@ parameter is only used when @HANDSHAKE@ is called,
-- which sends a directory sharing request to the directory consumer.
module Amazonka.DirectoryService.ShareDirectory
  ( -- * Creating a Request
    ShareDirectory (..),
    newShareDirectory,

    -- * Request Lenses
    shareDirectory_shareNotes,
    shareDirectory_directoryId,
    shareDirectory_shareTarget,
    shareDirectory_shareMethod,

    -- * Destructuring the Response
    ShareDirectoryResponse (..),
    newShareDirectoryResponse,

    -- * Response Lenses
    shareDirectoryResponse_sharedDirectoryId,
    shareDirectoryResponse_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:/ 'newShareDirectory' smart constructor.
data ShareDirectory = ShareDirectory'
  { -- | A directory share request that is sent by the directory owner to the
    -- directory consumer. The request includes a typed message to help the
    -- directory consumer administrator determine whether to approve or reject
    -- the share invitation.
    ShareDirectory -> Maybe (Sensitive Text)
shareNotes :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Identifier of the Managed Microsoft AD directory that you want to share
    -- with other Amazon Web Services accounts.
    ShareDirectory -> Text
directoryId :: Prelude.Text,
    -- | Identifier for the directory consumer account with whom the directory is
    -- to be shared.
    ShareDirectory -> ShareTarget
shareTarget :: ShareTarget,
    -- | The method used when sharing a directory to determine whether the
    -- directory should be shared within your Amazon Web Services organization
    -- (@ORGANIZATIONS@) or with any Amazon Web Services account by sending a
    -- directory sharing request (@HANDSHAKE@).
    ShareDirectory -> ShareMethod
shareMethod :: ShareMethod
  }
  deriving (ShareDirectory -> ShareDirectory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShareDirectory -> ShareDirectory -> Bool
$c/= :: ShareDirectory -> ShareDirectory -> Bool
== :: ShareDirectory -> ShareDirectory -> Bool
$c== :: ShareDirectory -> ShareDirectory -> Bool
Prelude.Eq, Int -> ShareDirectory -> ShowS
[ShareDirectory] -> ShowS
ShareDirectory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShareDirectory] -> ShowS
$cshowList :: [ShareDirectory] -> ShowS
show :: ShareDirectory -> String
$cshow :: ShareDirectory -> String
showsPrec :: Int -> ShareDirectory -> ShowS
$cshowsPrec :: Int -> ShareDirectory -> ShowS
Prelude.Show, forall x. Rep ShareDirectory x -> ShareDirectory
forall x. ShareDirectory -> Rep ShareDirectory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShareDirectory x -> ShareDirectory
$cfrom :: forall x. ShareDirectory -> Rep ShareDirectory x
Prelude.Generic)

-- |
-- Create a value of 'ShareDirectory' 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:
--
-- 'shareNotes', 'shareDirectory_shareNotes' - A directory share request that is sent by the directory owner to the
-- directory consumer. The request includes a typed message to help the
-- directory consumer administrator determine whether to approve or reject
-- the share invitation.
--
-- 'directoryId', 'shareDirectory_directoryId' - Identifier of the Managed Microsoft AD directory that you want to share
-- with other Amazon Web Services accounts.
--
-- 'shareTarget', 'shareDirectory_shareTarget' - Identifier for the directory consumer account with whom the directory is
-- to be shared.
--
-- 'shareMethod', 'shareDirectory_shareMethod' - The method used when sharing a directory to determine whether the
-- directory should be shared within your Amazon Web Services organization
-- (@ORGANIZATIONS@) or with any Amazon Web Services account by sending a
-- directory sharing request (@HANDSHAKE@).
newShareDirectory ::
  -- | 'directoryId'
  Prelude.Text ->
  -- | 'shareTarget'
  ShareTarget ->
  -- | 'shareMethod'
  ShareMethod ->
  ShareDirectory
newShareDirectory :: Text -> ShareTarget -> ShareMethod -> ShareDirectory
newShareDirectory
  Text
pDirectoryId_
  ShareTarget
pShareTarget_
  ShareMethod
pShareMethod_ =
    ShareDirectory'
      { $sel:shareNotes:ShareDirectory' :: Maybe (Sensitive Text)
shareNotes = forall a. Maybe a
Prelude.Nothing,
        $sel:directoryId:ShareDirectory' :: Text
directoryId = Text
pDirectoryId_,
        $sel:shareTarget:ShareDirectory' :: ShareTarget
shareTarget = ShareTarget
pShareTarget_,
        $sel:shareMethod:ShareDirectory' :: ShareMethod
shareMethod = ShareMethod
pShareMethod_
      }

-- | A directory share request that is sent by the directory owner to the
-- directory consumer. The request includes a typed message to help the
-- directory consumer administrator determine whether to approve or reject
-- the share invitation.
shareDirectory_shareNotes :: Lens.Lens' ShareDirectory (Prelude.Maybe Prelude.Text)
shareDirectory_shareNotes :: Lens' ShareDirectory (Maybe Text)
shareDirectory_shareNotes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ShareDirectory' {Maybe (Sensitive Text)
shareNotes :: Maybe (Sensitive Text)
$sel:shareNotes:ShareDirectory' :: ShareDirectory -> Maybe (Sensitive Text)
shareNotes} -> Maybe (Sensitive Text)
shareNotes) (\s :: ShareDirectory
s@ShareDirectory' {} Maybe (Sensitive Text)
a -> ShareDirectory
s {$sel:shareNotes:ShareDirectory' :: Maybe (Sensitive Text)
shareNotes = Maybe (Sensitive Text)
a} :: ShareDirectory) 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

-- | Identifier of the Managed Microsoft AD directory that you want to share
-- with other Amazon Web Services accounts.
shareDirectory_directoryId :: Lens.Lens' ShareDirectory Prelude.Text
shareDirectory_directoryId :: Lens' ShareDirectory Text
shareDirectory_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ShareDirectory' {Text
directoryId :: Text
$sel:directoryId:ShareDirectory' :: ShareDirectory -> Text
directoryId} -> Text
directoryId) (\s :: ShareDirectory
s@ShareDirectory' {} Text
a -> ShareDirectory
s {$sel:directoryId:ShareDirectory' :: Text
directoryId = Text
a} :: ShareDirectory)

-- | Identifier for the directory consumer account with whom the directory is
-- to be shared.
shareDirectory_shareTarget :: Lens.Lens' ShareDirectory ShareTarget
shareDirectory_shareTarget :: Lens' ShareDirectory ShareTarget
shareDirectory_shareTarget = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ShareDirectory' {ShareTarget
shareTarget :: ShareTarget
$sel:shareTarget:ShareDirectory' :: ShareDirectory -> ShareTarget
shareTarget} -> ShareTarget
shareTarget) (\s :: ShareDirectory
s@ShareDirectory' {} ShareTarget
a -> ShareDirectory
s {$sel:shareTarget:ShareDirectory' :: ShareTarget
shareTarget = ShareTarget
a} :: ShareDirectory)

-- | The method used when sharing a directory to determine whether the
-- directory should be shared within your Amazon Web Services organization
-- (@ORGANIZATIONS@) or with any Amazon Web Services account by sending a
-- directory sharing request (@HANDSHAKE@).
shareDirectory_shareMethod :: Lens.Lens' ShareDirectory ShareMethod
shareDirectory_shareMethod :: Lens' ShareDirectory ShareMethod
shareDirectory_shareMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ShareDirectory' {ShareMethod
shareMethod :: ShareMethod
$sel:shareMethod:ShareDirectory' :: ShareDirectory -> ShareMethod
shareMethod} -> ShareMethod
shareMethod) (\s :: ShareDirectory
s@ShareDirectory' {} ShareMethod
a -> ShareDirectory
s {$sel:shareMethod:ShareDirectory' :: ShareMethod
shareMethod = ShareMethod
a} :: ShareDirectory)

instance Core.AWSRequest ShareDirectory where
  type
    AWSResponse ShareDirectory =
      ShareDirectoryResponse
  request :: (Service -> Service) -> ShareDirectory -> Request ShareDirectory
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 ShareDirectory
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ShareDirectory)))
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 -> ShareDirectoryResponse
ShareDirectoryResponse'
            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
"SharedDirectoryId")
            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 ShareDirectory where
  hashWithSalt :: Int -> ShareDirectory -> Int
hashWithSalt Int
_salt ShareDirectory' {Maybe (Sensitive Text)
Text
ShareMethod
ShareTarget
shareMethod :: ShareMethod
shareTarget :: ShareTarget
directoryId :: Text
shareNotes :: Maybe (Sensitive Text)
$sel:shareMethod:ShareDirectory' :: ShareDirectory -> ShareMethod
$sel:shareTarget:ShareDirectory' :: ShareDirectory -> ShareTarget
$sel:directoryId:ShareDirectory' :: ShareDirectory -> Text
$sel:shareNotes:ShareDirectory' :: ShareDirectory -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
shareNotes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ShareTarget
shareTarget
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ShareMethod
shareMethod

instance Prelude.NFData ShareDirectory where
  rnf :: ShareDirectory -> ()
rnf ShareDirectory' {Maybe (Sensitive Text)
Text
ShareMethod
ShareTarget
shareMethod :: ShareMethod
shareTarget :: ShareTarget
directoryId :: Text
shareNotes :: Maybe (Sensitive Text)
$sel:shareMethod:ShareDirectory' :: ShareDirectory -> ShareMethod
$sel:shareTarget:ShareDirectory' :: ShareDirectory -> ShareTarget
$sel:directoryId:ShareDirectory' :: ShareDirectory -> Text
$sel:shareNotes:ShareDirectory' :: ShareDirectory -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
shareNotes
      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 ShareTarget
shareTarget
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ShareMethod
shareMethod

instance Data.ToHeaders ShareDirectory where
  toHeaders :: ShareDirectory -> 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.ShareDirectory" ::
                          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 ShareDirectory where
  toJSON :: ShareDirectory -> Value
toJSON ShareDirectory' {Maybe (Sensitive Text)
Text
ShareMethod
ShareTarget
shareMethod :: ShareMethod
shareTarget :: ShareTarget
directoryId :: Text
shareNotes :: Maybe (Sensitive Text)
$sel:shareMethod:ShareDirectory' :: ShareDirectory -> ShareMethod
$sel:shareTarget:ShareDirectory' :: ShareDirectory -> ShareTarget
$sel:directoryId:ShareDirectory' :: ShareDirectory -> Text
$sel:shareNotes:ShareDirectory' :: ShareDirectory -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ShareNotes" 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 (Sensitive Text)
shareNotes,
            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
"ShareTarget" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ShareTarget
shareTarget),
            forall a. a -> Maybe a
Prelude.Just (Key
"ShareMethod" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ShareMethod
shareMethod)
          ]
      )

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

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

-- | /See:/ 'newShareDirectoryResponse' smart constructor.
data ShareDirectoryResponse = ShareDirectoryResponse'
  { -- | Identifier of the directory that is stored in the directory consumer
    -- account that is shared from the specified directory (@DirectoryId@).
    ShareDirectoryResponse -> Maybe Text
sharedDirectoryId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ShareDirectoryResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ShareDirectoryResponse -> ShareDirectoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShareDirectoryResponse -> ShareDirectoryResponse -> Bool
$c/= :: ShareDirectoryResponse -> ShareDirectoryResponse -> Bool
== :: ShareDirectoryResponse -> ShareDirectoryResponse -> Bool
$c== :: ShareDirectoryResponse -> ShareDirectoryResponse -> Bool
Prelude.Eq, ReadPrec [ShareDirectoryResponse]
ReadPrec ShareDirectoryResponse
Int -> ReadS ShareDirectoryResponse
ReadS [ShareDirectoryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ShareDirectoryResponse]
$creadListPrec :: ReadPrec [ShareDirectoryResponse]
readPrec :: ReadPrec ShareDirectoryResponse
$creadPrec :: ReadPrec ShareDirectoryResponse
readList :: ReadS [ShareDirectoryResponse]
$creadList :: ReadS [ShareDirectoryResponse]
readsPrec :: Int -> ReadS ShareDirectoryResponse
$creadsPrec :: Int -> ReadS ShareDirectoryResponse
Prelude.Read, Int -> ShareDirectoryResponse -> ShowS
[ShareDirectoryResponse] -> ShowS
ShareDirectoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShareDirectoryResponse] -> ShowS
$cshowList :: [ShareDirectoryResponse] -> ShowS
show :: ShareDirectoryResponse -> String
$cshow :: ShareDirectoryResponse -> String
showsPrec :: Int -> ShareDirectoryResponse -> ShowS
$cshowsPrec :: Int -> ShareDirectoryResponse -> ShowS
Prelude.Show, forall x. Rep ShareDirectoryResponse x -> ShareDirectoryResponse
forall x. ShareDirectoryResponse -> Rep ShareDirectoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShareDirectoryResponse x -> ShareDirectoryResponse
$cfrom :: forall x. ShareDirectoryResponse -> Rep ShareDirectoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'ShareDirectoryResponse' 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:
--
-- 'sharedDirectoryId', 'shareDirectoryResponse_sharedDirectoryId' - Identifier of the directory that is stored in the directory consumer
-- account that is shared from the specified directory (@DirectoryId@).
--
-- 'httpStatus', 'shareDirectoryResponse_httpStatus' - The response's http status code.
newShareDirectoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ShareDirectoryResponse
newShareDirectoryResponse :: Int -> ShareDirectoryResponse
newShareDirectoryResponse Int
pHttpStatus_ =
  ShareDirectoryResponse'
    { $sel:sharedDirectoryId:ShareDirectoryResponse' :: Maybe Text
sharedDirectoryId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ShareDirectoryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Identifier of the directory that is stored in the directory consumer
-- account that is shared from the specified directory (@DirectoryId@).
shareDirectoryResponse_sharedDirectoryId :: Lens.Lens' ShareDirectoryResponse (Prelude.Maybe Prelude.Text)
shareDirectoryResponse_sharedDirectoryId :: Lens' ShareDirectoryResponse (Maybe Text)
shareDirectoryResponse_sharedDirectoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ShareDirectoryResponse' {Maybe Text
sharedDirectoryId :: Maybe Text
$sel:sharedDirectoryId:ShareDirectoryResponse' :: ShareDirectoryResponse -> Maybe Text
sharedDirectoryId} -> Maybe Text
sharedDirectoryId) (\s :: ShareDirectoryResponse
s@ShareDirectoryResponse' {} Maybe Text
a -> ShareDirectoryResponse
s {$sel:sharedDirectoryId:ShareDirectoryResponse' :: Maybe Text
sharedDirectoryId = Maybe Text
a} :: ShareDirectoryResponse)

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

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