{-# 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.ApiGatewayV2.CreateRouteResponse
-- 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 RouteResponse for a Route.
module Amazonka.ApiGatewayV2.CreateRouteResponse
  ( -- * Creating a Request
    CreateRouteResponse (..),
    newCreateRouteResponse,

    -- * Request Lenses
    createRouteResponse_modelSelectionExpression,
    createRouteResponse_responseModels,
    createRouteResponse_responseParameters,
    createRouteResponse_apiId,
    createRouteResponse_routeId,
    createRouteResponse_routeResponseKey,

    -- * Destructuring the Response
    CreateRouteResponseResponse (..),
    newCreateRouteResponseResponse,

    -- * Response Lenses
    createRouteResponseResponse_modelSelectionExpression,
    createRouteResponseResponse_responseModels,
    createRouteResponseResponse_responseParameters,
    createRouteResponseResponse_routeResponseId,
    createRouteResponseResponse_routeResponseKey,
    createRouteResponseResponse_httpStatus,
  )
where

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

-- | Creates a new RouteResponse resource to represent a route response.
--
-- /See:/ 'newCreateRouteResponse' smart constructor.
data CreateRouteResponse = CreateRouteResponse'
  { -- | The model selection expression for the route response. Supported only
    -- for WebSocket APIs.
    CreateRouteResponse -> Maybe Text
modelSelectionExpression :: Prelude.Maybe Prelude.Text,
    -- | The response models for the route response.
    CreateRouteResponse -> Maybe (HashMap Text Text)
responseModels :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The route response parameters.
    CreateRouteResponse -> Maybe (HashMap Text ParameterConstraints)
responseParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text ParameterConstraints),
    -- | The API identifier.
    CreateRouteResponse -> Text
apiId :: Prelude.Text,
    -- | The route ID.
    CreateRouteResponse -> Text
routeId :: Prelude.Text,
    -- | The route response key.
    CreateRouteResponse -> Text
routeResponseKey :: Prelude.Text
  }
  deriving (CreateRouteResponse -> CreateRouteResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateRouteResponse -> CreateRouteResponse -> Bool
$c/= :: CreateRouteResponse -> CreateRouteResponse -> Bool
== :: CreateRouteResponse -> CreateRouteResponse -> Bool
$c== :: CreateRouteResponse -> CreateRouteResponse -> Bool
Prelude.Eq, ReadPrec [CreateRouteResponse]
ReadPrec CreateRouteResponse
Int -> ReadS CreateRouteResponse
ReadS [CreateRouteResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateRouteResponse]
$creadListPrec :: ReadPrec [CreateRouteResponse]
readPrec :: ReadPrec CreateRouteResponse
$creadPrec :: ReadPrec CreateRouteResponse
readList :: ReadS [CreateRouteResponse]
$creadList :: ReadS [CreateRouteResponse]
readsPrec :: Int -> ReadS CreateRouteResponse
$creadsPrec :: Int -> ReadS CreateRouteResponse
Prelude.Read, Int -> CreateRouteResponse -> ShowS
[CreateRouteResponse] -> ShowS
CreateRouteResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateRouteResponse] -> ShowS
$cshowList :: [CreateRouteResponse] -> ShowS
show :: CreateRouteResponse -> String
$cshow :: CreateRouteResponse -> String
showsPrec :: Int -> CreateRouteResponse -> ShowS
$cshowsPrec :: Int -> CreateRouteResponse -> ShowS
Prelude.Show, forall x. Rep CreateRouteResponse x -> CreateRouteResponse
forall x. CreateRouteResponse -> Rep CreateRouteResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateRouteResponse x -> CreateRouteResponse
$cfrom :: forall x. CreateRouteResponse -> Rep CreateRouteResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateRouteResponse' 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:
--
-- 'modelSelectionExpression', 'createRouteResponse_modelSelectionExpression' - The model selection expression for the route response. Supported only
-- for WebSocket APIs.
--
-- 'responseModels', 'createRouteResponse_responseModels' - The response models for the route response.
--
-- 'responseParameters', 'createRouteResponse_responseParameters' - The route response parameters.
--
-- 'apiId', 'createRouteResponse_apiId' - The API identifier.
--
-- 'routeId', 'createRouteResponse_routeId' - The route ID.
--
-- 'routeResponseKey', 'createRouteResponse_routeResponseKey' - The route response key.
newCreateRouteResponse ::
  -- | 'apiId'
  Prelude.Text ->
  -- | 'routeId'
  Prelude.Text ->
  -- | 'routeResponseKey'
  Prelude.Text ->
  CreateRouteResponse
