{-# 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.CreateObject
-- 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 object in a Directory. Additionally attaches the object to a
-- parent, if a parent reference and @LinkName@ is specified. An object is
-- simply a collection of Facet attributes. You can also use this API call
-- to create a policy object, if the facet from which you create the object
-- is a policy facet.
module Amazonka.CloudDirectory.CreateObject
  ( -- * Creating a Request
    CreateObject (..),
    newCreateObject,

    -- * Request Lenses
    createObject_linkName,
    createObject_objectAttributeList,
    createObject_parentReference,
    createObject_directoryArn,
    createObject_schemaFacets,

    -- * Destructuring the Response
    CreateObjectResponse (..),
    newCreateObjectResponse,

    -- * Response Lenses
    createObjectResponse_objectIdentifier,
    createObjectResponse_httpStatus,
  )
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:/ 'newCreateObject' smart constructor.
data CreateObject = CreateObject'
  { -- | The name of link that is used to attach this object to a parent.
    CreateObject -> Maybe Text
linkName :: Prelude.Maybe Prelude.Text,
    -- | The attribute map whose attribute ARN contains the key and attribute
    -- value as the map value.
    CreateObject -> Maybe [AttributeKeyAndValue]
objectAttributeList :: Prelude.Maybe [AttributeKeyAndValue],
    -- | If specified, the parent reference to which this object will be
    -- attached.
    CreateObject -> Maybe ObjectReference
parentReference :: Prelude.Maybe ObjectReference,
    -- | The Amazon Resource Name (ARN) that is associated with the Directory in
    -- which the object will be created. For more information, see arns.
    CreateObject -> Text
directoryArn :: Prelude.Text,
    -- | A list of schema facets to be associated with the object. Do not provide
    -- minor version components. See SchemaFacet for details.
    CreateObject -> [SchemaFacet]
schemaFacets :: [SchemaFacet]
  }
  deriving (CreateObject -> CreateObject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateObject -> CreateObject -> Bool
$c/= :: CreateObject -> CreateObject -> Bool
== :: CreateObject -> CreateObject -> Bool
$c== :: CreateObject -> CreateObject -> Bool
Prelude.Eq, ReadPrec [CreateObject]
ReadPrec CreateObject
Int -> ReadS CreateObject
ReadS [CreateObject]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateObject]
$creadListPrec :: ReadPrec [CreateObject]
readPrec :: ReadPrec CreateObject
$creadPrec :: ReadPrec CreateObject
readList :: ReadS [CreateObject]
$creadList :: ReadS [CreateObject]
readsPrec :: Int -> ReadS CreateObject
$creadsPrec :: Int -> ReadS CreateObject
Prelude.Read, Int -> CreateObject -> ShowS
[CreateObject] -> ShowS
CreateObject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateObject] -> ShowS
$cshowList :: [CreateObject] -> ShowS
show :: CreateObject -> String
$cshow :: CreateObject -> String
showsPrec :: Int -> CreateObject -> ShowS
$cshowsPrec :: Int -> CreateObject -> ShowS
Prelude.Show, forall x. Rep CreateObject x -> CreateObject
forall x. CreateObject -> Rep CreateObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateObject x -> CreateObject
$cfrom :: forall x. CreateObject -> Rep CreateObject x
Prelude.Generic)

-- |
-- Create a value of 'CreateObject' 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:
--
-- 'linkName', 'createObject_linkName' - The name of link that is used to attach this object to a parent.
--
-- 'objectAttributeList', 'createObject_objectAttributeList' - The attribute map whose attribute ARN contains the key and attribute
-- value as the map value.
--
-- 'parentReference', 'createObject_parentReference' - If specified, the parent reference to which this object will be
-- attached.
--
-- 'directoryArn', 'createObject_directoryArn' - The Amazon Resource Name (ARN) that is associated with the Directory in
-- which the object will be created. For more information, see arns.
--
-- 'schemaFacets', 'createObject_schemaFacets' - A list of schema facets to be associated with the object. Do not provide
-- minor version components. See SchemaFacet for details.
newCreateObject ::
  -- | 'directoryArn'
  Prelude.Text ->
  CreateObject
newCreateObject :: Text -> CreateObject
newCreateObject Text
pDirectoryArn_ =
  CreateObject'
    { $sel:linkName:CreateObject' :: Maybe Text
linkName = forall a. Maybe a
Prelude.Nothing,
      $sel:objectAttributeList:CreateObject' :: Maybe [AttributeKeyAndValue]
objectAttributeList = forall a. Maybe a
Prelude.Nothing,
      $sel:parentReference:CreateObject' :: Maybe ObjectReference
parentReference = forall a. Maybe a
Prelude.Nothing,
      $sel:directoryArn:CreateObject' :: Text
directoryArn = Text
pDirectoryArn_,
      $sel:schemaFacets:CreateObject' :: [SchemaFacet]
schemaFacets = forall a. Monoid a => a
Prelude.mempty
    }

