{-# 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.CloudControl.GetResource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about the current state of the specified resource.
-- For details, see
-- <https://docs.aws.amazon.com/cloudcontrolapi/latest/userguide/resource-operations-read.html Reading a resource\'s current state>.
--
-- You can use this action to return information about an existing resource
-- in your account and Amazon Web Services Region, whether those resources
-- were provisioned using Cloud Control API.
module Amazonka.CloudControl.GetResource
  ( -- * Creating a Request
    GetResource (..),
    newGetResource,

    -- * Request Lenses
    getResource_roleArn,
    getResource_typeVersionId,
    getResource_typeName,
    getResource_identifier,

    -- * Destructuring the Response
    GetResourceResponse (..),
    newGetResourceResponse,

    -- * Response Lenses
    getResourceResponse_resourceDescription,
    getResourceResponse_typeName,
    getResourceResponse_httpStatus,
  )
where

import Amazonka.CloudControl.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:/ 'newGetResource' smart constructor.
data GetResource = GetResource'
  { -- | The Amazon Resource Name (ARN) of the Identity and Access Management
    -- (IAM) role for Cloud Control API to use when performing this resource
    -- operation. The role specified must have the permissions required for
    -- this operation. The necessary permissions for each event handler are
    -- defined in the
    -- @ @<https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-schema.html#schema-properties-handlers handlers>@ @
    -- section of the
    -- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-schema.html resource type definition schema>.
    --
    -- If you do not specify a role, Cloud Control API uses a temporary session
    -- created using your Amazon Web Services user credentials.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/cloudcontrolapi/latest/userguide/resource-operations.html#resource-operations-permissions Specifying credentials>
    -- in the /Amazon Web Services Cloud Control API User Guide/.
    GetResource -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | For private resource types, the type version to use in this resource
    -- operation. If you do not specify a resource version, CloudFormation uses
    -- the default version.
    GetResource -> Maybe Text
typeVersionId :: Prelude.Maybe Prelude.Text,
    -- | The name of the resource type.
    GetResource -> Text
typeName :: Prelude.Text,
    -- | The identifier for the resource.
    --
    -- You can specify the primary identifier, or any secondary identifier
    -- defined for the resource type in its resource schema. You can only
    -- specify one identifier. Primary identifiers can be specified as a string
    -- or JSON; secondary identifiers must be specified as JSON.
    --
    -- For compound primary identifiers (that is, one that consists of multiple
    -- resource properties strung together), to specify the primary identifier
    -- as a string, list the property values /in the order they are specified/
    -- in the primary identifier definition, separated by @|@.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/cloudcontrolapi/latest/userguide/resource-identifier.html Identifying resources>
    -- in the /Amazon Web Services Cloud Control API User Guide/.
    GetResource -> Text
identifier :: Prelude.Text
  }
  deriving (GetResource -> GetResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetResource -> GetResource -> Bool
$c/= :: GetResource -> GetResource -> Bool
== :: GetResource -> GetResource -> Bool
$c== :: GetResource -> GetResource -> Bool
Prelude.Eq, ReadPrec [GetResource]
ReadPrec GetResource
Int -> ReadS GetResource
ReadS [GetResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetResource]
$creadListPrec :: ReadPrec [GetResource]
readPrec :: ReadPrec GetResource
$creadPrec :: ReadPrec GetResource
readList :: ReadS [GetResource]
$creadList :: ReadS [GetResource]
readsPrec :: Int -> ReadS GetResource
$creadsPrec :: Int -> ReadS GetResource
Prelude.Read, Int -> GetResource -> ShowS
[GetResource] -> ShowS
GetResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetResource] -> ShowS
$cshowList :: [GetResource] -> ShowS
show :: GetResource -> String
$cshow :: GetResource -> String
showsPrec :: Int -> GetResource -> ShowS
$cshowsPrec :: Int -> GetResource -> ShowS
Prelude.Show, forall x. Rep GetResource x -> GetResource
forall x. GetResource -> Rep GetResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetResource x -> GetResource
$cfrom :: forall x. GetResource -> Rep GetResource x
Prelude.Generic)