newCreateRouteResponse :: Text -> Text -> Text -> CreateRouteResponse
newCreateRouteResponse
  Text
pApiId_
  Text
pRouteId_
  Text
pRouteResponseKey_ =
    CreateRouteResponse'
      { $sel:modelSelectionExpression:CreateRouteResponse' :: Maybe Text
modelSelectionExpression =
          forall a. Maybe a
Prelude.Nothing,
        $sel:responseModels:CreateRouteResponse' :: Maybe (HashMap Text Text)
responseModels = forall a. Maybe a
Prelude.Nothing,
        $sel:responseParameters:CreateRouteResponse' :: Maybe (HashMap Text ParameterConstraints)
responseParameters = forall a. Maybe a
Prelude.Nothing,
        $sel:apiId:CreateRouteResponse' :: Text
apiId = Text
pApiId_,
        $sel:routeId:CreateRouteResponse' :: Text
routeId = Text
pRouteId_,
        $sel:routeResponseKey:CreateRouteResponse' :: Text
routeResponseKey = Text
pRouteResponseKey_
      }

-- | The model selection expression for the route response. Supported only
-- for WebSocket APIs.
createRouteResponse_modelSelectionExpression :: Lens.Lens' CreateRouteResponse (Prelude.Maybe Prelude.Text)
createRouteResponse_modelSelectionExpression :: Lens' CreateRouteResponse (Maybe Text)
createRouteResponse_modelSelectionExpression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRouteResponse' {Maybe Text
modelSelectionExpression :: Maybe Text
$sel:modelSelectionExpression:CreateRouteResponse' :: CreateRouteResponse -> Maybe Text
modelSelectionExpression} -> Maybe Text
modelSelectionExpression) (\s :: CreateRouteResponse
s@CreateRouteResponse' {} Maybe Text
a -> CreateRouteResponse
s {$sel:modelSelectionExpression:CreateRouteResponse' :: Maybe Text
modelSelectionExpression = Maybe Text
a} :: CreateRouteResponse)

-- | The response models for the route response.
createRouteResponse_responseModels :: Lens.Lens' CreateRouteResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createRouteResponse_responseModels :: Lens' CreateRouteResponse (Maybe (HashMap Text Text))
createRouteResponse_responseModels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRouteResponse' {Maybe (HashMap Text Text)
responseModels :: Maybe (HashMap Text Text)
$sel:responseModels:CreateRouteResponse' :: CreateRouteResponse -> Maybe (HashMap Text Text)
responseModels} -> Maybe (HashMap Text Text)
responseModels) (\s :: CreateRouteResponse
s@CreateRouteResponse' {} Maybe (HashMap Text Text)
a -> CreateRouteResponse
s {$sel:responseModels:CreateRouteResponse' :: Maybe (HashMap Text Text)
responseModels = Maybe (HashMap Text Text)
a} :: CreateRouteResponse) 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 route response parameters.
createRouteResponse_responseParameters :: Lens.Lens' CreateRouteResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text ParameterConstraints))
createRouteResponse_responseParameters :: Lens'
  CreateRouteResponse (Maybe (HashMap Text ParameterConstraints))