-- | The name of link that is used to attach this object to a parent.
createObject_linkName :: Lens.Lens' CreateObject (Prelude.Maybe Prelude.Text)
createObject_linkName :: Lens' CreateObject (Maybe Text)
createObject_linkName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateObject' {Maybe Text
linkName :: Maybe Text
$sel:linkName:CreateObject' :: CreateObject -> Maybe Text
linkName} -> Maybe Text
linkName) (\s :: CreateObject
s@CreateObject' {} Maybe Text
a -> CreateObject
s {$sel:linkName:CreateObject' :: Maybe Text
linkName = Maybe Text
a} :: CreateObject)

-- | The attribute map whose attribute ARN contains the key and attribute
-- value as the map value.
createObject_objectAttributeList :: Lens.Lens' CreateObject (Prelude.Maybe [AttributeKeyAndValue])
createObject_objectAttributeList :: Lens' CreateObject (Maybe [AttributeKeyAndValue])
createObject_objectAttributeList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateObject' {Maybe [AttributeKeyAndValue]
objectAttributeList :: Maybe [AttributeKeyAndValue]
$sel:objectAttributeList:CreateObject' :: CreateObject -> Maybe [AttributeKeyAndValue]
objectAttributeList} -> Maybe [AttributeKeyAndValue]
objectAttributeList) (\s :: CreateObject
s@CreateObject' {} Maybe [AttributeKeyAndValue]
a -> CreateObject
s {$sel:objectAttributeList:CreateObject' :: Maybe [AttributeKeyAndValue]
objectAttributeList = Maybe [AttributeKeyAndValue]
a} :: CreateObject) 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

-- | If specified, the parent reference to which this object will be
-- attached.
createObject_parentReference :: Lens.Lens' CreateObject (Prelude.Maybe ObjectReference)
createObject_parentReference :: Lens' CreateObject (Maybe ObjectReference)
createObject_parentReference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateObject' {Maybe ObjectReference
parentReference :: Maybe ObjectReference
$sel:parentReference:CreateObject' :: CreateObject -> Maybe ObjectReference
parentReference} -> Maybe ObjectReference
parentReference) (\s :: CreateObject
s@CreateObject' {} Maybe ObjectReference
a -> CreateObject
s {$sel:parentReference:CreateObject' :: Maybe ObjectReference
parentReference = Maybe ObjectReference
a} :: CreateObject)

-- | The Amazon Resource Name (ARN) that is associated with the Directory in
-- which the object will be created. For more information, see arns.
createObject_directoryArn :: Lens.Lens' CreateObject Prelude.Text
createObject_directoryArn :: Lens' CreateObject Text
createObject_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateObject' {Text
directoryArn :: Text
$sel:directoryArn:CreateObject' :: CreateObject -> Text
directoryArn} -> Text
directoryArn) (\s :: CreateObject
s@CreateObject' {} Text
a -> CreateObject
s {$sel:directoryArn:CreateObject' :: Text
directoryArn = Text
a} :: CreateObject)

-- | A list of schema facets to be associated with the object. Do not provide
-- minor version components. See SchemaFacet for details.
createObject_schemaFacets :: Lens.Lens' CreateObject [SchemaFacet]
createObject_schemaFacets :: Lens' CreateObject [SchemaFacet]
createObject_schemaFacets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateObject' {[SchemaFacet]
schemaFacets :: [SchemaFacet]
$sel:schemaFacets:CreateObject' :: CreateObject -> [SchemaFacet]
schemaFacets} -> [SchemaFacet]
schemaFacets) (\s :: CreateObject
s@CreateObject' {} [SchemaFacet]
a -> CreateObject
s {$sel:schemaFacets:CreateObject' :: [SchemaFacet]
schemaFacets = [SchemaFacet]
a} :: CreateObject) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateObject where
  type AWSResponse CreateObject = CreateObjectResponse
  request :: (Service -> Service) -> CreateObject -> Request CreateObject
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateObject
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateObject)))
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 -> CreateObjectResponse
CreateObjectResponse'
            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
"ObjectIdentifier")
            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 CreateObject where
  hashWithSalt :: Int -> CreateObject -> Int
hashWithSalt Int
_salt CreateObject' {[SchemaFacet]
Maybe [AttributeKeyAndValue]
Maybe Text
Maybe ObjectReference
Text
schemaFacets :: [SchemaFacet]
directoryArn :: Text
parentReference :: Maybe ObjectReference
objectAttributeList :: Maybe [AttributeKeyAndValue]
linkName :: Maybe Text
$sel:schemaFacets:CreateObject' :: CreateObject -> [SchemaFacet]
$sel:directoryArn:CreateObject' :: CreateObject -> Text
$sel:parentReference:CreateObject' :: CreateObject -> Maybe ObjectReference
$sel:objectAttributeList:CreateObject' :: CreateObject -> Maybe [AttributeKeyAndValue]
$sel:linkName:CreateObject' :: CreateObject -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
linkName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AttributeKeyAndValue]
objectAttributeList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ObjectReference
parentReference
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [SchemaFacet]
schemaFacets

