{-# 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.GetModelTemplate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Generates a sample mapping template that can be used to transform a
-- payload into the structure of a model.
module Amazonka.APIGateway.GetModelTemplate
  ( -- * Creating a Request
    GetModelTemplate (..),
    newGetModelTemplate,

    -- * Request Lenses
    getModelTemplate_restApiId,
    getModelTemplate_modelName,

    -- * Destructuring the Response
    GetModelTemplateResponse (..),
    newGetModelTemplateResponse,

    -- * Response Lenses
    getModelTemplateResponse_value,
    getModelTemplateResponse_httpStatus,
  )
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 generate a sample mapping template used to transform the
-- payload.
--
-- /See:/ 'newGetModelTemplate' smart constructor.
data GetModelTemplate = GetModelTemplate'
  { -- | The string identifier of the associated RestApi.
    GetModelTemplate -> Text
restApiId :: Prelude.Text,
    -- | The name of the model for which to generate a template.
    GetModelTemplate -> Text
modelName :: Prelude.Text
  }
  deriving (GetModelTemplate -> GetModelTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetModelTemplate -> GetModelTemplate -> Bool
$c/= :: GetModelTemplate -> GetModelTemplate -> Bool
== :: GetModelTemplate -> GetModelTemplate -> Bool
$c== :: GetModelTemplate -> GetModelTemplate -> Bool
Prelude.Eq, ReadPrec [GetModelTemplate]
ReadPrec GetModelTemplate
Int -> ReadS GetModelTemplate
ReadS [GetModelTemplate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetModelTemplate]
$creadListPrec :: ReadPrec [GetModelTemplate]
readPrec :: ReadPrec GetModelTemplate
$creadPrec :: ReadPrec GetModelTemplate
readList :: ReadS [GetModelTemplate]
$creadList :: ReadS [GetModelTemplate]
readsPrec :: Int -> ReadS GetModelTemplate
$creadsPrec :: Int -> ReadS GetModelTemplate
Prelude.Read, Int -> GetModelTemplate -> ShowS
[GetModelTemplate] -> ShowS
GetModelTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetModelTemplate] -> ShowS
$cshowList :: [GetModelTemplate] -> ShowS
show :: GetModelTemplate -> String
$cshow :: GetModelTemplate -> String
showsPrec :: Int -> GetModelTemplate -> ShowS
$cshowsPrec :: Int -> GetModelTemplate -> ShowS
Prelude.Show, forall x. Rep GetModelTemplate x -> GetModelTemplate
forall x. GetModelTemplate -> Rep GetModelTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetModelTemplate x -> GetModelTemplate
$cfrom :: forall x. GetModelTemplate -> Rep GetModelTemplate x
Prelude.Generic)

-- |
-- Create a value of 'GetModelTemplate' 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', 'getModelTemplate_restApiId' - The string identifier of the associated RestApi.
--
-- 'modelName', 'getModelTemplate_modelName' - The name of the model for which to generate a template.
newGetModelTemplate ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'modelName'
  Prelude.Text ->
  GetModelTemplate
newGetModelTemplate :: Text -> Text -> GetModelTemplate
newGetModelTemplate Text
pRestApiId_ Text
pModelName_ =
  GetModelTemplate'
    { $sel:restApiId:GetModelTemplate' :: Text
restApiId = Text
pRestApiId_,
      $sel:modelName:GetModelTemplate' :: Text
modelName = Text
pModelName_
    }

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

-- | The name of the model for which to generate a template.
getModelTemplate_modelName :: Lens.Lens' GetModelTemplate Prelude.Text
getModelTemplate_modelName :: Lens' GetModelTemplate Text
getModelTemplate_modelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetModelTemplate' {Text
modelName :: Text
$sel:modelName:GetModelTemplate' :: GetModelTemplate -> Text
modelName} -> Text
modelName) (\s :: GetModelTemplate
s@GetModelTemplate' {} Text
a -> GetModelTemplate
s {$sel:modelName:GetModelTemplate' :: Text
modelName = Text
a} :: GetModelTemplate)

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

instance Prelude.NFData GetModelTemplate where
  rnf :: GetModelTemplate -> ()
rnf GetModelTemplate' {Text
modelName :: Text
restApiId :: Text
$sel:modelName:GetModelTemplate' :: GetModelTemplate -> Text
$sel:restApiId:GetModelTemplate' :: GetModelTemplate -> 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
modelName