createRouteResponse_responseParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRouteResponse' {Maybe (HashMap Text ParameterConstraints)
responseParameters :: Maybe (HashMap Text ParameterConstraints)
$sel:responseParameters:CreateRouteResponse' :: CreateRouteResponse -> Maybe (HashMap Text ParameterConstraints)
responseParameters} -> Maybe (HashMap Text ParameterConstraints)
responseParameters) (\s :: CreateRouteResponse
s@CreateRouteResponse' {} Maybe (HashMap Text ParameterConstraints)
a -> CreateRouteResponse
s {$sel:responseParameters:CreateRouteResponse' :: Maybe (HashMap Text ParameterConstraints)
responseParameters = Maybe (HashMap Text ParameterConstraints)
a} :: CreateRouteResponse) 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 API identifier.
createRouteResponse_apiId :: Lens.Lens' CreateRouteResponse Prelude.Text
createRouteResponse_apiId :: Lens' CreateRouteResponse Text
createRouteResponse_apiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRouteResponse' {Text
apiId :: Text
$sel:apiId:CreateRouteResponse' :: CreateRouteResponse -> Text
apiId} -> Text
apiId) (\s :: CreateRouteResponse
s@CreateRouteResponse' {} Text
a -> CreateRouteResponse
s {$sel:apiId:CreateRouteResponse' :: Text
apiId = Text
a} :: CreateRouteResponse)

-- | The route ID.
createRouteResponse_routeId :: Lens.Lens' CreateRouteResponse Prelude.Text
createRouteResponse_routeId :: Lens' CreateRouteResponse Text
createRouteResponse_routeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRouteResponse' {Text
routeId :: Text
$sel:routeId:CreateRouteResponse' :: CreateRouteResponse -> Text
routeId} -> Text
routeId) (\s :: CreateRouteResponse
s@CreateRouteResponse' {} Text
a -> CreateRouteResponse
s {$sel:routeId:CreateRouteResponse' :: Text
routeId = Text
a} :: CreateRouteResponse)

-- | The route response key.
createRouteResponse_routeResponseKey :: Lens.Lens' CreateRouteResponse Prelude.Text
createRouteResponse_routeResponseKey :: Lens' CreateRouteResponse Text
createRouteResponse_routeResponseKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRouteResponse' {Text
routeResponseKey :: Text
$sel:routeResponseKey:CreateRouteResponse' :: CreateRouteResponse -> Text
routeResponseKey} -> Text
routeResponseKey) (\s :: CreateRouteResponse
s@CreateRouteResponse' {} Text
a -> CreateRouteResponse
s {$sel:routeResponseKey:CreateRouteResponse' :: Text
routeResponseKey = Text
a} :: CreateRouteResponse)

instance Core.AWSRequest CreateRouteResponse where
  type
    AWSResponse CreateRouteResponse =
      CreateRouteResponseResponse
  request :: (Service -> Service)
-> CreateRouteResponse -> Request CreateRouteResponse
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 CreateRouteResponse
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateRouteResponse)))
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
-> Maybe (HashMap Text Text)
-> Maybe (HashMap Text ParameterConstraints)
-> Maybe Text
-> Maybe Text
-> Int
-> CreateRouteResponseResponse
CreateRouteResponseResponse'
            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
"modelSelectionExpression")
            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
"responseModels" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"responseParameters"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"routeResponseId")
            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
"routeResponseKey")
            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 CreateRouteResponse where
  hashWithSalt :: Int -> CreateRouteResponse -> Int