instance Prelude.NFData CreateObject where
  rnf :: CreateObject -> ()
rnf CreateObject' {[SchemaFacet]
Maybe [AttributeKeyAndValue]
Maybe Text
Maybe ObjectReference
Text
schemaFacets :: [SchemaFacet]
directoryArn :: Text
parentReference :: Maybe ObjectReference
objectAttributeList :: Maybe [AttributeKeyAndValue]
linkName :: Maybe Text
$sel:schemaFacets:CreateObject' :: CreateObject -> [SchemaFacet]
$sel:directoryArn:CreateObject' :: CreateObject -> Text
$sel:parentReference:CreateObject' :: CreateObject -> Maybe ObjectReference
$sel:objectAttributeList:CreateObject' :: CreateObject -> Maybe [AttributeKeyAndValue]
$sel:linkName:CreateObject' :: CreateObject -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
linkName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [AttributeKeyAndValue]
objectAttributeList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ObjectReference
parentReference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
directoryArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [SchemaFacet]
schemaFacets

instance Data.ToHeaders CreateObject where
  toHeaders :: CreateObject -> ResponseHeaders
toHeaders CreateObject' {[SchemaFacet]
Maybe [AttributeKeyAndValue]
Maybe Text
Maybe ObjectReference
Text
schemaFacets :: [SchemaFacet]
directoryArn :: Text
parentReference :: Maybe ObjectReference
objectAttributeList :: Maybe [AttributeKeyAndValue]
linkName :: Maybe Text
$sel:schemaFacets:CreateObject' :: CreateObject -> [SchemaFacet]
$sel:directoryArn:CreateObject' :: CreateObject -> Text
$sel:parentReference:CreateObject' :: CreateObject -> Maybe ObjectReference
$sel:objectAttributeList:CreateObject' :: CreateObject -> Maybe [AttributeKeyAndValue]
$sel:linkName:CreateObject' :: CreateObject -> Maybe 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 CreateObject where
  toJSON :: CreateObject -> Value
toJSON CreateObject' {[SchemaFacet]
Maybe [AttributeKeyAndValue]
Maybe Text
Maybe ObjectReference
Text
schemaFacets :: [SchemaFacet]
directoryArn :: Text
parentReference :: Maybe ObjectReference
objectAttributeList :: Maybe [AttributeKeyAndValue]
linkName :: Maybe Text
$sel:schemaFacets:CreateObject' :: CreateObject -> [SchemaFacet]
$sel:directoryArn:CreateObject' :: CreateObject -> Text
$sel:parentReference:CreateObject' :: CreateObject -> Maybe ObjectReference
$sel:objectAttributeList:CreateObject' :: CreateObject -> Maybe [AttributeKeyAndValue]
$sel:linkName:CreateObject' :: CreateObject -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"LinkName" 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
linkName,
            (Key
"ObjectAttributeList" 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 [AttributeKeyAndValue]
objectAttributeList,
            (Key
"ParentReference" 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 ObjectReference
parentReference,
            forall a. a -> Maybe a
Prelude.Just (Key
"SchemaFacets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [SchemaFacet]
schemaFacets)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateObjectResponse' 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:
--
-- 'objectIdentifier', 'createObjectResponse_objectIdentifier' - The identifier that is associated with the object.
--
-- 'httpStatus', 'createObjectResponse_httpStatus' - The response's http status code.
newCreateObjectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateObjectResponse
newCreateObjectResponse :: Int -> CreateObjectResponse
newCreateObjectResponse Int
pHttpStatus_ =
  CreateObjectResponse'
    { $sel:objectIdentifier:CreateObjectResponse' :: Maybe Text
objectIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateObjectResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier that is associated with the object.
createObjectResponse_objectIdentifier :: Lens.Lens' CreateObjectResponse (Prelude.Maybe Prelude.Text)
createObjectResponse_objectIdentifier :: Lens' CreateObjectResponse (Maybe Text)
createObjectResponse_objectIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateObjectResponse' {Maybe Text
objectIdentifier :: Maybe Text
$sel:objectIdentifier:CreateObjectResponse' :: CreateObjectResponse -> Maybe Text
objectIdentifier} -> Maybe Text
objectIdentifier) (\s :: CreateObjectResponse
s@CreateObjectResponse' {} Maybe Text
a -> CreateObjectResponse
s {$sel:objectIdentifier:CreateObjectResponse' :: Maybe Text
objectIdentifier = Maybe Text
a} :: CreateObjectResponse)

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

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