instance Data.ToHeaders GetModelTemplate where
  toHeaders :: GetModelTemplate -> 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 GetModelTemplate where
  toPath :: GetModelTemplate -> ByteString
toPath GetModelTemplate' {Text
modelName :: Text
restApiId :: Text
$sel:modelName:GetModelTemplate' :: GetModelTemplate -> Text
$sel:restApiId:GetModelTemplate' :: GetModelTemplate -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/restapis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId,
        ByteString
"/models/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
modelName,
        ByteString
"/default_template"
      ]

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

-- | Represents a mapping template used to transform a payload.
--
-- /See:/ 'newGetModelTemplateResponse' smart constructor.
data GetModelTemplateResponse = GetModelTemplateResponse'
  { -- | The Apache Velocity Template Language (VTL) template content used for
    -- the template resource.
    GetModelTemplateResponse -> Maybe Text
value :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetModelTemplateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetModelTemplateResponse -> GetModelTemplateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetModelTemplateResponse -> GetModelTemplateResponse -> Bool
$c/= :: GetModelTemplateResponse -> GetModelTemplateResponse -> Bool
== :: GetModelTemplateResponse -> GetModelTemplateResponse -> Bool
$c== :: GetModelTemplateResponse -> GetModelTemplateResponse -> Bool
Prelude.Eq, ReadPrec [GetModelTemplateResponse]
ReadPrec GetModelTemplateResponse
Int -> ReadS GetModelTemplateResponse
ReadS [GetModelTemplateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetModelTemplateResponse]
$creadListPrec :: ReadPrec [GetModelTemplateResponse]
readPrec :: ReadPrec GetModelTemplateResponse
$creadPrec :: ReadPrec GetModelTemplateResponse
readList :: ReadS [GetModelTemplateResponse]
$creadList :: ReadS [GetModelTemplateResponse]
readsPrec :: Int -> ReadS GetModelTemplateResponse
$creadsPrec :: Int -> ReadS GetModelTemplateResponse
Prelude.Read, Int -> GetModelTemplateResponse -> ShowS
[GetModelTemplateResponse] -> ShowS
GetModelTemplateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetModelTemplateResponse] -> ShowS
$cshowList :: [GetModelTemplateResponse] -> ShowS
show :: GetModelTemplateResponse -> String
$cshow :: GetModelTemplateResponse -> String
showsPrec :: Int -> GetModelTemplateResponse -> ShowS
$cshowsPrec :: Int -> GetModelTemplateResponse -> ShowS
Prelude.Show, forall x.
Rep GetModelTemplateResponse x -> GetModelTemplateResponse
forall x.
GetModelTemplateResponse -> Rep GetModelTemplateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetModelTemplateResponse x -> GetModelTemplateResponse
$cfrom :: forall x.
GetModelTemplateResponse -> Rep GetModelTemplateResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetModelTemplateResponse' 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:
--
-- 'value', 'getModelTemplateResponse_value' - The Apache Velocity Template Language (VTL) template content used for
-- the template resource.
--
-- 'httpStatus', 'getModelTemplateResponse_httpStatus' - The response's http status code.
newGetModelTemplateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetModelTemplateResponse
newGetModelTemplateResponse :: Int -> GetModelTemplateResponse
newGetModelTemplateResponse Int
pHttpStatus_ =
  GetModelTemplateResponse'
    { $sel:value:GetModelTemplateResponse' :: Maybe Text
value = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetModelTemplateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Apache Velocity Template Language (VTL) template content used for
-- the template resource.
getModelTemplateResponse_value :: Lens.Lens' GetModelTemplateResponse (Prelude.Maybe Prelude.Text)
getModelTemplateResponse_value :: Lens' GetModelTemplateResponse (Maybe Text)
getModelTemplateResponse_value = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetModelTemplateResponse' {Maybe Text
value :: Maybe Text
$sel:value:GetModelTemplateResponse' :: GetModelTemplateResponse -> Maybe Text
value} -> Maybe Text
value) (\s :: GetModelTemplateResponse
s@GetModelTemplateResponse' {} Maybe Text
a -> GetModelTemplateResponse
s {$sel:value:GetModelTemplateResponse' :: Maybe Text
value = Maybe Text
a} :: GetModelTemplateResponse)

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

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