hashWithSalt Int
_salt CreateRouteResponse' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text ParameterConstraints)
Text
routeResponseKey :: Text
routeId :: Text
apiId :: Text
responseParameters :: Maybe (HashMap Text ParameterConstraints)
responseModels :: Maybe (HashMap Text Text)
modelSelectionExpression :: Maybe Text
$sel:routeResponseKey:CreateRouteResponse' :: CreateRouteResponse -> Text
$sel:routeId:CreateRouteResponse' :: CreateRouteResponse -> Text
$sel:apiId:CreateRouteResponse' :: CreateRouteResponse -> Text
$sel:responseParameters:CreateRouteResponse' :: CreateRouteResponse -> Maybe (HashMap Text ParameterConstraints)
$sel:responseModels:CreateRouteResponse' :: CreateRouteResponse -> Maybe (HashMap Text Text)
$sel:modelSelectionExpression:CreateRouteResponse' :: CreateRouteResponse -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
modelSelectionExpression
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
responseModels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text ParameterConstraints)
responseParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
routeId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
routeResponseKey

instance Prelude.NFData CreateRouteResponse where
  rnf :: CreateRouteResponse -> ()
rnf CreateRouteResponse' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text ParameterConstraints)
Text
routeResponseKey :: Text
routeId :: Text
apiId :: Text
responseParameters :: Maybe (HashMap Text ParameterConstraints)
responseModels :: Maybe (HashMap Text Text)
modelSelectionExpression :: Maybe Text
$sel:routeResponseKey:CreateRouteResponse' :: CreateRouteResponse -> Text
$sel:routeId:CreateRouteResponse' :: CreateRouteResponse -> Text
$sel:apiId:CreateRouteResponse' :: CreateRouteResponse -> Text
$sel:responseParameters:CreateRouteResponse' :: CreateRouteResponse -> Maybe (HashMap Text ParameterConstraints)
$sel:responseModels:CreateRouteResponse' :: CreateRouteResponse -> Maybe (HashMap Text Text)
$sel:modelSelectionExpression:CreateRouteResponse' :: CreateRouteResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
modelSelectionExpression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
responseModels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text ParameterConstraints)
responseParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
apiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
routeId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
routeResponseKey

instance Data.ToHeaders CreateRouteResponse where
  toHeaders :: CreateRouteResponse -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateRouteResponse where
  toJSON :: CreateRouteResponse -> Value
toJSON CreateRouteResponse' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text ParameterConstraints)
Text
routeResponseKey :: Text
routeId :: Text
apiId :: Text
responseParameters :: Maybe (HashMap Text ParameterConstraints)
responseModels :: Maybe (HashMap Text Text)
modelSelectionExpression :: Maybe Text
$sel:routeResponseKey:CreateRouteResponse' :: CreateRouteResponse -> Text
$sel:routeId:CreateRouteResponse' :: CreateRouteResponse -> Text
$sel:apiId:CreateRouteResponse' :: CreateRouteResponse -> Text
$sel:responseParameters:CreateRouteResponse' :: CreateRouteResponse -> Maybe (HashMap Text ParameterConstraints)
$sel:responseModels:CreateRouteResponse' :: CreateRouteResponse -> Maybe (HashMap Text Text)
$sel:modelSelectionExpression:CreateRouteResponse' :: CreateRouteResponse -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"modelSelectionExpression" 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
modelSelectionExpression,
            (Key
"responseModels" 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 (HashMap Text Text)
responseModels,
            (Key
"responseParameters" 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 (HashMap Text ParameterConstraints)
responseParameters,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"routeResponseKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
routeResponseKey)
          ]
      )

instance Data.ToPath CreateRouteResponse where
  toPath :: CreateRouteResponse -> ByteString
toPath CreateRouteResponse' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text ParameterConstraints)
Text
routeResponseKey :: Text
routeId :: Text
apiId :: Text
responseParameters :: Maybe (HashMap Text ParameterConstraints)
responseModels :: Maybe (HashMap Text Text)
modelSelectionExpression :: Maybe Text
$sel:routeResponseKey:CreateRouteResponse' :: CreateRouteResponse -> Text
$sel:routeId:CreateRouteResponse' :: CreateRouteResponse -> Text
$sel:apiId:CreateRouteResponse' :: CreateRouteResponse -> Text
$sel:responseParameters:CreateRouteResponse' :: CreateRouteResponse -> Maybe (HashMap Text ParameterConstraints)
$sel:responseModels:CreateRouteResponse' :: CreateRouteResponse -> Maybe (HashMap Text Text)
$sel:modelSelectionExpression:CreateRouteResponse' :: CreateRouteResponse -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v2/apis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiId,
        ByteString