-- |
-- Create a value of 'GetResource' 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:
--
-- 'roleArn', 'getResource_roleArn' - The Amazon Resource Name (ARN) of the Identity and Access Management
-- (IAM) role for Cloud Control API to use when performing this resource
-- operation. The role specified must have the permissions required for
-- this operation. The necessary permissions for each event handler are
-- defined in the
-- @ @<https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-schema.html#schema-properties-handlers handlers>@ @
-- section of the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-schema.html resource type definition schema>.
--
-- If you do not specify a role, Cloud Control API uses a temporary session
-- created using your Amazon Web Services user credentials.
--
-- For more information, see
-- <https://docs.aws.amazon.com/cloudcontrolapi/latest/userguide/resource-operations.html#resource-operations-permissions Specifying credentials>
-- in the /Amazon Web Services Cloud Control API User Guide/.
--
-- 'typeVersionId', 'getResource_typeVersionId' - For private resource types, the type version to use in this resource
-- operation. If you do not specify a resource version, CloudFormation uses
-- the default version.
--
-- 'typeName', 'getResource_typeName' - The name of the resource type.
--
-- 'identifier', 'getResource_identifier' - The identifier for the resource.
--
-- You can specify the primary identifier, or any secondary identifier
-- defined for the resource type in its resource schema. You can only
-- specify one identifier. Primary identifiers can be specified as a string
-- or JSON; secondary identifiers must be specified as JSON.
--
-- For compound primary identifiers (that is, one that consists of multiple
-- resource properties strung together), to specify the primary identifier
-- as a string, list the property values /in the order they are specified/
-- in the primary identifier definition, separated by @|@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/cloudcontrolapi/latest/userguide/resource-identifier.html Identifying resources>
-- in the /Amazon Web Services Cloud Control API User Guide/.
newGetResource ::
  -- | 'typeName'
  Prelude.Text ->
  -- | 'identifier'
  Prelude.Text ->
  GetResource
newGetResource :: Text -> Text -> GetResource
newGetResource Text
pTypeName_ Text
pIdentifier_ =
  GetResource'
    { $sel:roleArn:GetResource' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:typeVersionId:GetResource' :: Maybe Text
typeVersionId = forall a. Maybe a
Prelude.Nothing,
      $sel:typeName:GetResource' :: Text
typeName = Text
pTypeName_,
      $sel:identifier:GetResource' :: Text
identifier = Text
pIdentifier_
    }

-- | The Amazon Resource Name (ARN) of the Identity and Access Management
-- (IAM) role for Cloud Control API to use when performing this resource
-- operation. The role specified must have the permissions required for
-- this operation. The necessary permissions for each event handler are
-- defined in the
-- @ @<https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-schema.html#schema-properties-handlers handlers>@ @
-- section of the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-schema.html resource type definition schema>.
--
-- If you do not specify a role, Cloud Control API uses a temporary session
-- created using your Amazon Web Services user credentials.
--
-- For more information, see
-- <https://docs.aws.amazon.com/cloudcontrolapi/latest/userguide/resource-operations.html#resource-operations-permissions Specifying credentials>
-- in the /Amazon Web Services Cloud Control API User Guide/.
getResource_roleArn :: Lens.Lens' GetResource (Prelude.Maybe Prelude.Text)
getResource_roleArn :: Lens' GetResource (Maybe Text)
getResource_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResource' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:GetResource' :: GetResource -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: GetResource
s@GetResource' {} Maybe Text
a -> GetResource
s {$sel:roleArn:GetResource' :: Maybe Text
roleArn = Maybe Text
a} :: GetResource)

