{-# 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.CreateResource
-- 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 a Resource resource.
module Amazonka.APIGateway.CreateResource
  ( -- * Creating a Request
    CreateResource (..),
    newCreateResource,

    -- * Request Lenses
    createResource_restApiId,
    createResource_parentId,
    createResource_pathPart,

    -- * 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

-- | Requests API Gateway to create a Resource resource.
--
-- /See:/ 'newCreateResource' smart constructor.
data CreateResource = CreateResource'
  { -- | The string identifier of the associated RestApi.
    CreateResource -> Text
restApiId :: Prelude.Text,
    -- | The parent resource\'s identifier.
    CreateResource -> Text
parentId :: Prelude.Text,
    -- | The last path segment for this resource.
    CreateResource -> Text
pathPart :: Prelude.Text
  }
  deriving (CreateResource -> CreateResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateResource -> CreateResource -> Bool
$c/= :: CreateResource -> CreateResource -> Bool
== :: CreateResource -> CreateResource -> Bool
$c== :: CreateResource -> CreateResource -> Bool
Prelude.Eq, ReadPrec [CreateResource]
ReadPrec CreateResource
Int -> ReadS CreateResource
ReadS [CreateResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateResource]
$creadListPrec :: ReadPrec [CreateResource]
readPrec :: ReadPrec CreateResource
$creadPrec :: ReadPrec CreateResource
readList :: ReadS [CreateResource]
$creadList :: ReadS [CreateResource]
readsPrec :: Int -> ReadS CreateResource
$creadsPrec :: Int -> ReadS CreateResource
Prelude.Read, Int -> CreateResource -> ShowS
[CreateResource] -> ShowS
CreateResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateResource] -> ShowS
$cshowList :: [CreateResource] -> ShowS
show :: CreateResource -> String
$cshow :: CreateResource -> String
showsPrec :: Int -> CreateResource -> ShowS
$cshowsPrec :: Int -> CreateResource -> ShowS
Prelude.Show, forall x. Rep CreateResource x -> CreateResource
forall x. CreateResource -> Rep CreateResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateResource x -> CreateResource
$cfrom :: forall x. CreateResource -> Rep CreateResource x
Prelude.Generic)

-- |
-- Create a value of 'CreateResource' 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:
--
-- 'restApiId', 'createResource_restApiId' - The string identifier of the associated RestApi.
--
-- 'parentId', 'createResource_parentId' - The parent resource\'s identifier.
--
-- 'pathPart', 'createResource_pathPart' - The last path segment for this resource.
newCreateResource ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'parentId'
  Prelude.Text ->
  -- | 'pathPart'
  Prelude.Text ->
  CreateResource
newCreateResource :: Text -> Text -> Text -> CreateResource
newCreateResource Text
pRestApiId_ Text
pParentId_ Text
pPathPart_ =
  CreateResource'
    { $sel:restApiId:CreateResource' :: Text
restApiId = Text
pRestApiId_,
      $sel:parentId:CreateResource' :: Text
parentId = Text
pParentId_,
      $sel:pathPart:CreateResource' :: Text
pathPart = Text
pPathPart_
    }

-- | The string identifier of the associated RestApi.
createResource_restApiId :: Lens.Lens' CreateResource Prelude.Text
createResource_restApiId :: Lens' CreateResource Text
createResource_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResource' {Text
restApiId :: Text
$sel:restApiId:CreateResource' :: CreateResource -> Text
restApiId} -> Text
restApiId) (\s :: CreateResource
s@CreateResource' {} Text
a -> CreateResource
s {$sel:restApiId:CreateResource' :: Text
restApiId = Text
a} :: CreateResource)

-- | The parent resource\'s identifier.
createResource_parentId :: Lens.Lens' CreateResource Prelude.Text
createResource_parentId :: Lens' CreateResource Text
createResource_parentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResource' {Text
parentId :: Text
$sel:parentId:CreateResource' :: CreateResource -> Text
parentId} -> Text
parentId) (\s :: CreateResource
s@CreateResource' {} Text
a -> CreateResource
s {$sel:parentId:CreateResource' :: Text
parentId = Text
a} :: CreateResource)

-- | The last path segment for this resource.
createResource_pathPart :: Lens.Lens' CreateResource Prelude.Text
createResource_pathPart :: Lens' CreateResource Text
createResource_pathPart = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResource' {Text
pathPart :: Text
$sel:pathPart:CreateResource' :: CreateResource -> Text
pathPart} -> Text
pathPart) (\s :: CreateResource
s@CreateResource' {} Text
a -> CreateResource
s {$sel:pathPart:CreateResource' :: Text
pathPart = Text
a} :: CreateResource)

instance Core.AWSRequest CreateResource where
  type AWSResponse CreateResource = Resource
  request :: (Service -> Service) -> CreateResource -> Request CreateResource
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 CreateResource
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateResource)))
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 CreateResource where
  hashWithSalt :: Int -> CreateResource -> Int
hashWithSalt Int
_salt CreateResource' {Text
pathPart :: Text
parentId :: Text
restApiId :: Text
$sel:pathPart:CreateResource' :: CreateResource -> Text
$sel:parentId:CreateResource' :: CreateResource -> Text
$sel:restApiId:CreateResource' :: CreateResource -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
restApiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
parentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pathPart

instance Prelude.NFData CreateResource where
  rnf :: CreateResource -> ()
rnf CreateResource' {Text
pathPart :: Text
parentId :: Text
restApiId :: Text
$sel:pathPart:CreateResource' :: CreateResource -> Text
$sel:parentId:CreateResource' :: CreateResource -> Text
$sel:restApiId:CreateResource' :: CreateResource -> Text
..} =
    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
parentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
pathPart

instance Data.ToHeaders CreateResource where
  toHeaders :: CreateResource -> 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.ToJSON CreateResource where
  toJSON :: CreateResource -> Value
toJSON CreateResource' {Text
pathPart :: Text
parentId :: Text
restApiId :: Text
$sel:pathPart:CreateResource' :: CreateResource -> Text
$sel:parentId:CreateResource' :: CreateResource -> Text
$sel:restApiId:CreateResource' :: CreateResource -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"pathPart" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
pathPart)]
      )

instance Data.ToPath CreateResource where
  toPath :: CreateResource -> ByteString
toPath CreateResource' {Text
pathPart :: Text
parentId :: Text
restApiId :: Text
$sel:pathPart:CreateResource' :: CreateResource -> Text
$sel:parentId:CreateResource' :: CreateResource -> Text
$sel:restApiId:CreateResource' :: CreateResource -> 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
parentId
      ]

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