"/routes/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
routeId,
        ByteString
"/routeresponses"
      ]

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

-- | /See:/ 'newCreateRouteResponseResponse' smart constructor.
data CreateRouteResponseResponse = CreateRouteResponseResponse'
  { -- | Represents the model selection expression of a route response. Supported
    -- only for WebSocket APIs.
    CreateRouteResponseResponse -> Maybe Text
modelSelectionExpression :: Prelude.Maybe Prelude.Text,
    -- | Represents the response models of a route response.
    CreateRouteResponseResponse -> Maybe (HashMap Text Text)
responseModels :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Represents the response parameters of a route response.
    CreateRouteResponseResponse
-> Maybe (HashMap Text ParameterConstraints)
responseParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text ParameterConstraints),
    -- | Represents the identifier of a route response.
    CreateRouteResponseResponse -> Maybe Text
routeResponseId :: Prelude.Maybe Prelude.Text,
    -- | Represents the route response key of a route response.
    CreateRouteResponseResponse -> Maybe Text
routeResponseKey :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateRouteResponseResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateRouteResponseResponse -> CreateRouteResponseResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateRouteResponseResponse -> CreateRouteResponseResponse -> Bool
$c/= :: CreateRouteResponseResponse -> CreateRouteResponseResponse -> Bool
== :: CreateRouteResponseResponse -> CreateRouteResponseResponse -> Bool
$c== :: CreateRouteResponseResponse -> CreateRouteResponseResponse -> Bool
Prelude.Eq, ReadPrec [CreateRouteResponseResponse]
ReadPrec CreateRouteResponseResponse
Int -> ReadS CreateRouteResponseResponse
ReadS [CreateRouteResponseResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateRouteResponseResponse]
$creadListPrec :: ReadPrec [CreateRouteResponseResponse]
readPrec :: ReadPrec CreateRouteResponseResponse
$creadPrec :: ReadPrec CreateRouteResponseResponse
readList :: ReadS [CreateRouteResponseResponse]
$creadList :: ReadS [CreateRouteResponseResponse]
readsPrec :: Int -> ReadS CreateRouteResponseResponse
$creadsPrec :: Int -> ReadS CreateRouteResponseResponse
Prelude.Read, Int -> CreateRouteResponseResponse -> ShowS
[CreateRouteResponseResponse] -> ShowS
CreateRouteResponseResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateRouteResponseResponse] -> ShowS
$cshowList :: [CreateRouteResponseResponse] -> ShowS
show :: CreateRouteResponseResponse -> String
$cshow :: CreateRouteResponseResponse -> String
showsPrec :: Int -> CreateRouteResponseResponse -> ShowS
$cshowsPrec :: Int -> CreateRouteResponseResponse -> ShowS
Prelude.Show, forall x.
Rep CreateRouteResponseResponse x -> CreateRouteResponseResponse
forall x.
CreateRouteResponseResponse -> Rep CreateRouteResponseResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateRouteResponseResponse x -> CreateRouteResponseResponse
$cfrom :: forall x.
CreateRouteResponseResponse -> Rep CreateRouteResponseResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateRouteResponseResponse' 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:
--
-- 'modelSelectionExpression', 'createRouteResponseResponse_modelSelectionExpression' - Represents the model selection expression of a route response. Supported
-- only for WebSocket APIs.
--
-- 'responseModels', 'createRouteResponseResponse_responseModels' - Represents the response models of a route response.
--
-- 'responseParameters', 'createRouteResponseResponse_responseParameters' - Represents the response parameters of a route response.
--
-- 'routeResponseId', 'createRouteResponseResponse_routeResponseId' - Represents the identifier of a route response.
--
-- 'routeResponseKey', 'createRouteResponseResponse_routeResponseKey' - Represents the route response key of a route response.
--
-- 'httpStatus', 'createRouteResponseResponse_httpStatus' - The response's http status code.
newCreateRouteResponseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateRouteResponseResponse
newCreateRouteResponseResponse :: Int -> CreateRouteResponseResponse
newCreateRouteResponseResponse Int
pHttpStatus_ =
  CreateRouteResponseResponse'
    { $sel:modelSelectionExpression:CreateRouteResponseResponse' :: Maybe Text
modelSelectionExpression =
        forall a. Maybe a
Prelude.Nothing,
      $sel:responseModels:CreateRouteResponseResponse' :: Maybe (HashMap Text Text)
responseModels = forall a. Maybe a
Prelude.Nothing,
      $sel:responseParameters:CreateRouteResponseResponse' :: Maybe (HashMap Text ParameterConstraints)
responseParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:routeResponseId:CreateRouteResponseResponse' :: Maybe Text
routeResponseId = forall a. Maybe a
Prelude.Nothing,
      $sel:routeResponseKey:CreateRouteResponseResponse' :: Maybe Text
routeResponseKey = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateRouteResponseResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Represents the model selection expression of a route response. Supported
-- only for WebSocket APIs.
createRouteResponseResponse_modelSelectionExpression :: Lens.Lens' CreateRouteResponseResponse (Prelude.Maybe Prelude.Text)
createRouteResponseResponse_modelSelectionExpression :: Lens' CreateRouteResponseResponse (Maybe Text)
createRouteResponseResponse_modelSelectionExpression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRouteResponseResponse' {Maybe Text
modelSelectionExpression :: Maybe Text
$sel:modelSelectionExpression:CreateRouteResponseResponse' :: CreateRouteResponseResponse -> Maybe Text
modelSelectionExpression} -> Maybe Text
modelSelectionExpression) (\s :: CreateRouteResponseResponse
s@CreateRouteResponseResponse' {} Maybe Text
a -> CreateRouteResponseResponse
s {$sel:modelSelectionExpression:CreateRouteResponseResponse' :: Maybe Text
modelSelectionExpression = Maybe Text
a} :: CreateRouteResponseResponse)