-- | For private resource types, the type version to use in this resource
-- operation. If you do not specify a resource version, CloudFormation uses
-- the default version.
getResource_typeVersionId :: Lens.Lens' GetResource (Prelude.Maybe Prelude.Text)
getResource_typeVersionId :: Lens' GetResource (Maybe Text)
getResource_typeVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResource' {Maybe Text
typeVersionId :: Maybe Text
$sel:typeVersionId:GetResource' :: GetResource -> Maybe Text
typeVersionId} -> Maybe Text
typeVersionId) (\s :: GetResource
s@GetResource' {} Maybe Text
a -> GetResource
s {$sel:typeVersionId:GetResource' :: Maybe Text
typeVersionId = Maybe Text
a} :: GetResource)

-- | The name of the resource type.
getResource_typeName :: Lens.Lens' GetResource Prelude.Text
getResource_typeName :: Lens' GetResource Text
getResource_typeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResource' {Text
typeName :: Text
$sel:typeName:GetResource' :: GetResource -> Text
typeName} -> Text
typeName) (\s :: GetResource
s@GetResource' {} Text
a -> GetResource
s {$sel:typeName:GetResource' :: Text
typeName = Text
a} :: GetResource)

-- | The identifier for the resource.
--
-- You can specify the primary identifier, or any secondary identifier
-- defined for the resource type in its resource schema. You can only
-- specify one identifier. Primary identifiers can be specified as a string
-- or JSON; secondary identifiers must be specified as JSON.
--
-- For compound primary identifiers (that is, one that consists of multiple
-- resource properties strung together), to specify the primary identifier
-- as a string, list the property values /in the order they are specified/
-- in the primary identifier definition, separated by @|@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/cloudcontrolapi/latest/userguide/resource-identifier.html Identifying resources>
-- in the /Amazon Web Services Cloud Control API User Guide/.
getResource_identifier :: Lens.Lens' GetResource Prelude.Text
getResource_identifier :: Lens' GetResource Text
getResource_identifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResource' {Text
identifier :: Text
$sel:identifier:GetResource' :: GetResource -> Text
identifier} -> Text
identifier) (\s :: GetResource
s@GetResource' {} Text
a -> GetResource
s {$sel:identifier:GetResource' :: Text
identifier = Text
a} :: GetResource)

instance Core.AWSRequest GetResource where
  type AWSResponse GetResource = GetResourceResponse
  request :: (Service -> Service) -> GetResource -> Request GetResource
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 GetResource
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetResource)))
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 ResourceDescription
-> Maybe Text -> Int -> GetResourceResponse
GetResourceResponse'
            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
"ResourceDescription")
            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
"TypeName")
            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 GetResource where
  hashWithSalt :: Int -> GetResource -> Int
hashWithSalt Int
_salt GetResource' {Maybe Text
Text
identifier :: Text
typeName :: Text
typeVersionId :: Maybe Text
roleArn :: Maybe Text
$sel:identifier:GetResource' :: GetResource -> Text
$sel:typeName:GetResource' :: GetResource -> Text
$sel:typeVersionId:GetResource' :: GetResource -> Maybe Text
$sel:roleArn:GetResource' :: GetResource -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
typeVersionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
typeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identifier

instance Prelude.NFData GetResource where
  rnf :: GetResource -> ()
rnf GetResource' {Maybe Text
Text
identifier :: Text
typeName :: Text
typeVersionId :: Maybe Text
roleArn :: Maybe Text
$sel:identifier:GetResource' :: GetResource -> Text
$sel:typeName:GetResource' :: GetResource -> Text
$sel:typeVersionId:GetResource' :: GetResource -> Maybe Text
$sel:roleArn:GetResource' :: GetResource -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
typeVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
typeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identifier

instance Data.ToHeaders GetResource where
  toHeaders :: GetResource -> 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
"CloudApiService.GetResource" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetResource where
  toJSON :: GetResource -> Value
