{-# 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.APIGateway.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)
--
-- Lists information about a resource.
module Amazonka.APIGateway.GetResource
  ( -- * Creating a Request
    GetResource (..),
    newGetResource,

    -- * Request Lenses
    getResource_embed,
    getResource_restApiId,
    getResource_resourceId,

    -- * Destructuring the Response
    Resource (..),
    newResource,

    -- * Response Lenses
    resource_id,
    resource_parentId,
    resource_path,
    resource_pathPart,
    resource_resourceMethods,
  )
where

import Amazonka.APIGateway.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

-- | Request to list information about a resource.
--
-- /See:/ 'newGetResource' smart constructor.
data GetResource = GetResource'
  { -- | A query parameter to retrieve the specified resources embedded in the
    -- returned Resource representation in the response. This @embed@ parameter
    -- value is a list of comma-separated strings. Currently, the request
    -- supports only retrieval of the embedded Method resources this way. The
    -- query parameter value must be a single-valued list and contain the
    -- @\"methods\"@ string. For example,
    -- @GET \/restapis\/{restapi_id}\/resources\/{resource_id}?embed=methods@.
    GetResource -> Maybe [Text]
embed :: Prelude.Maybe [Prelude.Text],
    -- | The string identifier of the associated RestApi.
    GetResource -> Text
restApiId :: Prelude.Text,
    -- | The identifier for the Resource resource.
    GetResource -> Text
resourceId :: 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:
--
-- 'embed', 'getResource_embed' - A query parameter to retrieve the specified resources embedded in the
-- returned Resource representation in the response. This @embed@ parameter
-- value is a list of comma-separated strings. Currently, the request
-- supports only retrieval of the embedded Method resources this way. The
-- query parameter value must be a single-valued list and contain the
-- @\"methods\"@ string. For example,
-- @GET \/restapis\/{restapi_id}\/resources\/{resource_id}?embed=methods@.
--
-- 'restApiId', 'getResource_restApiId' - The string identifier of the associated RestApi.
--
-- 'resourceId', 'getResource_resourceId' - The identifier for the Resource resource.
newGetResource ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  GetResource
newGetResource :: Text -> Text -> GetResource
newGetResource Text
pRestApiId_ Text
pResourceId_ =
  GetResource'
    { $sel:embed:GetResource' :: Maybe [Text]
embed = forall a. Maybe a
Prelude.Nothing,
      $sel:restApiId:GetResource' :: Text
restApiId = Text
pRestApiId_,
      $sel:resourceId:GetResource' :: Text
resourceId = Text
pResourceId_
    }

-- | A query parameter to retrieve the specified resources embedded in the
-- returned Resource representation in the response. This @embed@ parameter
-- value is a list of comma-separated strings. Currently, the request
-- supports only retrieval of the embedded Method resources this way. The
-- query parameter value must be a single-valued list and contain the
-- @\"methods\"@ string. For example,
-- @GET \/restapis\/{restapi_id}\/resources\/{resource_id}?embed=methods@.
getResource_embed :: Lens.Lens' GetResource (Prelude.Maybe [Prelude.Text])
getResource_embed :: Lens' GetResource (Maybe [Text])
getResource_embed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResource' {Maybe [Text]
embed :: Maybe [Text]
$sel:embed:GetResource' :: GetResource -> Maybe [Text]
embed} -> Maybe [Text]
embed) (\s :: GetResource
s@GetResource' {} Maybe [Text]
a -> GetResource
s {$sel:embed:GetResource' :: Maybe [Text]
embed = Maybe [Text]
a} :: GetResource) 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 string identifier of the associated RestApi.
getResource_restApiId :: Lens.Lens' GetResource Prelude.Text
getResource_restApiId :: Lens' GetResource Text
getResource_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResource' {Text
restApiId :: Text
$sel:restApiId:GetResource' :: GetResource -> Text
restApiId} -> Text
restApiId) (\s :: GetResource
s@GetResource' {} Text
a -> GetResource
s {$sel:restApiId:GetResource' :: Text
restApiId = Text
a} :: GetResource)

-- | The identifier for the Resource resource.
getResource_resourceId :: Lens.Lens' GetResource Prelude.Text
getResource_resourceId :: Lens' GetResource Text
getResource_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResource' {Text
resourceId :: Text
$sel:resourceId:GetResource' :: GetResource -> Text
resourceId} -> Text
resourceId) (\s :: GetResource
s@GetResource' {} Text
a -> GetResource
s {$sel:resourceId:GetResource' :: Text
resourceId = Text
a} :: GetResource)

instance Core.AWSRequest GetResource where
  type AWSResponse GetResource = Resource
  request :: (Service -> Service) -> GetResource -> Request GetResource
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 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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable GetResource where
  hashWithSalt :: Int -> GetResource -> Int
hashWithSalt Int
_salt GetResource' {Maybe [Text]
Text
resourceId :: Text
restApiId :: Text
embed :: Maybe [Text]
$sel:resourceId:GetResource' :: GetResource -> Text
$sel:restApiId:GetResource' :: GetResource -> Text
$sel:embed:GetResource' :: GetResource -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
embed
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
restApiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId

instance Prelude.NFData GetResource where
  rnf :: GetResource -> ()
rnf GetResource' {Maybe [Text]
Text
resourceId :: Text
restApiId :: Text
embed :: Maybe [Text]
$sel:resourceId:GetResource' :: GetResource -> Text
$sel:restApiId:GetResource' :: GetResource -> Text
$sel:embed:GetResource' :: GetResource -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
embed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
restApiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId

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
"Accept"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
          ]
      )

instance Data.ToPath GetResource where
  toPath :: GetResource -> ByteString
toPath GetResource' {Maybe [Text]
Text
resourceId :: Text
restApiId :: Text
embed :: Maybe [Text]
$sel:resourceId:GetResource' :: GetResource -> Text
$sel:restApiId:GetResource' :: GetResource -> Text
$sel:embed:GetResource' :: GetResource -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/restapis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId,
        ByteString
"/resources/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
resourceId
      ]

instance Data.ToQuery GetResource where
  toQuery :: GetResource -> QueryString
toQuery GetResource' {Maybe [Text]
Text
resourceId :: Text
restApiId :: Text
embed :: Maybe [Text]
$sel:resourceId:GetResource' :: GetResource -> Text
$sel:restApiId:GetResource' :: GetResource -> Text
$sel:embed:GetResource' :: GetResource -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"embed"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
embed)
      ]