-- | Represents the response models of a route response.
createRouteResponseResponse_responseModels :: Lens.Lens' CreateRouteResponseResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createRouteResponseResponse_responseModels :: Lens' CreateRouteResponseResponse (Maybe (HashMap Text Text))
createRouteResponseResponse_responseModels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRouteResponseResponse' {Maybe (HashMap Text Text)
responseModels :: Maybe (HashMap Text Text)
$sel:responseModels:CreateRouteResponseResponse' :: CreateRouteResponseResponse -> Maybe (HashMap Text Text)
responseModels} -> Maybe (HashMap Text Text)
responseModels) (\s :: CreateRouteResponseResponse
s@CreateRouteResponseResponse' {} Maybe (HashMap Text Text)
a -> CreateRouteResponseResponse
s {$sel:responseModels:CreateRouteResponseResponse' :: Maybe (HashMap Text Text)
responseModels = Maybe (HashMap Text Text)
a} :: CreateRouteResponseResponse) 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

-- | Represents the response parameters of a route response.
createRouteResponseResponse_responseParameters :: Lens.Lens' CreateRouteResponseResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text ParameterConstraints))
createRouteResponseResponse_responseParameters :: Lens'
  CreateRouteResponseResponse
  (Maybe (HashMap Text ParameterConstraints))