toJSON GetResource' {Maybe Text
Text
identifier :: Text
typeName :: Text
typeVersionId :: Maybe Text
roleArn :: Maybe Text
$sel:identifier:GetResource' :: GetResource -> Text
$sel:typeName:GetResource' :: GetResource -> Text
$sel:typeVersionId:GetResource' :: GetResource -> Maybe Text
$sel:roleArn:GetResource' :: GetResource -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"RoleArn" 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
roleArn,
            (Key
"TypeVersionId" 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
typeVersionId,
            forall a. a -> Maybe a
Prelude.Just (Key
"TypeName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
typeName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Identifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
identifier)
          ]
      )

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

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

-- | /See:/ 'newGetResourceResponse' smart constructor.
data GetResourceResponse = GetResourceResponse'
  { GetResourceResponse -> Maybe ResourceDescription
resourceDescription :: Prelude.Maybe ResourceDescription,
    -- | The name of the resource type.
    GetResourceResponse -> Maybe Text
typeName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetResourceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetResourceResponse -> GetResourceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetResourceResponse -> GetResourceResponse -> Bool
$c/= :: GetResourceResponse -> GetResourceResponse -> Bool
== :: GetResourceResponse -> GetResourceResponse -> Bool
$c== :: GetResourceResponse -> GetResourceResponse -> Bool
Prelude.Eq, Int -> GetResourceResponse -> ShowS
[GetResourceResponse] -> ShowS
GetResourceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetResourceResponse] -> ShowS
$cshowList :: [GetResourceResponse] -> ShowS
show :: GetResourceResponse -> String
$cshow :: GetResourceResponse -> String
showsPrec :: Int -> GetResourceResponse -> ShowS
$cshowsPrec :: Int -> GetResourceResponse -> ShowS
Prelude.Show, forall x. Rep GetResourceResponse x -> GetResourceResponse
forall x. GetResourceResponse -> Rep GetResourceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetResourceResponse x -> GetResourceResponse
$cfrom :: forall x. GetResourceResponse -> Rep GetResourceResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetResourceResponse' 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:
--
-- 'resourceDescription', 'getResourceResponse_resourceDescription' - Undocumented member.
--
-- 'typeName', 'getResourceResponse_typeName' - The name of the resource type.
--
-- 'httpStatus', 'getResourceResponse_httpStatus' - The response's http status code.
newGetResourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetResourceResponse
newGetResourceResponse :: Int -> GetResourceResponse
newGetResourceResponse Int
pHttpStatus_ =
  GetResourceResponse'
    { $sel:resourceDescription:GetResourceResponse' :: Maybe ResourceDescription
resourceDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:typeName:GetResourceResponse' :: Maybe Text
typeName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetResourceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
getResourceResponse_resourceDescription :: Lens.Lens' GetResourceResponse (Prelude.Maybe ResourceDescription)
getResourceResponse_resourceDescription :: Lens' GetResourceResponse (Maybe ResourceDescription)
getResourceResponse_resourceDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResourceResponse' {Maybe ResourceDescription
resourceDescription :: Maybe ResourceDescription
$sel:resourceDescription:GetResourceResponse' :: GetResourceResponse -> Maybe ResourceDescription
resourceDescription} -> Maybe ResourceDescription
resourceDescription) (\s :: GetResourceResponse
s@GetResourceResponse' {} Maybe ResourceDescription
a -> GetResourceResponse
s {$sel:resourceDescription:GetResourceResponse' :: Maybe ResourceDescription
resourceDescription = Maybe ResourceDescription
a} :: GetResourceResponse)

-- | The name of the resource type.
getResourceResponse_typeName :: Lens.Lens' GetResourceResponse (Prelude.Maybe Prelude.Text)
getResourceResponse_typeName :: Lens' GetResourceResponse (Maybe Text)
getResourceResponse_typeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResourceResponse' {Maybe Text
typeName :: Maybe Text
$sel:typeName:GetResourceResponse' :: GetResourceResponse -> Maybe Text
typeName} -> Maybe Text
typeName) (\s :: GetResourceResponse
s@GetResourceResponse' {} Maybe Text
a -> GetResourceResponse
s {$sel:typeName:GetResourceResponse' :: Maybe Text
typeName = Maybe Text
a} :: GetResourceResponse)

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

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