createRouteResponseResponse_responseParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRouteResponseResponse' {Maybe (HashMap Text ParameterConstraints)
responseParameters :: Maybe (HashMap Text ParameterConstraints)
$sel:responseParameters:CreateRouteResponseResponse' :: CreateRouteResponseResponse
-> Maybe (HashMap Text ParameterConstraints)
responseParameters} -> Maybe (HashMap Text ParameterConstraints)
responseParameters) (\s :: CreateRouteResponseResponse
s@CreateRouteResponseResponse' {} Maybe (HashMap Text ParameterConstraints)
a -> CreateRouteResponseResponse
s {$sel:responseParameters:CreateRouteResponseResponse' :: Maybe (HashMap Text ParameterConstraints)
responseParameters = Maybe (HashMap Text ParameterConstraints)
a} :: CreateRouteResponseResponse) 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

-- | Represents the identifier of a route response.
createRouteResponseResponse_routeResponseId :: Lens.Lens' CreateRouteResponseResponse (Prelude.Maybe Prelude.Text)
createRouteResponseResponse_routeResponseId :: Lens' CreateRouteResponseResponse (Maybe Text)
createRouteResponseResponse_routeResponseId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRouteResponseResponse' {Maybe Text
routeResponseId :: Maybe Text
$sel:routeResponseId:CreateRouteResponseResponse' :: CreateRouteResponseResponse -> Maybe Text
routeResponseId} -> Maybe Text
routeResponseId) (\s :: CreateRouteResponseResponse
s@CreateRouteResponseResponse' {} Maybe Text
a -> CreateRouteResponseResponse
s {$sel:routeResponseId:CreateRouteResponseResponse' :: Maybe Text
routeResponseId = Maybe Text
a} :: CreateRouteResponseResponse)

-- | Represents the route response key of a route response.
createRouteResponseResponse_routeResponseKey :: Lens.Lens' CreateRouteResponseResponse (Prelude.Maybe Prelude.Text)
createRouteResponseResponse_routeResponseKey :: Lens' CreateRouteResponseResponse (Maybe Text)
createRouteResponseResponse_routeResponseKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRouteResponseResponse' {Maybe Text
routeResponseKey :: Maybe Text
$sel:routeResponseKey:CreateRouteResponseResponse' :: CreateRouteResponseResponse -> Maybe Text
routeResponseKey} -> Maybe Text
routeResponseKey) (\s :: CreateRouteResponseResponse
s@CreateRouteResponseResponse' {} Maybe Text
a -> CreateRouteResponseResponse
s {$sel:routeResponseKey:CreateRouteResponseResponse' :: Maybe Text
routeResponseKey = Maybe Text
a} :: CreateRouteResponseResponse)

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

instance Prelude.NFData CreateRouteResponseResponse where
  rnf :: CreateRouteResponseResponse -> ()
rnf CreateRouteResponseResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text ParameterConstraints)
httpStatus :: Int
routeResponseKey :: Maybe Text
routeResponseId :: Maybe Text
responseParameters :: Maybe (HashMap Text ParameterConstraints)
responseModels :: Maybe (HashMap Text Text)
modelSelectionExpression :: Maybe Text
$sel:httpStatus:CreateRouteResponseResponse' :: CreateRouteResponseResponse -> Int
$sel:routeResponseKey:CreateRouteResponseResponse' :: CreateRouteResponseResponse -> Maybe Text
$sel:routeResponseId:CreateRouteResponseResponse' :: CreateRouteResponseResponse -> Maybe Text
$sel:responseParameters:CreateRouteResponseResponse' :: CreateRouteResponseResponse
-> Maybe (HashMap Text ParameterConstraints)
$sel:responseModels:CreateRouteResponseResponse' :: CreateRouteResponseResponse -> Maybe (HashMap Text Text)
$sel:modelSelectionExpression:CreateRouteResponseResponse' :: CreateRouteResponseResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
modelSelectionExpression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
responseModels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text ParameterConstraints)
responseParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
routeResponseId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
routeResponseKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus